闪亮:使用reactiveValues的ggplot交互中的反应性上下文错误

时间:2015-08-27 14:19:52

标签: r shiny

我的计划是导入一个名为rawdata的大型原始数据集,然后使用sourced scripts.R文件对数据集进行一些修改。 munged数据作为由tidyr :: gather命名为heap创建的多个数据帧的列表传递回server.R。

接下来,我要显示heap[[2]]heap[[10]]的ggplot。

使用Shiny网站上的示例情节互动,我希望能够从图中刷掉显然是异常值的点。但是,我对一个我无法调试的讨厌的反应性上下文错误感到震惊。我很确定它涉及第77到80行:

vals.temp <- reactiveValues(
if(!is.null(heap())) {
  keeprows = rep(TRUE, nrow(heap()[[2]]))
})

在Shiny网站上提供的示例中,它使用mtcars数据集,但我的是基于用户输入的反应数据集。我怀疑那里某处有脱节。

链接到文件: Dropbox

非常感谢您的专业知识!

1 个答案:

答案 0 :(得分:1)

您可以声明一个空列表vals <- reactiveValues(),然后添加一个元素some <- reactive({ ... vals$keeprows <- nrow...})

在下面的示例中,plotOutput('figure')现在是互动的。我在闪亮的画廊中使用了提到的例子。

服务器脚本的关键部分:

output$AddCustom <- renderUI(
    AddCustomInputs()
  )


  # Based on data() variables column, populate a selectInput called "subset" with variable data
  output$selector <- renderUI({
    selectInput('subset', 'Graph Parameter', choices = levels(heap()[[1]]$variable))
  })

  # Changes from here: ----------------------------------------------------------------------

  vals <- reactiveValues() # keeprows = rep(TRUE, 100000 )

  # Subset the data() set by the value selected in the "subset" selectInput and save it as df()
  df <- reactive({

    vals$keeprows <- rep(TRUE, nrow(heap()[[1]][heap()[[1]]$variable %in% input$subset, ]))

    return(heap()[[1]][heap()[[1]]$variable %in% input$subset, ])
  })


  observeEvent(input$exclude_toggle, {
    res <- brushedPoints( df(), input$figure_brush, allRows = TRUE)

    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  observeEvent(input$exclude_reset, {
    vals$keeprows <- rep(TRUE, nrow( df() ))
  })


  # create a plot based on df()
  output$figure <- renderPlot({

    keep <- df()[ vals$keeprows, , drop = FALSE ] 

    if(!is.null(df())) {
      plot <- isolate(
        ggplot(data = na.omit(keep), aes(x = NST_DATI, y = value)) + 
          geom_line() + 
          labs(x = "Date", y = input$subset, title = paste(input$subset, "vs. Date"))
      )
      return(plot)
    }
  })
  output$table <- renderDataTable(
    if(!is.null(rawdata())) {
      return(rawdata())
    }
  )
})

ui script:

shinyUI(fluidPage(
    titlePanel("Data Fix-it"),
    sidebarLayout(
      sidebarPanel(
        fileInput('rawfile', 'Input *.CSV'),
        helpText("Files downloaded from ADRS Console must be saved as *.csv for import."),
        h4("Other Parameters"),
        tags$body("Only the 'Big 7' parameters will be retained, unless specified."),
        br(),
        checkboxInput('AddCustomCheck', 'Add custom parameters'),
        uiOutput('AddCustom'),
        hr(),
        numericInput('sequnceminutes', 'Water Quality Interval (mins)', value = 60),
        actionButton('groomgo', 'Groom Data'),
        textOutput('linesaltered'),
        hr(),
        downloadButton('downloadcsv', 'Download *.csv file')
      ),
      mainPanel(
        tabsetPanel(
          tabPanel("Plot",
                   uiOutput('selector'),
                   plotOutput('figure', brush = brushOpts(id = "figure_brush")),

                   actionButton("exclude_toggle", "Toggle points"),
                   actionButton("exclude_reset", "Reset")
          ),
          tabPanel("Table",
                   dataTableOutput('heaptable')),
          tabPanel("Report",
                   actionButton('MakePlotsgo', 'Make Plots'),
                   plotOutput('heaptemp'),
                   plotOutput('heapph'),
                   plotOutput('heapcond'),
                   plotOutput('heaptds'),
                   plotOutput('heapdomgl'),
                   plotOutput('heapdosat'),
                   plotOutput('heapturb'),
                   plotOutput('heapflow'),
                   plotOutput('heapcustom1'),
                   plotOutput('heapcustom2'),
                   plotOutput('heapcustom3')
          )
        )
      )
    )))

我希望这是你想要的:)