Passing the same reactive object to the same shiny module causes "Error: promise already under evaluation"
Passing the same reactive object to the same shiny module causes "Error: promise already under evaluation"
Objective: 我创建了一个简单的可复制应用程序，我试图在其中通过操作按钮添加 UI 组件，以便我可以过滤UI 过滤器从操作按钮生成的相同数据集。我试图在应用过滤器后使用闪亮的模块代码来保存数据集，并在下次单击操作按钮时重用过滤后的数据集。换句话说，每次单击操作按钮生成一组新的 UI 组件时，我都想重用这个过滤后的数据集（而不是原始的未过滤数据集）。
问题： 当用户单击操作按钮时，预期的结果在第一个实例中有效，但任何连续单击操作按钮都会导致 错误：promise already评估中：递归默认参数引用或更早的问题？ 是我试图在 shiny/shiny 模块中做不到的事情，还是我执行的不正确？任何帮助将不胜感激。
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;")),
br(),
column(width = 12, tableOutput(ns("test"))))
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data %>%
rename(Var = one_of(input$sel.col)) %>%
arrange(Var) %>%
filter(Var >= min(input$sel.rng), Var <= max(input$sel.rng)) %>%
rename(!!input$sel.col := Var)
})
output$test = renderTable({
data.filtered() %>%
head()
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
counter = reactiveVal(value = 0)
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
counter(input$add.filter)
if (counter() == 1) {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
} else {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = df.filtered())
}
output$tbl = renderTable({
df.filtered()
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
我能够通过采取替代方法解决我的问题，如我在上面的评论中所述。下面的代码提供了用户选择的输入的摘要 table。所有需要做的就是将这些过滤器应用于 table 以相应地对其进行子集化。
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;"))
)
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data.frame(Col.Nm = input$sel.col,
Min = min(input$sel.rng, na.rm = T),
Max = max(input$sel.rng, na.rm = T))
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
df.filtered = reactiveValues()
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
df.filtered[[paste0("Filtered_", input$add.filter[1])]] = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
output$tbl = renderTable({
for (i in 1:input$add.filter[1]) {
if (i == 1) {
df = df.filtered[[paste0("Filtered_", i)]]()
} else {
df = rbind(df,
df.filtered[[paste0("Filtered_", i)]]())
}
}
df
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Objective: 我创建了一个简单的可复制应用程序，我试图在其中通过操作按钮添加 UI 组件，以便我可以过滤UI 过滤器从操作按钮生成的相同数据集。我试图在应用过滤器后使用闪亮的模块代码来保存数据集，并在下次单击操作按钮时重用过滤后的数据集。换句话说，每次单击操作按钮生成一组新的 UI 组件时，我都想重用这个过滤后的数据集（而不是原始的未过滤数据集）。
问题： 当用户单击操作按钮时，预期的结果在第一个实例中有效，但任何连续单击操作按钮都会导致 错误：promise already评估中：递归默认参数引用或更早的问题？ 是我试图在 shiny/shiny 模块中做不到的事情，还是我执行的不正确？任何帮助将不胜感激。
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;")),
br(),
column(width = 12, tableOutput(ns("test"))))
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data %>%
rename(Var = one_of(input$sel.col)) %>%
arrange(Var) %>%
filter(Var >= min(input$sel.rng), Var <= max(input$sel.rng)) %>%
rename(!!input$sel.col := Var)
})
output$test = renderTable({
data.filtered() %>%
head()
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
counter = reactiveVal(value = 0)
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
counter(input$add.filter)
if (counter() == 1) {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
} else {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = df.filtered())
}
output$tbl = renderTable({
df.filtered()
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
我能够通过采取替代方法解决我的问题，如我在上面的评论中所述。下面的代码提供了用户选择的输入的摘要 table。所有需要做的就是将这些过滤器应用于 table 以相应地对其进行子集化。
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;"))
)
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data.frame(Col.Nm = input$sel.col,
Min = min(input$sel.rng, na.rm = T),
Max = max(input$sel.rng, na.rm = T))
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
df.filtered = reactiveValues()
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
df.filtered[[paste0("Filtered_", input$add.filter[1])]] = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
output$tbl = renderTable({
for (i in 1:input$add.filter[1]) {
if (i == 1) {
df = df.filtered[[paste0("Filtered_", i)]]()
} else {
df = rbind(df,
df.filtered[[paste0("Filtered_", i)]]())
}
}
df
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)