Блестящий модуль: для возврата нескольких реактивных выходов из одной функции в модуле (связывание листовки и таблицы данных) - PullRequest
0 голосов
/ 28 ноября 2018

Я кодирую модуль Shiny, чтобы связать карту листовки с таблицей данных (код основан на Shiny - как выделить объект на карте листовки при выборе записи в таблице данных? ).

Трудность, с которой я сталкиваюсь, заключается в передаче некоторого визуализированного текста ("tabvec_title") и таблицы данных ("vector_table") из скрипта module.R в приложение.R, и связывание таблицы данных и карты листовки.Это руководство полезно (https://github.com/rstudio/webinars/blob/master/19-Understanding-modules/01-Modules-Webinar.pdf), но мне все еще неясно, как лучше всего передать обработанный текст и таблицу в app.R. Большое спасибо за ваш совет. (Обновлено, см. Комментарий ниже).

Выдержки из файлов: app.R (версия 2):

source("module.R")

tags$div(id="tabvec ",
  fluidRow(
  column(12,
    tags$br(),
       tags$div(myModuleUI('vector_titab'), id="myModuleUI")


server <- function(input, output, session) {
proxy <- leafletProxy("map")

callModule(mod_sl1,'vector_titab', reactive(input$pow_sl), proxy, vector_table, tabvec_title, 
   reactive(input$map_marker_click))

# Hide/show DT and title beneath map
 observe({
   if(input$pow_sl == TRUE){
     shinyjs::show(id="myModuleUI", selector = input$pow_sl)
   } else {
     shinyjs::hide(id="myModuleUI", selector = input$pow_sl)
   }}
 )
   ...

module.R (версия 2):

# Permits interactive selection of marker and DT table rows ----
library(leaflet)
library(DT)
library(shinydashboard)

myModuleUI <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("tabvec_title")),
    DT::dataTableOutput(ns("vector_table"))
  )
}

mod_sl1 <- function(input, output, session, pow_sl, prox, vector_table, tabvec_title, 
                map_marker_click){

 ns <- session$ns
 observeEvent(pow_sl(), {
 html_legend <- '<i class="fa fa-map-marker" style="color:green;"></i></i>Plants '
 print("test89")
 if(pow_sl() != 0){
    pow_sl <- readOGR("./geospatial_files/srilanka", layer = "plants")
    pow_sldf <- as.data.frame(pow_sl)

    # add table
    pow_d <- pow_sldf[,c(1:5,7:8,10:11,14)]
    pow_d$Latitude <- round(pow_d$Latitude, digits=4)
    pow_d$Longitude <- round(pow_d$Longitude, digits=4)
    colnames(pow_d)<- c("id","PlantName","Latitude", "Longitude","Type")
    pow_d$id <- as.character(pow_d$id)
    pow_d$Fuel <- as.character(pow_d$Fuel)
    pow_d$Type <- as.character(pow_d$Type)

    # drop first row with missing details
    pow_dt <- pow_d[-1,]

 output$tabvec_title <- renderText({ "Plants" })

 output$vector_table <- renderDataTable({
 DT::datatable(pow_dt, selection = c("single"),
                options=list(stateSave = TRUE, buttons = c('copy', 'csv', 'excel',  'print'),dom = 'Bflit'),
                rownames=FALSE, caption = "", extensions = 'Buttons')
})

 # to keep track of previously selected row
 prev_row <- reactiveVal()

 # new icon style
 red_icon = makeAwesomeIcon(icon = 'flag', markerColor = 'red', iconColor = 'white')

 observeEvent(input$vector_table_rows_selected, {
   row_selected = pow_dt[input$vector_table_rows_selected,]
   prox %>%
     addAwesomeMarkers(
      layerId = as.character(row_selected$id),
      lng=row_selected$Longitude,
      lat=row_selected$Latitude,
      group = "pow_slg",
      icon = red_icon,
      label = as.character(row_selected$Fuel))

   # Reset previously selected marker
   if(!is.null(prev_row()))
   {
    prox %>%
      addAwesomeMarkers(popup=as.character(prev_row()$Fuel),
                        layerId = as.character(prev_row()$id),
                        lng=prev_row()$Longitude,
                        lat=prev_row()$Latitude,
                        group = "pow_slg",
                        icon=icons_pow,
                        #icon = as.character(prev_row()$icons),
                        label = as.character(row_selected$Fuel))
  }
  # set new value to reactiveVal
  prev_row(row_selected)
  print("prev_row")
  print(prev_row)
})

prox %>%
  addControl(html = html_legend, position = "bottomleft", layerId="pow_slc") %>%
  addAwesomeMarkers(
    data = pow_dt, 
    layerId = as.character(pow_dt$id),
    icon = icons_pow,
    group = "pow_slg",
    label = as.character(pow_dt$Fuel))

    observeEvent(map_marker_click(), {
    clickId <- map_marker_click()$id
    dataTableProxy("vector_table") %>%
    selectRows(which(pow_dt$id == clickId)) %>%
    selectPage(which(input$vector_table_rows_all == clickId) %/% input$vector_table_state$length + 1)
})

 } else {
  prox %>% clearGroup("pow_slg") %>% removeControl(layerId="pow_slc")
}
})
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...