Shiny breaks if dynamically change datasets - r

Question

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.

Answer 1

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
Output 2 for mtcars