[新注释 1：最终解决的代码发布在最底部，反映了 ismirsehregal 于 2021 年 12 月 3 日的解决方案，以及一些标记为“# ADDED”和“# MODIFIED”的小调整。 ADD 是为了解决我在矩阵 2 添加值后从矩阵 1 中删除行时遇到的错误（如下所述），而“MODIFIED”是为了符合矩阵 1 和 2 的列标题（它们没有不同的值）列标题）。
运行下面的代码时，我希望反应链中修改的最后一个对象能够“控制”或“支配”该反应链中的其他对象。在此代码中，链接的反应对象是“matrix1”和“matrix2”。输入到矩阵 2 下游的矩阵 1，并输入到矩阵 1 上游的矩阵 2 的前 2 列。按照草案，矩阵 2 的输入胜过矩阵 1 的输入。我希望最后输入的矩阵能够胜过另一个矩阵。有人可以帮我弄这个吗？
底部的图像有助于说明。
我已经搞砸了isolate()和其他事情来尝试让它按照我想要的方式工作。我还遇到了矩阵陷入循环的问题，其中值在两个矩阵之间来回反弹。我没有完全掌握isolate() yet.
Code:
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",
label ="Matrix 1 (scenario 1):",
value = matrix(c(60,5),ncol=2,dimnames=list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE),
class = "numeric"),
actionButton(inputId = "showMat2", "Add scenarios"),br(),br(),
),
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))) }
isolate(updateMatrixInput(session, inputId = "matrix1", value = tmpMat1))
})
observeEvent(input$showMat2,{
showModal(
modalDialog(
matrixInput("matrix2",
label = "Matrix 2:",
value = input$matrix1,
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
footer = tagList(modalButton("Close"))
))
observeEvent(input$matrix2, {
tmpMat2 <- input$matrix2
rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMat2))
isolate(updateMatrixInput(session, inputId = "matrix1", value = tmpMat2[,1:2]))
})
})
plotData <- reactive({
tryCatch(
lapply(seq_len(ncol(input$matrix1)/2),
function(i){
tibble(
Scenario= colnames(input$matrix1)[i*2-1],X=seq_len(10),
Y=sumMat(input$matrix1[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)
新注释 1：最终解决的代码如下
sumMat <- function(x) {return(rep(sum(x, na.rm = TRUE), 10))}
ui <- fluidPage(sidebarLayout(
sidebarPanel(
matrixInput(
"matrix1",
label = "Matrix 1:", # MODIFIED HEADER
value = matrix(c(60,5),ncol=2,dimnames=list(NULL,rep("Scenario 1",2))), # MODIFIED HEADER
rows = list(extend = TRUE, delete = TRUE),
cols = list(multiheader = TRUE), # ADD
class = "numeric"
),
actionButton(inputId = "showMat2", "Add scenarios"),br(),br(),
),
mainPanel(plotOutput("plot"))
))
server <- function(input, output, session) {
currentMat <- reactiveVal(isolate(input$matrix1))
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)
tmpMat2 <- currentMat()
if(nrow(tmpMat1) > nrow(tmpMat2)){tmpMat2 <- rbind(tmpMat2, rep(NA, ncol(tmpMat2)))}
# ADDED
if(nrow(tmpMat2) > nrow(tmpMat1)){tmpMat1 <- rbind(tmpMat1, rep(NA, ncol(tmpMat1)))}
currentMat(cbind(tmpMat1[drop=FALSE], tmpMat2[,-1:-2,drop=FALSE]))
})
observeEvent(input$showMat2, {
showModal(modalDialog(
matrixInput(
"matrix2",
label = "Matrix 2:",
value = currentMat(),
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE,delta = 2,delete = TRUE,multiheader = TRUE),
class = "numeric"
),
footer = tagList(modalButton("Close"))
))
})
observeEvent(input$matrix2, {
tmpMat2 <- input$matrix2
rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
colnames(tmpMat2) <-
paste("Scenario", rep(1:ncol(tmpMat2),each = 2,length.out = ncol(tmpMat2)))
currentMat(tmpMat2)
updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
updateMatrixInput(session, inputId = "matrix1", value = tmpMat2[, 1:2, drop = FALSE])
})
plotData <- reactive({
tryCatch(
lapply(seq_len(ncol(input$matrix1) / 2),
function(i) {
tibble(
Scenario = colnames(input$matrix1)[i * 2 - 1],
X = seq_len(10),
Y = sumMat(input$matrix1[, (i * 2 - 1):(i * 2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e)
NULL
)
})
output$plot <- renderPlot({
plotData() %>% ggplot() +
geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
)) +
theme(legend.title = element_blank())
})
}
shinyApp(ui, server)
