Блог

Главная - Вопросы по программированию - R Блестящий: как написать цикл для observeEvent

R Блестящий: как написать цикл для observeEvent

#r #loops #shiny #lapply

#r #циклы #блестящий #lapply

Вопрос:

У меня есть следующий код. Есть ли какой-нибудь способ записать это в цикле или векторизованном операторе, таком как lapply? В моем реальном коде у меня еще больше кистей, так что это будет очень полезно. Спасибо.

Игнорируйте эту строку. Просто нужно добавить еще несколько текстов.

 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_

})

Ответ №1:

observeEvent отлично работает в 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)

РЕДАКТИРОВАТЬ : для предыдущей версии shiny используйте это на сервере (добавить 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)]]
      })
    )
  }
)

Комментарии:

1. Я обнаружил, что этот код работает в shiny_0.14.1 (Windows 7), но не в shiny_0.13.1 (Redhat). Как вы думаете, это связано с версиями пакетов или операционными системами?

2. В shiny_0.13.1 (Redhat, R версии 3.1.3) lapply работает для sliderInput s, но не для observeEvent s.

3. У меня нет этой конкретной версии, я тестировал с shiny 0.13.2 (R 3.2.0, redhat), она работает, а с shiny 0.12.2 (R 3.0.2, redhat) она не работает, но с моей правкой она работает.

4. Спасибо, я изменил его на for loop, который работает во всех версиях.

5. Только что протестировал — lapply отлично работает там, где циклы for, похоже, терпят неудачу. Должно быть, это как-то связано с защищенной функциональной средой lapply.

Метки: