10

I have the following code. Is there any way to write it in a loop or vectorized statement like lapply? In my real code, I have even more brushes so this will be pretty helpful. Thanks.

Ignore this line. Just need to add some more texts.

observeEvent(input$brush_1,{
  Res=brushedPoints(D(),input$brush_1,allRows = TRUE)
  vals$keeprows = Res$selected_
  })

observeEvent(input$brush_2,{
  Res=brushedPoints(D(),input$brush_2,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_3,{
  Res=brushedPoints(D(),input$brush_3,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_4,{
  Res=brushedPoints(D(),input$brush_4,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_5,{
  Res=brushedPoints(D(),input$brush_5,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_6,{
  Res=brushedPoints(D(),input$brush_6,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_7,{
  Res=brushedPoints(D(),input$brush_7,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_8,{
  Res=brushedPoints(D(),input$brush_8,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_9,{
  Res=brushedPoints(D(),input$brush_9,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_10,{
  Res=brushedPoints(D(),input$brush_10,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_11,{
  Res=brushedPoints(D(),input$brush_11,allRows = TRUE)
  vals$keeprows = Res$selected_

})

observeEvent(input$brush_12,{
  Res=brushedPoints(D(),input$brush_12,allRows = TRUE)
  vals$keeprows = Res$selected_

})
John
  • 1,779
  • 3
  • 25
  • 53

1 Answers1

16

observeEvent works great in lapply :

library("shiny")
ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      lapply(
        X = 1:6,
        FUN = function(i) {
          sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
        }
      )
    ),
    column(
      width = 6,
      verbatimTextOutput(outputId = "test")
    )
  )
)
server <- function(input, output){

  vals <- reactiveValues()

  lapply(
    X = 1:6,
    FUN = function(i){
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    }
  )

  output$test <- renderPrint({
    reactiveValuesToList(vals)
  })
}
shinyApp(ui = ui, server = server)

EDIT : for previous version of shiny, use this in server (add assign) :

lapply(
  X = 1:6,
  FUN = function(i){
    assign(
      paste0("obs", i),
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    )
  }
)
Victorp
  • 13,636
  • 2
  • 51
  • 55
  • I found that this code works in shiny_0.14.1(windows 7) but not in shiny_0.13.1(Redhat). Do you think it's related to packages versions or operation systems? – John Nov 01 '16 at 08:45
  • In shiny_0.13.1(Redhat, R version 3.1.3 ), the `lapply` works for the `sliderInput`s but not for `observeEvent`s. – John Nov 01 '16 at 08:46
  • I don't have this specific version, I've tested with shiny 0.13.2 (R 3.2.0, redhat) it works, and with shiny 0.12.2 (R 3.0.2, redhat) it doesn't work, but with my edit it works. – Victorp Nov 02 '16 at 10:47
  • Thanks, I changed it to `for` loop, which works in all versions. – John Nov 03 '16 at 07:47
  • Just tested -- lapply does work great where for loops seem to fail. Must have something to do with the protected function environment of lapply. – Taylor White Dec 08 '21 at 18:19