【发布时间】：2020-10-20 22:06:27
【问题描述】：
我正在尝试找到一种方法来禁用最近生成的输出的反应性，但启用正在呈现的当前输出的反应性。
在本例中，我单击New 开始新绘图并选择输入。然后，我再次单击New，这会在第一个图下方创建一个新图。但是，当我更改输入时，所有输出图都会更改。我只想改变当前的新情节。
为了解决这个问题，我想点击New 按钮，它会禁用旧图的反应性，但会为当前的新图保持反应性。
library(dplyr)
library(rlang)
library(ggplot2)
scatter_plot <- function(dataset, xvar, yvar) {
x <- rlang::sym(xvar)
y <- rlang::sym(yvar)
p <- ggplot(dataset, aes(x = !!x, y = !!y)) +
geom_point() +
theme(axis.title = element_text(size = rel(1.2)),
axis.text = element_text(size = rel(1.1)))
return(p)
}
regress <- function(dataset, xvar, yvar) {
# lefts <- rlang::sym(xvar)
# rights <- rlang::sym(yvar)
lefts <- xvar
rights <- yvar
lefts <- paste(lefts, " ~ ")
rights <- paste(rights, collapse = " + ")
formula <- paste(lefts, rights)
r <- summary(lm(formula, data = dataset))
return(r)
}
importUI <- function(id) {
ns <- NS(id)
tagList(
fileInput(ns("file1"), "Choose CSV File", accept = ".csv"),
checkboxInput(ns("header"), "Header", TRUE),
# tableOutput(ns("contents"))
)
}
importSE <- function(id) {
moduleServer(id,
function(input, output, session) {
dtreact <- reactive({
file <- input$file1
if (is.null(file))
return(NULL)
read.csv(file$datapath, header = input$header)
})
output$contents <- renderTable({
dtreact()
})
return(dtreact)
}
)
}
varselect_ui <- function(id) {
ns <- NS(id)
var_choices <- ""
tagList(selectInput(ns("xvar"), "Select X variable", choices = var_choices, selected = NULL),
selectInput(ns("yvar"), "Select Y variable", choices = var_choices, selected = NULL))
}
varselect_server <- function(id, dataset) {
moduleServer(id,
function(input, output, session) {
observeEvent(dataset(), {
updateSelectInput(session,
"xvar",
choices = names(dataset()))
updateSelectInput(session,
"yvar",
choices = names(dataset()))
})
return(
list(
xvar = reactive({input$xvar}),
yvar = reactive({input$yvar})
)
)
}
)
}
regselect_ui <- function(id) {
ns <- NS(id)
var_choices <- ""
tagList(selectInput(ns("xvar"), "Select X variable", choices = var_choices, selected = NULL),
selectInput(ns("yvar"), "Select Y variable", choices = var_choices, selected = NULL, multiple = TRUE))
}
regselect_server <- function(id, dataset) {
moduleServer(id,
function(input, output, session) {
observeEvent(dataset(), {
updateSelectInput(session,
"xvar",
choices = names(dataset()))
updateSelectInput(session,
"yvar",
choices = names(dataset()))
})
return(
list(
xvar = reactive({input$xvar}),
yvar = reactive({input$yvar})
)
)
}
)
}
scatterplot_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("plot1"))
}
scatterplot_server <- function(id, dataset, xvar, yvar) {
moduleServer(id,
function(input, output, session) {
plot1_obj <- reactive({
req(dataset())
p <- scatter_plot(dataset(), xvar = xvar(), yvar = yvar())
return(p)
})
output$plot1 <- renderPlot({
plot1_obj()
})
}
)
}
regressUI <- function(id) {
ns <- NS(id)
verbatimTextOutput(ns("regout"))
}
regressSE <- function(id, dataset, xvar, yvar) {
moduleServer(id,
function(input, output, session) {
reg_obj <- reactive({
req(dataset())
r <- regress(dataset(), xvar = xvar(), yvar = yvar())
return(r)
})
output$regout <- renderPrint({
reg_obj()
})
})
}
ui <- fluidPage(
wellPanel(selectInput(inputId = "input1", label = NULL, choices = c(" ", "Import", "Select", "Regress"))),
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = "input.input1 == 'Import'", importUI("import")),
conditionalPanel(condition = "input.input1 == 'Select'", actionButton("run1", "New"), varselect_ui("select")),
conditionalPanel(condition = "input.input1 == 'Regress'", actionButton("run2", "New "), regselect_ui("select1"))),
mainPanel(div(id = "add_here"))))
server <- function(input, output, session) {
dataset <- importSE("import")
df <- dataset
plotvars <- varselect_server("select", dataset = dataset)
plotvars2 <- regselect_server("select1", dataset = dataset)
# regressSE("regress1", dataset = df, xvar = plotvars2$xvar, yvar = plotvars2$yvar)
# output$contents <- renderTable({
# dataset()
# })
counter <- 1
observeEvent(input$run1, {
current_id <- paste0("out_", counter)
scatterplot_server(id = current_id,
dataset = df,
xvar = plotvars$xvar,
yvar = plotvars$yvar)
insertUI(selector = "#add_here",
ui = scatterplot_ui(current_id))
counter <<- counter + 1
})
observeEvent(input$run2, {
current_id <- paste0("out_", counter)
r <- regressSE(id = current_id,
dataset = df,
xvar = plotvars2$xvar,
yvar = plotvars2$yvar)
output$out <- renderPrint({
r
})
insertUI(selector = "#add_here",
ui = regressUI(current_id))
counter <<- counter + 1
})
}
shinyApp(ui, server)
如您所见，更改输入会更改所有输出。但我只希望第二个输出根据输入进行更改。
【问题讨论】：
-
我正在尝试解决这个问题，但需要知道您希望制作多少个地块？
-
感谢您的帮助，@MritiAgarwal。我想创建任意数量或无限数量的地块。