我正在创建一个shinydashboard来帮助客户探索一些空间数据。我想要实现的UI设计允许用户在两种布局之间轻松切换：
我无法实现此设计，因为每次用户在布局之间切换时都会出现两个问题：
我的猜测是，这可能是命名空间问题，但我没有任何创建modules的经验（似乎很复杂和可怕）。
有没有人有解决这些问题的好策略？
library(dplyr)
library(shiny)
library(shinydashboard)
library(leaflet)
library(RColorBrewer)
library(DT)
header <- dashboardHeader(
title = "Example"
)
sidebar <- dashboardSidebar(
sidebarMenu(id="tabs",
fluidPage(
fluidRow(
column(1),
column(11,
checkboxInput(inputId = "show",label = "Show Data Table",value = TRUE),
p(),
actionButton("zoom","Zoom to Oz",icon = icon("search-plus")))
)
)
)
)
)
body <- dashboardBody(
fluidPage(
fluidRow(
uiOutput("content")
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$map <- renderLeaflet({
pal <- colorNumeric("Set2", quakes$mag)
leaflet(quakes) %>% addTiles() %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
)
})
output$table <- DT::renderDataTable({
quakes %>% select(lat,long,mag) %>% DT::datatable()
})
observeEvent(input$zoom,{
leafletProxy(mapId = "map",data = quakes$mag) %>%
setView(132.166667, -23.033333, zoom = 4)
})
output$content <- renderUI({
makeCol_table <- function(){
column(4,
box(title = "",width = 12,height = "100%",
DT::dataTableOutput("table"))
)
}
makeCol_map8 <- function(){
column(8,
box(title = "",width = 12,height = "100%",
leafletOutput("map",height = "600px"))
)
}
makeCol_map12 <- function(){
column(12,
box(title = "",width = 12,height = "100%",
leafletOutput("map",height = "600px"))
)
}
fluidRow(
if(input$show == T)({makeCol_table()})else ({NULL}),
if(input$show == T)({makeCol_map8()}) else ({makeCol_map12()})
)
})
}
shinyApp(ui,server)
> sessionInfo()
R version 3.2.3 (2015-12-10)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X 10.11.3 (El Capitan)
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets
[6] methods base
other attached packages:
[1] dplyr_0.4.3 shinydashboard_0.5.1
[3] DT_0.1.39 RColorBrewer_1.1-2
[5] leaflet_1.0.1.9003 shiny_0.13.1
loaded via a namespace (and not attached):
[1] Rcpp_0.12.3 magrittr_1.5 munsell_0.4.3
[4] colorspace_1.2-6 xtable_1.8-2 R6_2.1.2
[7] plyr_1.8.3 tools_3.2.3 parallel_3.2.3
[10] DBI_0.3.1 htmltools_0.3 lazyeval_0.1.10
[13] yaml_2.1.13 digest_0.6.9 assertthat_0.1
[16] htmlwidgets_0.6 rsconnect_0.4.1.11 mime_0.4
[19] scales_0.4.0 jsonlite_0.9.19 httpuv_1.3.3
答案 0 :(得分：3)
我重新编写了您的应用，以便使用@daattali的精彩shinyjs套餐。我还删除了一些格式只是为了缩短它。
最终，我们可以使用javascript hide和show方法来隐藏包含您的表格的方框。
另请注意，我已将您的地图和表格移至ui。
library(dplyr)
library(shiny)
library(shinydashboard)
library(leaflet)
library(RColorBrewer)
library(DT)
library(shinyjs)
header <- dashboardHeader(
title = "Example"
)
sidebar <- dashboardSidebar(
sidebarMenu(id="tabs",
checkboxInput(inputId = "show",label = "Show Data Table",value = TRUE),
p(),
actionButton("zoom","Zoom to Oz", icon = icon("search-plus")
)
)
)
body <- dashboardBody(
## Initialise shinyjs
useShinyjs(),
div(id = "box_table-outer",
box(id = "box_table",
title = "",
width = 12,
height = "100%",
DT::dataTableOutput("table")
)
),
box(title = "",
width = 12,
height = "100%",
leafletOutput("map",
height = "600px")
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$map <- renderLeaflet({
pal <- colorNumeric("Set2", quakes$mag)
leaflet(quakes) %>%
addTiles() %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
)
})
output$table <- DT::renderDataTable({
quakes %>%
select(lat,long,mag) %>%
DT::datatable()
})
observeEvent(input$zoom, {
leafletProxy(mapId = "map",data = quakes$mag) %>%
setView(132.166667, -23.033333, zoom = 4)
})
## use shinyjs functions to show/hide the table box
## dependant on the check-box
observeEvent(input$show, {
if(input$show){
show(id = "box_table-outer")
}else{
hide(id = "box_table-outer")
}
})
}
shinyApp(ui,server)