r - 根据先前小部件的选定选项显示动态生成的“selectizeInput”小部件的选定选项

Question

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

我闪亮的应用程序现在看起来如何：https ://imgur.com/uQfdJrv

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

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

这是我使用的代码：

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

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

非常感谢。

标签： rinputshinyreactiveshinyapps

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)