根据上一个小部件的选择显示动态生成的 'selectizeInput' 小部件的选择

Question

我正在尝试构建一个闪亮的应用程序，当用户按下“+”按钮时，它会生成具有多个 selectInput 或 selectizeInput 小部件的行，并在他按下“-”按钮时删除这些行。下图显示了我现在所取得的成就：

我闪亮的应用程序现在的样子：https://imgur.com/uQfdJrv

我的问题是我找不到一种方法来在新行中显示与前一行中的小部件具有相同选定值的小部件。事实上，用户可能只想更改某些输入的值而不要更改其他输入的值。

参照上图，假设用户在第一次测试中选择 "Amikacin" 作为抗生素，选择“5”作为 AMR。第二个测试总是用 "Amikacin" 但他得到的 AMR 值为 10。按下“+”按钮后的新输入必须立即显示 "Amikacin" 和“5”，然后是用户只需将第二行的“5”更改为“10”。

这是我用过的代码：


library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

br(),

useShinyjs(),

  fluidRow(
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "minus",
                                     lib = "font-awesome")),
           div(style = "display: inline-block;
                        padding: 0px 10px;",
               h5("Add or remove an antimicrobial resistance test")),
           tags$div(id = "amr_test_placeholder")
    )
  ),

br()

)

###= SERVER
server <- function(input, output, session) {

  Antibiotics_name <- c("", "Amikacin", "Ampicillin", "Tetracycline")

  observe({

    toggleState(id = "remove_amr_test",
                condition = input$add_amr_test > input$remove_amr_test)

  })

  amr_test_values <- reactiveValues(val = 0)

  ###= Add ui
  observeEvent(input$add_amr_test, {

    amr_test_divId <- length(amr_test_values$val) + 1

    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(
        id = amr_test_divId,
        fluidRow(

          br(),

          column(width = 3,
                 selectizeInput(inputId = paste0("drug_",
                                                 input$add_amr_test - input$remove_amr_test),
                                label = h5(paste0("Antibiotic ",
                                                  input$add_amr_test - input$remove_amr_test)),
                                choices = Antibiotics_name,
                                selected = "")
          ),
          column(width = 1,
                 selectizeInput(inputId = paste0("rescom_",
                                                 input$add_amr_test - input$remove_amr_test),
                                label = h5(paste0("AMR ",
                                                  input$add_amr_test - input$remove_amr_test)),
                                choices = c("",
                                            seq(from = 1,
                                                to = 100,
                                                by = 1)),
                                selected = "")
          )
        )
      )
    )

    amr_test_values$val <- c(amr_test_values$val,
                             amr_test_divId)

  })

  ###= Remove ui
  observeEvent(input$remove_amr_test, {

    removeUI(

      selector = paste0('#', amr_test_values$val[length(amr_test_values$val)])

    )

    amr_test_values$val <- amr_test_values$val[-length(amr_test_values$val)]

  })

}



###= RUN APP
shinyApp(ui = ui, server = server)

最后，这是一张图片，用户按下“+”按钮生成第二行小部件后获得的预期结果。

预期结果示例：https://imgur.com/NIpOZOE

最后一个问题：一旦用户的每个小部件都具有特定值，将所有这些值存储在数据框中的最佳方式是什么？

非常感谢。

Answer 1

请参阅下面的第一个问题：

library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

br(),

useShinyjs(),

  fluidRow(
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "minus",
                                     lib = "font-awesome")),
           div(style = "display: inline-block;
                        padding: 0px 10px;",
               h5("Add or remove an antimicrobial resistance test")),
           tags$div(id = "amr_test_placeholder")
    )
  ),

br()

)

###= SERVER
server <- function(input, output, session) {

  Antibiotics_name <- c("", "Amikacin", "Ampicillin", "Tetracycline")

  observe({

    toggleState(id = "remove_amr_test",
                condition = input$add_amr_test > input$remove_amr_test)

  })

  amr_test_values <- reactiveValues(val = 0)

  ###= Add ui
  observeEvent(input$add_amr_test, {

    amr_test_divId <- length(amr_test_values$val) + 1

    # Simplified input_number here and code to obtain previous values if they exist
    input_number <- input$add_amr_test - input$remove_amr_test
    if (!is.null(eval(parse(text = paste0("input$drug_", input_number - 1))))) {
        drug_value = eval(parse(text = paste0("input$drug_", input_number - 1)))
    } else {
        drug_value = ""
    }
    if (!is.null(eval(parse(text = paste0("input$rescom_", input_number - 1))))) {
        rescom_value = eval(parse(text = paste0("input$rescom_", input_number - 1)))
    } else {
        rescom_value = ""
    }

    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(
        id = amr_test_divId,
        fluidRow(

          br(),

          column(width = 3,
                 selectizeInput(inputId = paste0("drug_",
                                                 input_number),
                                label = h5(paste0("Antibiotic ",
                                                  input_number)),
                                choices = Antibiotics_name,
                                selected = drug_value)
          ),
          column(width = 1,
                 selectizeInput(inputId = paste0("rescom_",
                                                 input_number),
                                label = h5(paste0("AMR ",
                                                  input_number)),
                                choices = c("",
                                            seq(from = 1,
                                                to = 100,
                                                by = 1)),
                                selected = rescom_value)
          )
        )
      )
    )

    amr_test_values$val <- c(amr_test_values$val,
                             amr_test_divId)

  })

  ###= Remove ui
  observeEvent(input$remove_amr_test, {

    removeUI(

      selector = paste0('#', amr_test_values$val[length(amr_test_values$val)])

    )

    amr_test_values$val <- amr_test_values$val[-length(amr_test_values$val)]

  })

}



###= RUN APP
shinyApp(ui = ui, server = server)

根据上一个小部件的选择显示动态生成的 'selectizeInput' 小部件的选择

Display the selected choice of a dynamically generated 'selectizeInput' widget based on the selected choice of previous widget

r

input

shiny

reactive

shinyapps