Rのselectinput関数を使用して複数の変数を選択する際に複数のinputboxを表示するShiny

Question

アプリケーションの目的は、ユーザーがrshinyのselectinput関数からいくつかの変数を選択することです。その変数の重みを入力として取ります。

たとえば、selectinput関数から4つの変数を選択すると、4つの数値入力ボックスがあり、ユーザーに対応する重みを入力する必要があります。

私はselectinput関数の代わりにcheckboxオプションを使用してこれを行うことができますが、変数の数が膨大なので、チェックボックスオプションは実行可能ではありません。次のようにチェックボックスの機能にコードを使用して

は次のとおりです。

checkboxInput("pick", "Picked_up"), 
     conditionalPanel(
     condition = "input.pick == true", 
     numericInput("var1","Enter the weightage of the variable","") 
    ), 

     br(), 
     checkboxInput("c2", "%C2"), 
     conditionalPanel(
     condition = "input.c2 == true", 
     numericInput("var2","Enter the weightage of the variable","") 
    ), 
     br(), 
     checkboxInput("newfill", "Perc_Newfill"), 
     conditionalPanel(
     condition = "input.newfill == true", 
     numericInput("var3","Enter the weightage of the variable","") 
    ), 

     br(), 
     checkboxInput("rts", "%RTS"), 
     conditionalPanel(
     condition = "input.rts == true", 
     numericInput("var4","Enter the weightage of the variable","") 
    ) 

私はselectinput機能のために同じ機能を実装したい、次のように、私が試したコードは次のとおりです。

uiOutput('select_value'), 
uiOutput('input_value'), 

ui.r

server.r

output$select_value <- renderUI({ 
    selectInput('var_name','choose variables',names(descriptive_data),multiple = TRUE) 
    }) 



    runInput2<- observeEvent(input$var_name,{ 


     for(i in 1:length(input$var_name)) 
     { 
     output$input_value <- renderUI({ 
     mydata <- input$var_name[1] 
     numericInput('var', 'input weightage',"") 

     }) 
     } 
    }) 

私はRshinyを新しくしています。したがって、私が間違っていることについての提案を入力して、これをどのように実装することができるのでしょうか。

Answer 1

ここでは、問題の解決方法を示します。選択された各変数に対してnumericInputが作成されます。 forループを使用する代わりに、lapply関数を使用して、すべてのUI要素が作成されたリストを返します（複数のUI要素をグループ化するための最良の方法です）。最後に、複数のオブザーバを作成してnumericInputの値を取得しないようにするには、変数が選択されている場合にのみアクションボタンを使用して値をリカバリします。サーバー機能の開始時に、定義済みの重み値を格納するためのベクトルが作成されました。また、ユーザーによって以前に割り当てられたnumericInputの値を復元するのにも役立ちます。これは、新しい変数が選択されるたびに、mainPanelが完全にレンダリングされるために必要です。

library(shiny) 

ui <- fluidPage(
    sidebarPanel(uiOutput('select_value')), 
    mainPanel(uiOutput('input_value')) 
) 

server <- function(input , output){ 
    descriptive_data <- mtcars 
    # initial value for weights and to keep track of value 
    weightages <- rep(0, ncol(descriptive_data)) 
    # set names to simplify recover/storing value 
    names(weightages) <- names(descriptive_data) 

    output$select_value <- renderUI({ 
    div(
     selectInput('var_name', 'choose variables', 
     names(descriptive_data), multiple = TRUE), 
     actionButton("get", "Get weightages"), 
     tableOutput('table') 
    ) 
    }) 

    output$input_value <- renderUI({ 
    var_name <- input$var_name 
    if (!is.null(var_name)) { 
     # lapply will return a list 
     lapply(1:length(var_name), function(k) { 
      numericInput(paste0("var", k), 
      paste('input weightage for', 
      # assign stored value 
      var_name[k]), weightages[[var_name[k]]]) 
     }) 
    }  
    }) 

    observeEvent(input$get, { 
    # to avoid create one observer per numeric input 
    # we use a action button to trigger the recovering 
    # of weights. 
    var_name <- input$var_name 
    if (!is.null(var_name)) { 
     for(k in 1:length(var_name)) { 
     # only recover/update value is the numeric input exists 
     if (!is.null(input[[paste0("var", k)]])) 
      weightages[[var_name[k]]] <<- input[[paste0("var", k)]] 
     } 
    } 
    # show current weights 
    output$table <- renderTable(data.frame(
         variable = names(descriptive_data), 
         weightages)) 

    }) 

} 

shinyApp(ui = ui , server = server)