使用R / Shiny創建動態數量的輸入元素

Question

我正在寫一個Shiny應用程序，用於可視化我公司的保險福利計划。 這是我想要發生的事情：

• 我將有一個selectInput或sliderInput ，用戶將在其中選擇他們的醫療計划中的個人數量
• 將出現匹配數量的雙面滑塊（每個成員一個）
• 然后，他們可以輸入他們對計划中每個成員的最佳/最差病例醫療費用的估計
• 我的代碼將采用這些估算並創建並排圖表，說明三個計划產品的預測成本，以便他們可以根據他們的估算確定哪一個最便宜

這是我當前的帶有硬編碼輸入的ui.R文件，模擬一個四口之家：

shinyUI(pageWithSidebar(

  headerPanel("Side by side comparison"),

  sidebarPanel(

    selectInput(inputId = "class", label = "Choose plan type:",
                list("Employee only" = "emp", "Employee and spouse" = "emp_spouse",
                     "Employee and child" = "emp_child", "Employee and family" = "emp_fam")),

    sliderInput(inputId = "ind1", label = "Individual 1",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind2", label = "Individual 2",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind3", label = "Individual 3",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind4", label = "Individual 4",
                min = 0, max = 20000, value = c(0, 2500), step = 250)
    ),

  mainPanel(
    tabsetPanel(  
    tabPanel("Side by Side", plotOutput(outputId = "main_plot", width = "100%")),
    tabPanel("Summary", tableOutput(outputId = "summary"))
  )
)))

這就是它的樣子（透明的末端部分是兩個計划的HSA貢獻的結果。我認為這是一個很好的方式來顯示保費和醫療費用，同時顯示公司HSA貢獻的影響。因此，你我只是比較純色的長度。

我看到的例子這樣其中UI輸入本身是固定的（在這種情況下，一個checkboxGroupInput存在，但它的內容是根據從另一個UI輸入的選擇定制），但我還沒有看到剪裁多個示例（或者說，輸入元素作為另一個UI輸入內容的結果而產生的輸入元素。

對此有任何建議（甚至可能）？

---

我的最后一招是創建15個輸入滑塊並將它們初始化為零。 我的代碼工作得很好，但是我想通過不必為偶爾擁有一個非常大的家庭的用戶創建那么多滑塊來清理界面。

---

根據Kevin Ushay的回答更新

我試着去server.R路由並有這個：

shinyServer(function(input, output) {

  output$sliders <- renderUI({
    members <- as.integer(input$members) # default 2
    max_pred <- as.integer(input$max_pred) # default 5000
    lapply(1:members, function(i) {
      sliderInput(inputId = paste0("ind", i), label = paste("Individual", i),
                  min = 0, max = max_pred, value = c(0, 500), step = 100)
    })

  })

})

緊接着，我嘗試從每個人的費用中提取input值：

expenses <- reactive({
    members <- as.numeric(input$members)

    mins <- sapply(1:members, function(i) {
      as.numeric(input[[paste0("ind", i)]])[1]
    })

    maxs <- sapply(1:members, function(i) {
      as.numeric(input[[paste0("ind", i)]])[2]
    })

    expenses <- as.data.frame(cbind(mins, maxs))
})

最后，我有兩個函數創建對象來存儲數據框，以便根據低和高醫療費用估算進行繪圖。 它們被稱為best_case和worst_case並且都需要expenses對象才能工作，因此我將其稱為我的第一行，因為我從這個問題中學到了

best_case <- reactive({

    expenses <- expenses()

    ...

)}

我有一些錯誤，所以我使用browser()來逐步完成expenses並注意到input$ind1類的特殊內容似乎不存在於expenses函數中。

我還在其中使用各種print()語句來查看發生了什么。 最引人注目的是當我print(names(input))作為函數的第一行時：

[1] "class"    "max_pred" "members" 

[1] "class"    "ind1"     "ind2"     "max_pred" "members" 

我得到兩個輸出，我認為這是由於expenses的定義和隨后的調用。 奇怪的是......當worst_case使用完全相同的expenses <- expense()行時，我沒有得到第三個。

如果我在expenses函數中執行類似print(expenses)的操作，我也會得到重復：

# the first
  mins maxs
1   NA   NA
2   NA   NA

# the second
  mins maxs
1    0  500
2    0  500

關於為什么我的ind1和ind2 input元素在第二次調用expenses之前不會出現的任何提示，從而阻止正確創建數據框？

Answer 1

你可以在server.R處理UI元素的server.R ，所以你有類似的東西：

ui.R
----

shinyUI( pageWithSideBar(
    ...
    selectInput("numIndividuals", ...)
    uiOutput("sliders"),
    ...
))

和

server.R
--------

shinyServer( function(input, output, session) {

  output$sliders <- renderUI({
    numIndividuals <- as.integer(input$numIndividuals)
    lapply(1:numIndividuals, function(i) {
      sliderInput(...)
    })
  })


})

當我擁有依賴於其他UI元素的值的UI元素時，我發現在server.R生成它們最容易。

理解所有_Input函數只生成HTML是有用的。 當您想要動態生成HTML時，將其移動到server.R 。 也許值得強調的另一件事是可以在renderUI調用中返回HTML'元素' list 。

Answer 2

您可以使用以下語法從shiny中訪問動態命名的變量：

input[["dynamically_named_element"]]

因此，在上面的示例中，如果您初始化滑塊元素

# server.R

output$sliders <- renderUI({
  members <- as.integer(input$members) # default 2
  max_pred <- as.integer(input$max_pred) # default 5000
  lapply(1:members, function(i) {
    sliderInput(inputId = paste0("ind", i), label = paste("Individual", i),
                min = 0, max = max_pred, value = c(0, 500), step = 100)
  })
})

# ui.R

selectInput("num", "select number of inputs", choices = seq(1,10,1))
uiOutput("input_ui")

您可以使用以下方法將值打印到表中

# server.R

output$table <- renderTable({
    num <- as.integer(input$num)

    data.frame(lapply(1:num, function(i) {
      input[[paste0("ind", i)]]
    }))
  })

# ui.R

tableOutput("table")

請看這里有一個有效的例子。 在這里工作要點。

資料來源：Joe Cheng的第一個答案，大約是這個帖子的一半

Answer 3

您可以使用do.call和lapply生成側邊欄，例如：

# create the first input, which isn't dynamic
sel.input = selectInput(inputId = "class", label = "Choose plan type:",
            list("Employee only" = "emp", "Employee and spouse" = "emp_spouse",
                 "Employee and child" = "emp_child", "Employee and family" = "emp_fam"))

num.individuals = 5  # determine the number of individuals here

# concatenate the select input and the other inputs
inputs = c(list(sel.input), lapply(1:num.individuals, function(i) {
    sliderInput(inputId = paste0("ind", i), label = paste("Individual", i), min = 0, max = 20000, value = c(0, 2500), step = 250)
}))

sidebar.panel = do.call(sidebarPanel, inputs)