The Problem
I am creating a shinydashboard to help a client explore some spatial data. The UI design I'd like to achieve allows the user to easily switch between two layouts:
- Map Only
- Map + Data Table
I'm having trouble implementing this design because every time the user switches between layouts two problems occur:
- The map is redrawn
- The ActionButtons break, preventing the user from exploring the data
My guess is that is may be a namespace issue, but I don't have any experience creating modules (seems complicated and scary).
Does anyone have a good strategy for resolving these issues?
Reproducible Example:
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)
Session info:
> 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
I've re-written your app so that it uses @daattali 's brilliant shinyjs package. I've also removed some of the formatting just to shorten it.
Ultimately we can make use of javascript hide and show methods to hide your box that contains your table.
Note also that I've moved your map and table to the 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)
来源：https://stackoverflow.com/questions/35808776/making-shiny-ui-adjustments-without-redrawing-leaflet-maps