2017-10-02 1 views
3

私は、ボタンを追加または削除すると、複数の反応要素が影響を受けるような光沢のあるアプリケーションを作成しています。私は以下にしようとしていることを大幅に単純化しました。基本的には、selectInput()とtextInput()ボックスを並べて、textInput()ボックスにselectInput()ボックスのユーザーが選択した結果が表示されるようにします。次に、追加ボタンをクリックして、ボタンをクリックすると、次の行の下に新しいselectInput()とtextInput()ボックスが並んで表示されます。上記のように、新しい行のtextInput()ボックスには、新しい行のselectInput()ボックスのユーザーが選択した結果が表示されます。R Shiny:追加/削除ボタンのコンテキストで複数の要素を反応させるにはどうすればよいですか?

問題は、新しいseletInput()ボックスの新しい値を参照できることです。 get()参照を使用することはできません。新しいボックスが追加されたり削除されたりすると、これらの値を参照できる反復的な方法が必要です。連続するselectInput()ボックスの結果への参照を正常に呼び出すにはどうすればよいですか?

suppressWarnings(library(shiny)) 
suppressWarnings(library(shinyFiles)) 


ui <- function(request) { 
    fluidPage(
     fluidRow(
      column(2, 
       uiOutput("ui1") 
      ), 
      column(2, 
       uiOutput("ui2") 
      ), 
      column(1, 
       actionButton(inputId = 'insertParamBtn', label = "Add Param") 
      ), 
      column(1, 
       actionButton(inputId = 'removeParamBtn', label = "Remove Param") 
      ) 
      ), 
     tags$div(id = 'placeholder'), 
     hr(), 
     fluidRow(column(12, verbatimTextOutput("view", placeholder = T))) 
      ) 
} 

server <- function(input, output, session) { 
    params <- reactiveValues(btn = 0) 
    output$ui1 <- renderUI({ 
     selectInput("UI1", "First UI", 
      choices = thisList, selected = 1) 
    }) 
    output$ui2 <- renderUI({ 
     textInput("UI2", "Second UI", value = input$UI1, width = '150px') 
    }) 

    observeEvent(input$insertParamBtn, { 
     params$btn <- params$btn + 1 
     insertUI(
      selector = '#placeholder', 
     ## wrap element in a div with id for ease of removal 
      ui = tags$div(
       id = paste0('param', params$btn + 1), 
        tags$p(fluidRow(
         column(2, 
          selectInput(paste0("UI1", params$btn + 1), 
             paste0("First UI ", params$btn + 1), 
             choices = thisList, selected = 1) 
           ), 
         column(2, 
          textInput(paste0("UI2", params$btn + 1), #*# 
           paste0("Second UI ", params$btn + 1), #*# 
           value = get(paste0("input$UI1", params$btn + 1)), #*# 
            width = '150px') #*# 
           ) 
           ) 
          ) 
          ) 
          ) 
    output$view <- renderPrint({ get(paste0("UI1", params$btn + 1)) }) 
    }) 

    observeEvent(input$removeParamBtn, { 
    removeUI(
    ## pass in appropriate div id 
      selector = paste0('#param', params$btn + 1) 
       ) 
    params$btn <- params$btn - 1 
    }) 

    } 
    shinyApp(ui = ui, server = server) 
+1

コードに問題があるようです。オブジェクト 'thislist'はどこにも定義されていませんが、アプリケーションで2回使用されます。 –

+0

thisList < - as.list(c(1,2,3,4,5)、c(1,2,3,4,5)) –

+0

申し訳ありませんが、まずその行をコピーするのを忘れてしまいました。ヘッドアップありがとう –

答えて

1

これはあなたが望むものであるならば、私はわからないが、次のアプローチは、2つbuttronsを介して入力ペアを追加/削除します。モジュールのUI側の機能を:まず、私は新しいUIがすでにselectorUIを使用して選択・デュオのためのshiny module

thisList <- as.list(c(1, 2, 3, 4, 5), c(1, 2, 3, 4, 5)) 

suppressWarnings(library(shiny)) 

selectorUI <- function(id){ 
    ns = NS(id) 

    tags$div(
    fluidRow(
     column(6, uiOutput(ns('first'))), 
     column(6, uiOutput(ns('second'))) 
    ), 
    id = paste0('param', id) 
) 
} 

selectorServer <- function(input, output, session){ 
    ns = session$ns 

    output$first <- renderUI({ 
    selectInput(
     ns('first'), 
     ns("First UI"), 
     choices = thisList, selected = 1) 
    }) 

    output$second <- renderUI({ 
    textInput(
     ns('second'), 
     ns("Second UI"), 
     value = input$first) 
    }) 
} 

を作成しました。

ui <- fluidPage(
    selectorUI(0), 
    fluidRow(
    column(6, actionButton(inputId = 'insertParamBtn', label = "Add Param")), 
    column(6, actionButton(inputId = 'removeParamBtn', label = "Remove Param")) 
), 
    tags$div(id = 'placeholder'), 
    hr(), 
    fluidRow(column(12, verbatimTextOutput("view", placeholder = T))) 
) 

サーバ側は、起動時にid=0ためのモジュールをレンダリングしid=params$buttonに新しい行が追加されるたび。

server <- function(input, output, session) { 
    callModule(selectorServer, 0) 

    params <- reactiveValues(btn = 0) 

    output$view <- renderPrint({ 
    print(input[[NS(params$btn, "first")]]) 
    print(input[[NS(params$btn, "second")]]) 
    }) 

    observeEvent(input$insertParamBtn, { 
    params$btn <- params$btn + 1 
    callModule(selectorServer, params$btn) 
    insertUI(
     selector = '#placeholder', 
     ui = selectorUI(params$btn) 
    ) 
    }) 

    observeEvent(input$removeParamBtn, { 
    removeUI(
     ## pass in appropriate div id 
     selector = paste0('#param', params$btn) 
    ) 
    params$btn <- params$btn - 1 
    })  
} 
shinyApp(ui = ui, server = server) 

あなたのコードへの重要な違いは、私は2回の別々のrenderUIselectInputのためのコールとtextInputを使用したことです。これらの2つを単一のrenderUIコールに入れると、注意しないと無限ループが作成される可能性があります。

モデルを使用してこれを書き直したという事実は、IMOの読み込みと拡張を容易にする設計上の決定に過ぎません。

関連する問題