2016-10-14 2 views
4

私は以下のコードを持っています。 lapplyのようなループやベクトル化されたステートメントで書く方法はありますか?私の実際のコードでは、もっとブラシがあるので、これはかなり役に立ちます。ありがとう。R Shiny:observeEventのループを書く方法

この行は無視してください。ちょっとだけテキストを追加するだけです。

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_ 

}) 

答えて

5

observeEventlapplyに素晴らしい作品:

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:光沢のある以前のバージョンのために、(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)]] 
     }) 
    ) 
    } 
) 
+0

私はこのコードことがわかりましたshiny_0.14.1(Windows 7)では動作しますが、shiny_0.13.1(Redhat)では動作しません。パッケージのバージョンや運用システムに関係していると思いますか? – John

+0

shiny_0.13.1(Redhat、Rバージョン3.1.3)では、 'lapply'は' sliderInput'では動作しますが、 'observeEvent'では動作しません。 – John

+0

私はこの特定のバージョンを持っていません、光沢のある0.13.2(R 3.2.0、redhat)で動作しています。光沢のある0.12.2(R 3.0.2、redhat)私の編集でそれは動作します。 – Victorp

関連する問題