我有一个应用程序可以动态创建绘图并更新输入值。该应用程序正在运行,但我必须加载绘图,然后加载需要两个操作按钮和observeEvents 的值。
我尝试放置两个用于创建绘图和使用 Load All
actionButton 更新值的 for 循环,但它们似乎无法在 observeEvent 中协同工作。我也尝试将 for 循环转换为 lapply,但没有奏效。
library(shiny)
histogramUI <- function(id,var,bins) {
tagList(
fluidRow(column(4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
column(8, plotOutput(NS(id, "hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = 10, main = input$var)
}, res = 96)
})
}
ui <-
fluidPage(
actionButton("load_plots", "Load Plots"),
actionButton("load_values", "Load Values"),
actionButton("load_all", "Load All"),
div(id = "add_here")
)
server <- function(input, output, session) {
a <- list("hist_1-var" = "hp",
"hist_2-var" = "cyl",
"hist_3-var" = "am",
"hist_4-var" = "disp",
"hist_5-var" = "wt")
modules <- c("add", "hist_1", "hist_2", "hist_3", "hist_4", "hist_5")
observeEvent(input$load_plots, {
bins <- 10
if (length(modules)>1) {
for (i in 1:(length(modules))) {
if (substr(modules[i],1,4)=='hist') {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
}
}
})
observeEvent(input$load_values, {
for (i in 1:length(a)) {
updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
}
})
observeEvent(input$load_all, {
bins <- 10
if (length(modules)>1) {
lapply(seq_along(modules),
function(i) {
if (substr(modules[i],1,4)=='hist') {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
}
)
}
lapply(seq_along(a),
function(k) {
for (i in 1:length(a)) {
updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
}
}
)
# if (length(modules)>1) {
# for (i in 1:(length(modules))) {
#
# if (substr(modules[i],1,4)=='hist') {
# histogramServer(modules[i])
# insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
# }
# }
# }
#
# for (i in 1:length(a)) {
# updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
# }
})
}
shinyApp(ui, server, enableBookmarking = "server")
答案 0 :(得分:1)
对于初始插入,您需要使预先选择的变量可用于服务器。否则,服务器将尝试访问尚不存在的 input$var
(NULL
)。这同样适用于 bins
。
请检查以下内容:
library(shiny)
histogramUI <- function(id, selected_var, selected_bins, module_choices) {
tagList(fluidRow(
column(
4,
selectInput(
NS(id, "var"),
"Variable",
choices = module_choices,
selected = selected_var
),
numericInput(NS(id, "bins"), "bins", value = selected_bins, min = 1)
),
column(8, plotOutput(NS(id, "hist")))
))
}
histogramServer <- function(id, selected_var, selected_bins, module_choices) {
moduleServer(id, function(input, output, session) {
var <- reactive({
if(is.null(input$var)){
selected_var
} else {
var <- input$var
}
})
bins <- reactive({
if(is.null(input$bins)){
selected_bins
} else {
bins <- input$bins
}
})
data <- reactive({
mtcars[[which(module_choices == var())]]
})
output$hist <- renderPlot({
hist(data(), breaks = bins(), main = var())
}, res = 96)
})
}
ui <- fluidPage(
actionButton("load_all", "Load All"),
div(id = "add_here")
)
server <- function(input, output, session) {
observeEvent(input$load_all, {
modules <- c("hist_1", "hist_2", "hist_3", "hist_4", "hist_5")
module_choices <- paste0(modules, "-var")
names(module_choices) <- colnames(mtcars)[seq_along(module_choices)]
bins <- 11
if (length(modules) > 1) {
lapply(seq_along(modules), function(i) {
histogramServer(modules[i], module_choices[i], bins, module_choices)
insertUI(
selector = "#add_here",
ui = histogramUI(modules[i], module_choices[i], bins, module_choices)
)
})
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
答案 1 :(得分:1)
我会准确地回答你的问题。默认 insertUI
以延迟方式计算。您需要使用 immediate
这样的参数 insertUI(..., immediate = TRUE)
来强制立即评估。
正是在你的情况下。
insertUI(selector = "#add_here",
ui = histogramUI(modules[i], paste0(modules[i], "-var"), paste0(modules[i], "-bin")),
immediate = TRUE)