我可以循环使用 R Shiny showModal 吗？

Question

我知道这里有一些类似的问题，但它们都有几年历史了，而且似乎都指向使用

shinyalert

包而不是 showModal。我的基本问题是，我需要允许用户在 DT 数据表中选择可能包含错误数据的一行或多行，然后收集每一行的错误输入，以便我可以将其推回数据库.

这是一个基本示例，仅弹出最后一个模式对话框...

library(shiny)
library(DT)
library(magrittr)
library(dplyr)

ids <- c(1, 2, 3, 4, 5)
firstNames <- c("Bob", "Jane", "Jim", "Billy", "Siouxsie")
lastNames <- c("Smith", "Jones", "Thomas", "Idol", "Sioux")
FaveColors <- c("Blue", "Green", "Yellow", "Red", "Black")
df <- data.frame(ids, firstNames, lastNames, FaveColors)

# Define UI 
ui <- fluidPage(

    # Application title
    titlePanel("Minimal Example"),

    # Sidebar 
    sidebarLayout(
        sidebarPanel(
            tabPanel("Columns",
                      checkboxGroupInput(inputId = "ColumnsToShow", label = "Output Columns",
                                         choices = names(df)
                      )
            ),
            actionButton(inputId = "ErrorButton", label="Comment on selected rows")
        ),

        # Show a table
        mainPanel(
          DT::dataTableOutput("FilteredDataFrame")
        )
    )
)

# Define server logic 
server <- function(input, output) {
  
  filtered_df <- reactive({
    temp_frame <- df %>% select(all_of(input$ColumnsToShow))
    return(temp_frame)
  })
  
  observeEvent(input$ErrorButton, {
    if (length(input$FilteredDataFrame_rows_selected) > 0) {
      for (value in 1:length(input$FilteredDataFrame_rows_selected)) {
        myString <- paste("You have selected row", input$FilteredDataFrame_rows_selected[value])
        showModal(modalDialog(
          title = "Report possible data error",
          myString,
          easyClose = FALSE,
          fade = TRUE
        ))
      }
    }
    
  }
  )
    

  output$FilteredDataFrame <- DT::renderDT(server=TRUE, {datatable(filtered_df(), extensions = 'Buttons',
                                                                   options = list(scrollx=TRUE,
                                                                                  lengthMenu = c(10,20,30),
                                                                                  paging = TRUE,
                                                                                  searching = TRUE,
                                                                                  fixedColumns = TRUE,
                                                                                  autoWidth = TRUE,
                                                                                  ordering = TRUE,
                                                                                  #dom = 'Bfrtip',
                                                                                  dom = 'tlip',
                                                                                  buttons = c('copy', 
                                                                                              'csv',
                                                                                              'excel')
                                                                   )
  )
  }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

仅标准闪亮有什么办法吗？

Answer 1

在花了更多时间解决这个问题后，我正在修改我的答案。

您观察到的行为是由于模式对话框在 Shiny 中的显示方式造成的。当您循环

input$FilteredDataFrame_rows_selected

并在循环中使用

showModal

时，每次后续调用

showModal

都会覆盖之前显示的模式对话框。因此，实际上只会显示循环中的最后一个对话框。

使用标准 Shiny 解决此问题的一种方法是使用反应值和观察事件的组合来管理模态序列。这是一种一次显示一个模态框并仅在当前模态框关闭时才转到下一个模态框的解决方案：

1. 在显示下一个模式之前，使用

   removeModal()

   关闭当前模式。
2. 使用反应值来跟踪当前显示模态的索引。
3. 使用单独的

   observeEvent

   监听模态闭包并增加无功值的索引。

这是代码的修改版本：

library(shiny)
library(DT)
library(magrittr)
library(dplyr)

ids <- c(1, 2, 3, 4, 5)
firstNames <- c("Bob", "Jane", "Jim", "Billy", "Siouxsie")
lastNames <- c("Smith", "Jones", "Thomas", "Idol", "Sioux")
FaveColors <- c("Blue", "Green", "Yellow", "Red", "Black")
df <- data.frame(ids, firstNames, lastNames, FaveColors)

ui <- fluidPage(
  titlePanel("Minimal Example"),
  sidebarLayout(
    sidebarPanel(
      tabPanel("Columns",
               checkboxGroupInput(inputId = "ColumnsToShow", label = "Output Columns",
                                  choices = names(df)
               )
      ),
      actionButton(inputId = "ErrorButton", label="Comment on selected rows")
    ),
    mainPanel(
      DT::dataTableOutput("FilteredDataFrame")
    )
  )
)

server <- function(input, output, session) {
  filtered_df <- reactive({
    df %>% select(all_of(input$ColumnsToShow))
  })
  
  currentModalIndex <- reactiveVal(0)
  
  observeEvent(input$ErrorButton, {
    currentModalIndex(1) # reset index to 1
  })
  
  observeEvent(currentModalIndex(), {
    if (currentModalIndex() > 0 && currentModalIndex() <= length(input$FilteredDataFrame_rows_selected)) {
      myString <- paste("You have selected row", input$FilteredDataFrame_rows_selected[currentModalIndex()])
      showModal(modalDialog(
        title = "Report possible data error",
        myString,
        footer = actionButton("nextModal", "Next"),
        easyClose = FALSE,
        fade = TRUE
      ))
    }
  })
  
  observeEvent(input$nextModal, {
    if (currentModalIndex() < length(input$FilteredDataFrame_rows_selected)) {
      currentModalIndex(currentModalIndex() + 1)
    } else {
      currentModalIndex(0) # reset index to 0, indicating no more modals to show
      removeModal()
    }
  })

  output$FilteredDataFrame <- DT::renderDT({
    datatable(filtered_df(), extensions = 'Buttons',
              options = list(scrollx=TRUE,
                             lengthMenu = c(10,20,30),
                             paging = TRUE,
                             searching = TRUE,
                             fixedColumns = TRUE,
                             autoWidth = TRUE,
                             ordering = TRUE,
                             dom = 'tlip',
                             buttons = c('copy', 'csv', 'excel')
              )
    )
  })
}

shinyApp(ui = ui, server = server)

现在，当您选择行并单击“对所选行进行注释”时，当您单击“下一步”时，每个模式将依次显示。