我正在编码一个Shiny模块,以将传单地图与数据表链接(代码基于Shiny - how to highlight an object on a leaflet map when selecting a record in a datatable?)。
我遇到的困难是将一些渲染文本(“ 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")
}
})
}