进行闪亮的UI调整而无需重绘传单地图 [英] Making Shiny UI Adjustments Without Redrawing Leaflet Maps
问题描述
我正在创建一个闪亮的仪表盘，以帮助客户探索一些空间数据.我想要实现的UI设计允许用户轻松地在两种布局之间切换:
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:
- 仅地图
- 地图+数据表
我在实现此设计时遇到了麻烦，因为每次用户在布局之间切换时，都会出现两个问题:
I'm having trouble implementing this design because every time the user switches between layouts two problems occur:
- 地图已重绘
- ActionButtons断开，阻止用户浏览数据
我的猜测是可能是名称空间问题，但是我没有创建模块(似乎很复杂又令人恐惧).
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?
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
推荐答案
我已经重新编写了您的应用程序，以便它使用@daattali出色的
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.
最终，我们可以使用javascript hide和show方法来隐藏包含表的框.
Ultimately we can make use of javascript hide and show methods to hide your box that contains your table.
还请注意，我已经将您的地图和表格移到了ui.
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)
这篇关于进行闪亮的UI调整而无需重绘传单地图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
