Search code examples
rggplot2shinyshiny-serverggvis

Shiny breaks if dynamically change datasets

I am trying to create a shiny app where depending on the dataset, ggvis will create a scatter plot. The app works fine at the beginning. But if I try to change the dataset to mtcars, shiny just disappears.

My ui.R -

library(ggvis)
library(shiny)
th.dat <<- rock

shinyUI(fluidPage(


  titlePanel("Reactivity"),

  sidebarLayout(
    sidebarPanel(

      selectInput("dataset", "Choose a dataset:", 
                  choices = c("rock", "mtcars")),
      selectInput("xvar", "Choose x", choices = names(th.dat), selected = names(th.dat)[1]),
      selectInput("yvar", "Choose y", choices = names(th.dat), selected = names(th.dat)[2]),
    selectInput("idvar", "Choose id", choices = names(th.dat), selected = names(th.dat)[3])

    ),


    mainPanel(
ggvisOutput("yup")



    )
  )
))

server.R - 

  library(ggvis)
library(shiny)
library(datasets)

shinyServer(function(input, output, session) {

  datasetInput <- reactive({
    switch(input$dataset,
           "rock" = rock,
           "mtcars" = mtcars)

  })


  obs <- observe({
    input$dataset
    th.dat <<- datasetInput()
    s_options <- list()
    s_options <- colnames(th.dat)

    updateSelectInput(session, "xvar",
                      choices = s_options,
                      selected = s_options[[1]]
    )
    updateSelectInput(session, "yvar",
                      choices = s_options,
                      selected = s_options[[2]]
    )
    updateSelectInput(session, "idvar",
                      choices = s_options,
                      selected = s_options[[3]]
    )
  })

  xvarInput <- reactive({
    input$dataset
    input$xvar

    print("inside x reactive," )
    print(input$xvar)

    xvar <- input$xvar
  })

  yvarInput <- reactive({
    input$dataset
    input$yvar

    print("inside y reactive,")
    print(input$yvar)

    yvar <- input$yvar
  })


  dat <- reactive({

    dset <- datasetInput()
    xvar <- xvarInput()
#    print(xvar)
    yvar <- yvarInput()
#    print(yvar)

    x <- dset[, xvar]
    y <- dset[,yvar]
    df <- data.frame(x = x, y = y)
  })

  dat %>%
    ggvis(~x, ~y) %>%
    layer_points() %>%
    bind_shiny("yup")
})

I have tried many ways, but still stuck. Any help will be greatly appreciated.

Solution

  • I left some pointers in the comments but it seems that ggvis evaluates everything quite early so there is a need for some test cases.

    rm(list = ls())
library(shiny)
library(ggvis)

ui <- fluidPage(
  titlePanel("Reactivity"),
  sidebarPanel(
    selectInput("dataset", "Choose a dataset:", choices = c("rock", "mtcars")),
    uiOutput("xvar2"),uiOutput("yvar2"),uiOutput("idvar2")),
    mainPanel(ggvisOutput("yup"))
)

server <- (function(input, output, session) {

  dataSource <- reactive({switch(input$dataset,"rock" = rock,"mtcars" = mtcars)})

  # Dynamically create the selectInput
  output$xvar2 <- renderUI({selectInput("xvar", "Choose x",choices = names(dataSource()), selected = names(dataSource())[1])})
  output$yvar2 <- renderUI({selectInput("yvar", "Choose y",choices = names(dataSource()), selected = names(dataSource())[2])})
  output$idvar2 <- renderUI({selectInput("idvar", "Choose id",choices = names(dataSource()), selected = names(dataSource())[3])})

  my_subset_data <- reactive({        

    # Here check if the column names correspond to the dataset
    if(any(input$xvar %in% names(dataSource())) & any(input$yvar %in% names(dataSource())))
    {
      df <- subset(dataSource(), select = c(input$xvar, input$yvar))
      names(df) <- c("x","y")
      return(df)
    }
  })

  observe({
    test <- my_subset_data()
    # Test for null as ggvis will evaluate this way earlier when the my_subset_data is NULL
    if(!is.null(test)){
      test %>% ggvis(~x, ~y) %>% layer_points() %>% bind_shiny("yup")
    }
  })
})

shinyApp(ui = ui, server = server)

    Output 1 for rocks Image 1 Output 2 for mtcars Image 2