如何在rShiny中通过modalDialog迭代请求用户输入？

我已经对此进行了一周的研究/故障排除，但似乎无法解决问题

基本上，我希望通过rShiny中的对话框迭代请求用户输入。用户上传一个文件，然后按run report，如果发现任何重复项，则用户必须手动确定要选择的行

我在下面列出了两个“尝试”

第一种方法尝试通过所有已识别的重复项

dups（）

来执行

lappy

。问题是，当运行时，它会跳到最后一个模式对话框

---

第二次尝试遍历第一个dup，然后在req处暂停，等待“ok”。为此，我需要全局分配

I

；我使用

注意：这对我使用shinyalert的开发版本（1.0.0.9004）有效

我不确定您将如何在警报中包含datatable，或者什么是允许用户选择行的最直观的方式。但是，下面是一个循环列表的示例，使用
lappy
显示每个元素的警报：

库（闪亮）
图书馆（shinyalert）
ui这里是一个简短的示例应用程序，内置数据集有两组重复行（第3行和第4行以及第8行和第9行）。在本例中，循环是使用reactiveValues输入的。如果rv$循环大于1，则循环继续。“go”按钮在数据集中查找重复项，并启动循环以测试哪些行等于重复行。对于每个重复集，会启动一个modalDialogue，显示重复的行，用户可以通过selectInput决定删除哪些行

library(shiny)
library(tidyverse)

ui <- fluidPage(
  actionButton('go', "Go!"),
  h4("original dataframe"),
  tableOutput("original"),
  h4("user selected rows to filter out"),
  verbatimTextOutput("user_filtered"),
  h4("new user filtered df"),
  tableOutput('final')
)


server <- function(input, output, session) {

  data <- tibble(ID = c(1, 2, 3, 3, 3, 4, 5, 5, 5),
                 Name = c("Tom", "Jerry", "Frank", "Frank", "Frank", "Jennifer", "Terrence", "Terrence", "Terrence"),
                 Desc = c("Recent", "Recent", "Recent", "Recent","Not Recent", "Recent", "Recent", "Not Recent","Not Recent" ))

  data_indexed <- data %>% mutate(original_row = 1:length(ID))


  dups <- eventReactive(input$go, {


  df_split <- split(data, seq(nrow(data))) 

  dups_locations <- duplicated(data)

  dups <- data[which(dups_locations == T),]

  out <- vector("list")
  for(i in seq_len(nrow(dups))){
    out[[i]] <- map(df_split, ~identical(.x, dups[i,]))

  }

  return(out)
})

  rv <- reactiveValues(loop = 0, trigger = 0)

  num_iterations <- reactive({length(dups())})

  #start loops first time
  observeEvent(dups(), {
    rv$loop <- rv$loop + 1
          })

  #continues loop or stops
  duplicated_data <- eventReactive(rv$loop, {
    if(rv$loop > 0){
            data_indexed[which(dups()[[rv$loop]] == T),]
    }
  })

  output$table <- renderTable({
    duplicated_data() 
  })

  observeEvent(duplicated_data(),{
          rv$trigger <- rv$trigger + 1
  })
  observeEvent(rv$trigger, ignoreInit = TRUE, {
      showModal(modalDialog(title = "Make a Choice!",
                            "Which one to remove?",
                            tableOutput('table'),
                            selectInput('remove', "Remove this one", choices = seq_len(nrow(duplicated_data()))),
                            footer = actionButton("modal_submit", "Submit")))
  })

  remove_rows <- reactiveValues()
  #when user closes modal the response is saveed to           #remove_rows[[character representing number of itteration]]
  observeEvent(input$modal_submit, {
    remove_rows[[as.character(rv$loop)]] <- duplicated_data()$original_row[[as.numeric(input$remove)]]
    if(rv$loop < num_iterations()){
      rv$loop <- rv$loop + 1 #this retriggers step2 to go again
    } else {
      rv$done <- rv$done + 1
    } #breaks the disjointed loop and trigger start of next reactions
  })

  observeEvent(rv$done, {
    rv$loop <- 0 
  })

  #and the modal is closed
  observeEvent(input$modal_submit, {
    removeModal()
  })

  final_choice <- eventReactive(rv$done, ignoreInit = TRUE,{
    remove <- unlist(isolate(reactiveValuesToList(remove_rows)), use.names = F)
     # data[-as.numeric(remove),]


  })

  output$original <- renderTable({
    data
  })

  output$user_filtered <- renderText({
    final_choice()
  })

   output$final <- renderTable({
     data_indexed[-final_choice(),]
   })

}

shinyApp(ui, server)

库（闪亮）
图书馆（tidyverse）
用户界面
shinyApp(
  ui = basicPage(
    fileInput(
      inputId = "xlsx",
      label = "Upload File here",
      multiple = TRUE,
      accept = ".xlsx"
  ),
  actionButton("runReport", "Run Report")
),

server = function(input, output) {
  # Import Dataset
  dataset <- reactive({
    read.xlsx(input$xlsx$datapath)
  })

  observeEvent(input$xlsx, {
    print(dataset())
  })

  dups <- eventReactive(input$runReport, {
    unique(dataset()$ID[duplicated(dataset()$ID) |
                          duplicated(dataset()$ID)])

  })

  # Try # 1

  lapply(
    X = 1:2,
    FUN = function(i) {
      observeEvent(dups()[[i]], {
        # Show modal in client browser
        showModal(
          # Create UI for modal dialog
          modalDialog(
            title = "Multiple Options Found: Choose One",
            DT::renderDT(DT::datatable(dataset()[dataset()$ID == dups()[[i]],])),

            numericInput(paste0("optionRow", i), "Choose Row", NULL),

            footer = tagList(modalButton("Cancel"),
                             actionButton(paste0("ok", i), "OK"))

          )
        )

      })

      observeEvent(input[[paste0("ok", i)]], {
        print(input[[paste0("optionRow", i)]]) # choice assignment
        removeModal()

      })

    }
  )

  # Try #2

  observeEvent(dups(), {
    for (i in seq_along(dups())) {
      modalInstance <- function(x) {
        # Create UI for modal dialog
        modalDialog(
          title = "Multiple Options Found: Choose One",
          DT::renderDT(DT::datatable(dataset()[dataset()$ID == dups()[[x]],])),

          numericInput(paste0("optionRow", x), "Choose Row", NULL),

          footer = tagList(modalButton("Cancel"),
                           actionButton(paste0("ok", x), "OK"))

        )
      }

      cur <- modalInstance(i)

      showModal(cur)

      i <<- i

      # Need an outside call to fulfill requirement but continue loop
      print(!is.null(input[[paste0("ok", i)]]))
      req(!is.null(input[[paste0("ok", i)]]))

    }

  })

  observeEvent(input[[paste0("ok", i)]], {
    print(input[[paste0("optionRow", i)]]) # choice assignment
    removeModal()

  })

})

library(shiny)
library(tidyverse)

ui <- fluidPage(
  actionButton('go', "Go!"),
  h4("original dataframe"),
  tableOutput("original"),
  h4("user selected rows to filter out"),
  verbatimTextOutput("user_filtered"),
  h4("new user filtered df"),
  tableOutput('final')
)


server <- function(input, output, session) {

  data <- tibble(ID = c(1, 2, 3, 3, 3, 4, 5, 5, 5),
                 Name = c("Tom", "Jerry", "Frank", "Frank", "Frank", "Jennifer", "Terrence", "Terrence", "Terrence"),
                 Desc = c("Recent", "Recent", "Recent", "Recent","Not Recent", "Recent", "Recent", "Not Recent","Not Recent" ))

  data_indexed <- data %>% mutate(original_row = 1:length(ID))


  dups <- eventReactive(input$go, {


  df_split <- split(data, seq(nrow(data))) 

  dups_locations <- duplicated(data)

  dups <- data[which(dups_locations == T),]

  out <- vector("list")
  for(i in seq_len(nrow(dups))){
    out[[i]] <- map(df_split, ~identical(.x, dups[i,]))

  }

  return(out)
})

  rv <- reactiveValues(loop = 0, trigger = 0)

  num_iterations <- reactive({length(dups())})

  #start loops first time
  observeEvent(dups(), {
    rv$loop <- rv$loop + 1
          })

  #continues loop or stops
  duplicated_data <- eventReactive(rv$loop, {
    if(rv$loop > 0){
            data_indexed[which(dups()[[rv$loop]] == T),]
    }
  })

  output$table <- renderTable({
    duplicated_data() 
  })

  observeEvent(duplicated_data(),{
          rv$trigger <- rv$trigger + 1
  })
  observeEvent(rv$trigger, ignoreInit = TRUE, {
      showModal(modalDialog(title = "Make a Choice!",
                            "Which one to remove?",
                            tableOutput('table'),
                            selectInput('remove', "Remove this one", choices = seq_len(nrow(duplicated_data()))),
                            footer = actionButton("modal_submit", "Submit")))
  })

  remove_rows <- reactiveValues()
  #when user closes modal the response is saveed to           #remove_rows[[character representing number of itteration]]
  observeEvent(input$modal_submit, {
    remove_rows[[as.character(rv$loop)]] <- duplicated_data()$original_row[[as.numeric(input$remove)]]
    if(rv$loop < num_iterations()){
      rv$loop <- rv$loop + 1 #this retriggers step2 to go again
    } else {
      rv$done <- rv$done + 1
    } #breaks the disjointed loop and trigger start of next reactions
  })

  observeEvent(rv$done, {
    rv$loop <- 0 
  })

  #and the modal is closed
  observeEvent(input$modal_submit, {
    removeModal()
  })

  final_choice <- eventReactive(rv$done, ignoreInit = TRUE,{
    remove <- unlist(isolate(reactiveValuesToList(remove_rows)), use.names = F)
     # data[-as.numeric(remove),]


  })

  output$original <- renderTable({
    data
  })

  output$user_filtered <- renderText({
    final_choice()
  })

   output$final <- renderTable({
     data_indexed[-final_choice(),]
   })

}

shinyApp(ui, server)