web-dev-qa-db-ja.com

R / Shinyを使用して入力要素の動的な数を作成する

私は会社で保険給付プランを視覚化するためのShinyアプリを書いています。これが実現したいことです。

  • selectInputまたはsliderInputがあります。ここで、ユーザーは自分の医療プランの個​​人数を選択します
  • 一致する数の両面スライダーが表示されます(各メンバーに1つ)
  • その後、計画の各メンバーのベスト/ワーストケース医療費の見積もりを入力できます。
  • これらの見積もりを取得し、3つのプランの提供の予測コストを示すサイドバイサイドプロットを作成するコードがあるので、見積もりに基づいてどれが最も安価かを判断できます

ハードコーディングされた入力を持つ4つのファミリをシミュレートした現在の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"))
  )
)))

外観は次のとおりです(透明な最後のセクションは、2つの計画からのHSAの貢献の結果です。会社のHSAの貢献の影響を示しながら、保険料と医療費の両方を表示する良い方法だと思いました。単色の長さを比較するだけです)。

shiny-example

例を見ました like this UI入力自体は固定です(この場合、1つのcheckboxGroupInputが存在しますが、その内容は別のUI入力からの選択に基づいて調整されます)別のUI入力のコンテンツの結果として生成される入力要素のnumber(または、たとえば、タイプ)を調整する例を見たことはありません。

これに関する提案はありますか?


私の最後の手段は、たとえば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))
})

最後に、低医療費と高医療費の見積もりに基づいてプロット用のデータフレームを保存するオブジェクトを作成する2つの関数があります。それらはbest_caseおよびworst_caseと呼ばれ、両方とも動作するexpensesオブジェクトを必要とするため、 この質問 から学んだように最初の行として呼び出します

best_case <- reactive({

    expenses <- expenses()

    ...

)}

エラーが発生したため、browser()を使用してexpensesビットをステップ実行し、expenses関数内からinput$ind1などの特殊なものが存在しないように見えることに気付きました。

また、さまざまなprint()ステートメントをいじって、何が起こっているのかを確認しました。最も顕著なのは、関数の最初の行としてprint(names(input))を実行したときです。

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

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

twoの出力が得られますが、これはexpensesの定義とそれに続く呼び出しに起因すると考えられます。奇妙なことに、worst_caseがまったく同じexpenses <- expense()行を使用している場合、3番目のメッセージは表示されません。

expenses関数内でprint(expenses)のような操作を行うと、重複も発生します。

# the first
  mins maxs
1   NA   NA
2   NA   NA

# the second
  mins maxs
1    0  500
2    0  500

inputが2回目に呼び出されるまでind1およびind2expenses要素が表示されず、データフレームが正しく作成されない理由についてのヒント

57
Hendy

server.RでUI要素の生成を処理できるため、次のようなものがあります。

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に移動するのは理にかなっています。おそらく、強調する価値のある他のことは、list呼び出しでrenderUIのHTML '要素'を返すことは問題ないということです。

45
Kevin Ushey

次の構文を使用して、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")

動作する光沢のある例については、 here を参照してください。作業要点 こちら

出典:Joe Chengの最初の回答、約半分 このスレッド

17

次のような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)
5
David Robinson