Shiny R：带有“输入”数据选择的交互式切换输出答案

【问题标题】：Shiny R: Interactive toggle output with `input` data selectionShiny R：带有“输入”数据选择的交互式切换输出
【发布时间】：2016-12-14 19:27:09
【问题描述】：

我对交互式切换闪亮应用的数据选择有疑问。我想从selectInput 中选择数据，但错误提示：没有活动的反应上下文就不允许操作。（你试图做一些只能在反应式表达式或观察者内部完成的事情。）

有没有办法让数据与输入交互？

谢谢！

这是我的应用程序：

app.r:

ui <- fluidPage(
fluidRow(
column(width = 6,
       selectInput("vsselection", "Choose a vs:", 
                   choices = names(table(data.frame(mtcars$vs))),selected=0),
       plotOutput("plot1", height = 350,
                  click = "plot1_click",
                  brush = brushOpts(
                    id = "plot1_brush"
                  )
       ),
       actionButton("exclude_toggle", "Toggle points"),
       actionButton("exclude_reset", "Reset")
  )
 )
)

server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(mtcars[which(mtcars$vs==input$vsselection),]))
)

output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep    <- mtcars[which(mtcars$vs==input$vsselection),][ vals$keeprows, ,  drop = FALSE]
exclude <- mtcars[which(mtcars$vs==input$vsselection),][!vals$keeprows, , drop = FALSE]

 ggplot(keep, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = lm, fullrange = TRUE, color = "black") +
  geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
  coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
 })

# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mtcars[which(mtcars$vs==input$vsselection),],  input$plot1_click, allRows = TRUE)

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

# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mtcars[which(mtcars$vs==input$vsselection),],  input$plot1_brush, allRows = TRUE)

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

# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE,  nrow(mtcars[which(mtcars$vs==input$vsselection),]))
})

}

shinyApp(ui, server)

【问题讨论】：

标签： r shiny toggle

【解决方案1】：

我想你应该做的第一件事是将vals更改为vals <- reactive({...})，然后在引用它时添加括号，例如vals()$keeprows。这应该可以解决反应性问题。

【讨论】：

嗨，@Maria，非常感谢您的回复。但我得到错误说$ operator is invalid for atomic vectors。我不确定我们是否可以将reactiveValues() 更改为reactive()。

【解决方案2】：

最后，我通过保留Vals 的交互部分从reactiveValues() 的对象中删除交互部分来解决这个问题。

请注意，从 reactiveValues 对象获取的值是响应式的，但 reactiveValues 对象本身不是。

这是我的应用程序：

app.r:

ui <- fluidPage(
fluidRow(
column(width = 6,
       selectInput("vsselection", "Choose a vs:", 
                   choices =   names(table(data.frame(mtcars$vs))),selected=0),
       plotOutput("plot1", height = 350,
                  click = "plot1_click",
                  brush = brushOpts(
                    id = "plot1_brush"
                  )
       ),
       actionButton("exclude_toggle", "Toggle points"),
       actionButton("exclude_reset", "Reset")
  )
)
)

server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(mtcars))
)

output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep    <- mtcars[which(mtcars$vs==input$vsselection),][ vals$keeprows, ,   drop = FALSE]
exclude <- mtcars[which(mtcars$vs==input$vsselection),][!vals$keeprows, , drop = FALSE]

 ggplot(keep, aes(wt, mpg)) + geom_point(color = "blue") +
  geom_smooth(method = lm, fullrange = TRUE, color = "black") +
  geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha =  0.25) 
})

# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mtcars[which(mtcars$vs==input$vsselection),],  input$plot1_click, allRows = TRUE)

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

# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mtcars[which(mtcars$vs==input$vsselection),],  input$plot1_brush, allRows = TRUE)

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

# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE,   nrow(mtcars[which(mtcars$vs==input$vsselection),]))
})

}

【讨论】：