Блестящие перерывы при динамическом изменении наборов данных

Я пытаюсь создать блестящее приложение, в котором в зависимости от набора данных ggvis создаст точечную диаграмму. Приложение работает нормально в начале. Но если я попытаюсь изменить набор данных на mtcars, блеск просто исчезнет.

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")



    )
  )
))

сервер.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")
})

Я пробовал много способов, но все еще застрял. Любая помощь будет оценена.


r ggplot2 shiny shiny-server ggvis
person nafizh    schedule 24.08.2015    source источник
comment
Это ломается, потому что нет dset[,xvar], а th.dat по-прежнему рок. Вы должны быстро заполнять раскрывающиеся списки при изменении набора данных. Обратите внимание, что шанс получить ответ выше, если вы примете хорошие ответы на свои предыдущие вопросы.   -  person Dieter Menne    schedule 24.08.2015
comment
Если вы опустите код ggvis, а затем измените набор данных, вы увидите, что раскрывающиеся списки изменились соответствующим образом. Проблема, на мой взгляд, в том, что значение input$xvar и input$yvar не обновляется в dat reactive, и я не знаю, как это сделать. Кроме того, я принял решение своих предыдущих проблем раньше.   -  person nafizh    schedule 24.08.2015
comment
...к одной из ваших предыдущих проблем....   -  person Dieter Menne    schedule 26.08.2015

Ответы (1)


arrow_upward
2
arrow_downward

Я оставил несколько советов в комментариях, но кажется, что 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 для камней Image 1 Вывод 2 для mtcars Изображение 2

person Pork Chop    schedule 26.08.2015
comment
Большое спасибо за ответ, это решает мою проблему. Но есть тангенциальная проблема. Я добавил связанную кисть на график, где, если я закрашиваю точку, все точки с одним и тем же идентификатором также закрашиваются одним и тем же цветом. Но это работает только в первый раз. Если я изменю переменную x или y или набор данных, это больше не сработает. У вас есть идеи, почему это происходит? - person nafizh; 28.08.2015
comment
Рад, что это работает. :) Если честно, я не так много знаю о ggvis. Я уверен, что вы можете реализовать тестовый пример с оператором if, который решит другие ваши проблемы. Вы можете опубликовать новый вопрос с подробным изложением вашей проблемы, чтобы не сделать этот вопрос слишком загроможденным. - person Pork Chop; 28.08.2015