Making Shiny UI Adjustments Without Redrawing Leaflet Maps

Question

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:

1. The map is redrawn
2. 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 

Answer 1

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)