Shiny googleVis GeoChart not displaying with reactive switch

问题

I have trolled the internet for about a day trying to resolve this issue. I have a shiny application where the user can switch databases out the output is displayed in a googleVis geochart. The chart renders perfectly without the switch being used, but once the switch is used in the UI the chart dispears. I have temporarily resolved the issue with an actionButton and an eventReactive statement, but that means the user has to hit the button for the chart to refresh (not optimal). I am concerned if this is an issue with googleVis or just an error in my code somewhere. I can tell you that the dygraph works perfectly with the switch which leads me to believe it is googleVis. Here is my UI

sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("State Data Table", 
         tabName = "state", 
         icon = icon("dashboard")),
menuItem("State Complaint Map",
         tabName = "MAP",
         icon = icon("bar-chart-o")),
menuItem("Daily Data Table",
         tabName = "Day", 
         icon = icon("dashboard")),
menuItem("Daily Time Series Plot",
         tabName = "TZ",
         icon = icon("bar-chart-o")),
selectInput("data",
            "Data View",
            choices=c("Product","Sub Product"),
            multiple=FALSE),
uiOutput("input1"),
fluidRow(column(width=1),
         actionButton("generate","Generate State Plot"))
)
)

body <- dashboardBody(
tabItems(
tabItem(tabName = "state",
        h2("State Data Table"),
        DT::dataTableOutput("state")
),

tabItem(tabName ="Day",
        h2("Daily Data table"),
        DT::dataTableOutput("day")),

tabItem(tabName="MAP",
        h2("State Map"),   
        htmlOutput("StatePlot")),

tabItem(tabName="TZ",
        h2("Time Series Plot"),

        fluidRow(
          column(width=4),
          column(width=4,
                 box(width=NULL,
                     uiOutput("input2")))),
        box(width=12,
            dygraphOutput("DYEGRAPH1")))
)
)


ui <- dashboardPage(
dashboardHeader(title = "CFPB Complaints"),
sidebar,
body
)

Here is my server.R

server <- function(input, output) {

ProductView.st <- reactive({
switch(input$data,
       "Product"=cfpb.st,
       "Sub Product"=cfpb.st.sp)
})

ProductView.ts <- reactive({
switch(input$data,
       "Product"=cfpb.ts,
       "Sub Product"=cfpb.ts.sp)
})

output$input1 <- renderUI({
if(is.null(input$data))
  return(NULL)
Var <- ProductView.st()
selectInput("product",
          "Select Product for State Map",
          choices=levels(Var$Product),
          multiple=FALSE)
})

output$input2 <- renderUI({
if(is.null(input$data))
  return(NULL)
Var <- ProductView.ts()
selectInput("product2",
            "Select Product",
            choices=levels(Var$Product),
            multiple=FALSE)
})

output$day <- DT::renderDataTable({
datatable(ProductView.ts(),extensions = 'TableTools',    
rownames=FALSE,class = 'cell-border stripe',filter="top",
          options = list(
            searching=TRUE,
            autoWidth=TRUE,
            paging=TRUE,
            "sDom" = 'T<"clear">lfrtip',
            "oTableTools" = list(
              "sSwfPath" = "//cdnjs.cloudflare.com/ajax/libs/datatables- 
 tabletools/2.1.5/swf/copy_csv_xls.swf",
              "aButtons" = list(
                "copy",
                "print",
                list("sExtends" = "collection",
                     "sButtonText" = "Save",
                     "aButtons" = c("csv","xls"))))))
 })

 output$state <- DT::renderDataTable({
 datatable(ProductView.st(),extensions = 'TableTools',    
 rownames=FALSE,class = 'cell-border stripe',filter="top",
          options = list(
            searching=TRUE,
            autoWidth=TRUE,
            paging=FALSE,
            "sDom" = 'T<"clear">lfrtip',
            "oTableTools" = list(
              "sSwfPath" = "//cdnjs.cloudflare.com/ajax/libs/datatables-
 tabletools/2.1.5/swf/copy_csv_xls.swf",
              "aButtons" = list(
                "copy",
                "print",
                list("sExtends" = "collection",
                     "sButtonText" = "Save",
                     "aButtons" = c("csv","xls"))))))
  })

  plot1 <- eventReactive(input$generate,{
  state <- ProductView.st()
  state <- subset(state,Product == input$product)
  state
  })



  output$StatePlot <- renderGvis({
  gvisGeoChart(plot1(),"State","Complaints To Population *    
  10000",options=list(region="US", 
                                                                               displayMode="regions", 
                                                                               resolution="provinces",
                                                                               height=650,width=1100))

  })



  dygraph1 <- reactive({
  if(is.null(input$data))
  return(NULL)
  t <- ProductView.ts()
  t$Date.received <- as.Date(t$Date.received,format="%Y-%m-%d")
  t <- t[t$Product == input$product2,]
  t <- t[,-2]
  t <- as.xts(t,order.by=t$Date.received)
  t
  })

  output$DYEGRAPH1 <- renderDygraph({
  dygraph(dygraph1(),main="Complaints since 2012") %>%
  dyAxis("y",label = "Number of Complaints") %>%
  dyRangeSelector()
  })

  }
  shinyApp(ui, server)

回答1:

I seem to have solved this issue on my own using Sys.sleep(0.3) before the gvisGeoChart function. I am curious as to why I would need to delay the rendering of a googleVis chart on a switch?

来源：https://stackoverflow.com/questions/33530066/shiny-googlevis-geochart-not-displaying-with-reactive-switch

标签

Shiny

googlevis