在 R Shiny 中，为什么一个 observeEvent() 会使另一个 observeEvent() 无效？
In R Shiny, why does one observeEvent() nullify another observeEvent()?
在下面的 运行 代码中，observeEvent(input$matrix2, {...}) 使 observeEvent(input$matrix1, {...}) 无效。为什么会发生这种情况，我该如何解决？
矩阵 1 和矩阵 2 已关联。从矩阵 1 到矩阵 2 的值作为矩阵 2“场景 1”，矩阵 2 允许用户通过水平扩展矩阵输入其他场景。单击单个操作按钮后，Matrix 2 在模态对话框中呈现。当首先输入矩阵 1 时，App（绘图）工作正常（将用户输入绘制到矩阵 1 和 2 中）；但是当在输入矩阵 1 之前查看矩阵 2（我们没有任何用户输入矩阵 2）时，矩阵 1 变得无用。无用是指不再绘制矩阵 1 的输入。
出于说明目的，输出只是矩阵输入的总和，根据 sumMat(...) 函数在 10 个周期内绘制。
我试过 isolate(...)、req(...) 等的所有变体，但到目前为止运气不好。
下面的图片说明了问题：前2张图片显示应用程序在先输入矩阵1时运行良好；第 3 个图像显示在矩阵 1 之前访问矩阵 2 时失败。
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
matrixInput("matrix1",
value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
actionButton("matrix2show","Add scenarios"),
),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output, session){
observeEvent(input$matrix1, {
tmpMat1 <- input$matrix1
if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))}
updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
})
observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
req(input$matrix1)
a <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
b <- apply(input$matrix1,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
d <- ncol(input$matrix2)
tmpMat2 <- matrix(c(c), ncol = d)
tmpMat2[1,2] <- input$matrix1[1,2]
colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
updateMatrixInput(session,inputId="matrix2",value=tmpMat2)
})
observeEvent(input$matrix2show,{
showModal(
modalDialog(
matrixInput("matrix2",
label = "Matrix 2 (Value Y applied in Period X):",
value = if(is.null(input$matrix2))
{matrix(c(input$matrix1[,1],input$matrix1[,2]),
ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))}
else {input$matrix2},
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
footer = tagList(modalButton("Exit box"))
))
})
plotData <- reactive({
tryCatch(
if(isTruthy(input$matrix2)){
lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
function(i){
tibble(Scenario = colnames(input$matrix2)[i*2-1],
X = seq_len(10),Y = sumMat(input$matrix2[,(i*2-1):(i*2), drop = FALSE]))
}) %>% bind_rows()
}
else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
error = function(e) NULL)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
})
}
shinyApp(ui, server)
这是部分解决方案。每次单击 actionButton 时，都会为 matrix2 创建相同的 ID。这是一个问题，因为 Shiny 需要唯一的 ID。一旦我们对此进行了调整，它就可以正常工作。见下文。您仍然需要研究如何显示 input$matrix2 的前几列。
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
matrixInput("matrix1",
value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
actionButton("matrix2show","Add scenarios"),
),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output, session){
rv <- reactiveValues(tmpMat=NULL)
observeEvent(input$matrix1, {
tmpMat1 <- input$matrix1
if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))}
updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
})
observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
req(input[[paste0("matrix2",input$matrix2show)]])
req(input$matrix1)
imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
a <- apply(imatrix2,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
b <- apply(input$matrix1,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
d <- ncol(imatrix2)
tmpMat2 <- matrix(c(c), ncol = d)
tmpMat2[1,2] <- input$matrix1[1,2]
colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
rownames(tmpMat2) <- paste("Row", seq_len(nrow(imatrix2)))
updateMatrixInput(session,inputId=paste0("matrix2",input$matrix2show),value=tmpMat2)
rv$tmpMat <- tmpMat2
})
observe({print(rv$tmpMat)})
observeEvent(input$matrix2show,{
if (input$matrix2show==1) ivalue <- matrix(c(input$matrix1[,1],input$matrix1[,2]),
ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))
else{ if (!is.null(rv$tmpMat)) ivalue <- rv$tmpMat else ivalue <- input$matrix1}
showModal(
modalDialog(
matrixInput(paste0("matrix2",input$matrix2show),
label = "Matrix 2 (Value Y applied in Period X):",
value = ivalue,
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
footer = tagList(modalButton("Exit box"))
))
})
plotData <- reactive({
req(input$matrix1)
imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
tryCatch(
if(isTruthy(imatrix2)){
lapply(seq_len(ncol(imatrix2)/2), # column counter to set matrix index as it expands
function(i){
tibble(Scenario = colnames(imatrix2)[i*2-1],
X = seq_len(10),Y = sumMat(imatrix2[,(i*2-1):(i*2), drop = FALSE]))
}) %>% bind_rows()
}
else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
error = function(e) NULL)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
})
}
shinyApp(ui, server)
在下面的 运行 代码中，observeEvent(input$matrix2, {...}) 使 observeEvent(input$matrix1, {...}) 无效。为什么会发生这种情况，我该如何解决？
矩阵 1 和矩阵 2 已关联。从矩阵 1 到矩阵 2 的值作为矩阵 2“场景 1”，矩阵 2 允许用户通过水平扩展矩阵输入其他场景。单击单个操作按钮后，Matrix 2 在模态对话框中呈现。当首先输入矩阵 1 时，App（绘图）工作正常（将用户输入绘制到矩阵 1 和 2 中）；但是当在输入矩阵 1 之前查看矩阵 2（我们没有任何用户输入矩阵 2）时，矩阵 1 变得无用。无用是指不再绘制矩阵 1 的输入。
出于说明目的，输出只是矩阵输入的总和，根据 sumMat(...) 函数在 10 个周期内绘制。
我试过 isolate(...)、req(...) 等的所有变体，但到目前为止运气不好。
下面的图片说明了问题：前2张图片显示应用程序在先输入矩阵1时运行良好；第 3 个图像显示在矩阵 1 之前访问矩阵 2 时失败。
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
matrixInput("matrix1",
value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
actionButton("matrix2show","Add scenarios"),
),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output, session){
observeEvent(input$matrix1, {
tmpMat1 <- input$matrix1
if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))}
updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
})
observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
req(input$matrix1)
a <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
b <- apply(input$matrix1,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
d <- ncol(input$matrix2)
tmpMat2 <- matrix(c(c), ncol = d)
tmpMat2[1,2] <- input$matrix1[1,2]
colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
updateMatrixInput(session,inputId="matrix2",value=tmpMat2)
})
observeEvent(input$matrix2show,{
showModal(
modalDialog(
matrixInput("matrix2",
label = "Matrix 2 (Value Y applied in Period X):",
value = if(is.null(input$matrix2))
{matrix(c(input$matrix1[,1],input$matrix1[,2]),
ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))}
else {input$matrix2},
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
footer = tagList(modalButton("Exit box"))
))
})
plotData <- reactive({
tryCatch(
if(isTruthy(input$matrix2)){
lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
function(i){
tibble(Scenario = colnames(input$matrix2)[i*2-1],
X = seq_len(10),Y = sumMat(input$matrix2[,(i*2-1):(i*2), drop = FALSE]))
}) %>% bind_rows()
}
else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
error = function(e) NULL)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
})
}
shinyApp(ui, server)
这是部分解决方案。每次单击 actionButton 时，都会为 matrix2 创建相同的 ID。这是一个问题，因为 Shiny 需要唯一的 ID。一旦我们对此进行了调整，它就可以正常工作。见下文。您仍然需要研究如何显示 input$matrix2 的前几列。
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
matrixInput("matrix1",
value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
actionButton("matrix2show","Add scenarios"),
),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output, session){
rv <- reactiveValues(tmpMat=NULL)
observeEvent(input$matrix1, {
tmpMat1 <- input$matrix1
if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))}
updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
})
observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
req(input[[paste0("matrix2",input$matrix2show)]])
req(input$matrix1)
imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
a <- apply(imatrix2,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
b <- apply(input$matrix1,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
d <- ncol(imatrix2)
tmpMat2 <- matrix(c(c), ncol = d)
tmpMat2[1,2] <- input$matrix1[1,2]
colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
rownames(tmpMat2) <- paste("Row", seq_len(nrow(imatrix2)))
updateMatrixInput(session,inputId=paste0("matrix2",input$matrix2show),value=tmpMat2)
rv$tmpMat <- tmpMat2
})
observe({print(rv$tmpMat)})
observeEvent(input$matrix2show,{
if (input$matrix2show==1) ivalue <- matrix(c(input$matrix1[,1],input$matrix1[,2]),
ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))
else{ if (!is.null(rv$tmpMat)) ivalue <- rv$tmpMat else ivalue <- input$matrix1}
showModal(
modalDialog(
matrixInput(paste0("matrix2",input$matrix2show),
label = "Matrix 2 (Value Y applied in Period X):",
value = ivalue,
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
footer = tagList(modalButton("Exit box"))
))
})
plotData <- reactive({
req(input$matrix1)
imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
tryCatch(
if(isTruthy(imatrix2)){
lapply(seq_len(ncol(imatrix2)/2), # column counter to set matrix index as it expands
function(i){
tibble(Scenario = colnames(imatrix2)[i*2-1],
X = seq_len(10),Y = sumMat(imatrix2[,(i*2-1):(i*2), drop = FALSE]))
}) %>% bind_rows()
}
else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
error = function(e) NULL)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
})
}
shinyApp(ui, server)