如何通过 r Shiny 中的模态对话框迭代请求用户输入？
How do I iteratively request user input via modalDialog in rShiny?
我已经研究/解决这个问题一周了，但似乎无法弄清楚问题所在。
基本上，我想通过 rShiny 中的对话框反复请求用户输入。用户上传文件，他们按 运行 报告，如果发现任何重复项 - 用户必须手动确定要选择的行。
我在下面列出了两个 "tries"。
- 第一个尝试
lapply 通过所有已识别的重复项 dups()。问题是，当 运行 时，它会跳到最后一个模态对话框。
- 第二次尝试遍历第一个 dup，然后在 req 处暂停等待 "ok"。为此，我需要全局分配
i;我使用 <<-，我知道这通常是一个很大的禁忌。即使如此，当按下 okay 时，它只打印第一个用户输入并且不会继续循环。奇怪的是，如果您再次按 "Run Report"，它将跳过第一个选项并转到第二个。
数据：
ID,Name,Desc
1,Tom,Recent
2,Jerry,Recent
3,Frank,Recent
3,Frank,Not Recent
4,Jennifer,Recent
5,Terrence,Recent
5,Terrence,Not Recent
我在下面创建了一个可重现的小示例。
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()
})
})
注意： 使用 shinyalert (1.0.0.9004) 的开发版本对我有用。
我不确定您将如何在警报中包含数据表或允许用户选择行的最直观方式是什么。但是，这是一个循环列表并使用 lapply:
为每个元素显示警报的示例
library(shiny)
library(shinyalert)
ui <- fluidPage(
actionButton("go", "go"),
useShinyalert()
)
server <- function(input, output, session) {
observeEvent(input$go, {
dupes <- df[df$ID %in% df[duplicated(df$ID),]$ID, ]
dupes_list <- split(dupes, dupes$ID)
lapply(dupes_list, function(x) {
shinyalert(
title = unique(x$Name)
)
})
})
}
shinyApp(ui, server)
数据：
df <-
structure(list(
ID = c("1", "2", "3", "3", "4", "5", "5"),
Name = c(
"Tom",
"Jerry",
"Frank",
"Frank",
"Jennifer",
"Terrence",
"Terrence"
),
Desc = c(
"Recent",
"Recent",
"Recent",
"Not Recent",
"Recent",
"Recent",
"Not Recent"
)
),
row.names = c(NA, -7L),
class = "data.frame")
这是一个带有内置数据集的简短示例应用程序，该数据集包含 2 组重复行（第 3 和 4 行以及第 8 和 9 行）。在此示例 rv$loop 中，使用 reactiveValues 进入循环。如果 rv$loop 大于 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)
我已经研究/解决这个问题一周了，但似乎无法弄清楚问题所在。
基本上，我想通过 rShiny 中的对话框反复请求用户输入。用户上传文件，他们按 运行 报告，如果发现任何重复项 - 用户必须手动确定要选择的行。
我在下面列出了两个 "tries"。
- 第一个尝试
lapply通过所有已识别的重复项dups()。问题是，当 运行 时，它会跳到最后一个模态对话框。 - 第二次尝试遍历第一个 dup，然后在 req 处暂停等待 "ok"。为此，我需要全局分配
i;我使用<<-，我知道这通常是一个很大的禁忌。即使如此，当按下 okay 时，它只打印第一个用户输入并且不会继续循环。奇怪的是，如果您再次按 "Run Report"，它将跳过第一个选项并转到第二个。
数据：
ID,Name,Desc
1,Tom,Recent
2,Jerry,Recent
3,Frank,Recent
3,Frank,Not Recent
4,Jennifer,Recent
5,Terrence,Recent
5,Terrence,Not Recent
我在下面创建了一个可重现的小示例。
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()
})
})
注意： 使用 shinyalert (1.0.0.9004) 的开发版本对我有用。
我不确定您将如何在警报中包含数据表或允许用户选择行的最直观方式是什么。但是，这是一个循环列表并使用 lapply:
library(shiny)
library(shinyalert)
ui <- fluidPage(
actionButton("go", "go"),
useShinyalert()
)
server <- function(input, output, session) {
observeEvent(input$go, {
dupes <- df[df$ID %in% df[duplicated(df$ID),]$ID, ]
dupes_list <- split(dupes, dupes$ID)
lapply(dupes_list, function(x) {
shinyalert(
title = unique(x$Name)
)
})
})
}
shinyApp(ui, server)
数据：
df <-
structure(list(
ID = c("1", "2", "3", "3", "4", "5", "5"),
Name = c(
"Tom",
"Jerry",
"Frank",
"Frank",
"Jennifer",
"Terrence",
"Terrence"
),
Desc = c(
"Recent",
"Recent",
"Recent",
"Not Recent",
"Recent",
"Recent",
"Not Recent"
)
),
row.names = c(NA, -7L),
class = "data.frame")
这是一个带有内置数据集的简短示例应用程序，该数据集包含 2 组重复行（第 3 和 4 行以及第 8 和 9 行）。在此示例 rv$loop 中，使用 reactiveValues 进入循环。如果 rv$loop 大于 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)