如果动态更改数据集，闪亮的中断

Question

我正在尝试创建一个闪亮的应用程序，根据数据集，ggvis 将创建一个散点图。该应用程序在开始时运行良好。但是如果我尝试将数据集更改为 mtcars，那么闪亮就会消失。

我的 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")
})

我尝试了很多方法，但仍然卡住了。任何帮助将不胜感激。

Answer 1

我在 cmets 中留下了一些指示，但似乎 ggvis 很早就评估了所有内容，因此需要一些测试用例。

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)

岩石的输出 1 mtcars 的输出 2