在 R Shiny 中,如何只更新用户输入矩阵中的一个值?
In R Shiny, how to update only one value in a user input matrix?
在下面的 MWE 代码中,我试图让矩阵 1 中的任何用户输入仅在矩阵 2 的右上角 ([1,2)] 中反应性地反映出来,同时保留之前输入的所有其他值矩阵 2。底部的三个图像解释了这个问题:并非所有值都被准确保留。是否可以保留除 Matrix 2 [1,2] 之外的先前输入?如何做到这一点?
我一直在摆弄矩阵索引,现在碰壁了。
请注意 R Studio 控制台中发布的警告,如最终图片所示。
这“几乎是 MWE”,但是可以安全地忽略 extra/interpolation 的 UDF interpol()
,从而使代码变得简单。
MWE 代码:
library(shiny)
library(shinyMatrix)
interpol <- function(a, b) { # [a] = modeled periods, [b] = matrix inputs
c <- b
c[,1][c[,1] > a] <- a
d <- diff(c[,1, drop = FALSE])
d[d <= 0] <- NA
d <- c(1,d)
c <- cbind(c,d)
c <- na.omit(c)
c <- c[,-c(3),drop=FALSE]
e <- rep(NA, a)
e[c[,1]] <- c[,2]
e[seq_len(min(c[,1])-1)] <- e[min(c[,1])]
if(max(c[,1]) < a){e[seq(max(c[,1]) + 1, a, 1)] <- 0}
e <- approx(seq_along(e)[!is.na(e)], e[!is.na(e)], seq_along(e))$y # Interpolates
return(e)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
h5(strong("Matrix 1:")),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(names = FALSE),
class = "numeric"),
h5(strong("Matrix 2:")),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, names = TRUE, delete = TRUE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session){
observeEvent(input$periods,{
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(c(input$periods,input$matrix2[1,2]), 1, 2, dimnames = list(NULL,c("X","Y")))
)
})
observeEvent(input$matrix1, {
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(c(input$matrix2[,1],input$matrix1[,1]), ncol = 2, dimnames = list(NULL,c("X","Y")))
)
})
observeEvent(input$matrix2, {
if(any(rownames(input$matrix2) == "")){
tmpMatrix <- input$matrix2
rownames(tmpMatrix) <- paste("Row", seq_len(nrow(input$matrix2)))
isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMatrix))
}
input$matrix2
})
output$plot <- renderPlot({
req(input$matrix2)
plot(interpol(input$periods, input$matrix2))
})
}
shinyApp(ui, server)
好的,这很简单。在 matrix1 的 observeEvent
中,我简单地将 matrix2 的两列输入分解为对象 col1
和 col2
,将 matrix1 的值代入组合 matrix2 列的向量中的正确位置inputs(joinCol
),并使用updateMatrixInput
函数更新matrix2,如下图:
observeEvent(input$matrix1, {
col1 <- input$matrix2[,1]
col2 <- input$matrix2[,2]
joinCol <- c(col1,col2)
joinCol[length(input$matrix2)/2+1] <- input$matrix1[,1]
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(joinCol,
ncol = 2,
dimnames = list(NULL,c("X","Y")))
)
})
在下面的 MWE 代码中,我试图让矩阵 1 中的任何用户输入仅在矩阵 2 的右上角 ([1,2)] 中反应性地反映出来,同时保留之前输入的所有其他值矩阵 2。底部的三个图像解释了这个问题:并非所有值都被准确保留。是否可以保留除 Matrix 2 [1,2] 之外的先前输入?如何做到这一点?
我一直在摆弄矩阵索引,现在碰壁了。
请注意 R Studio 控制台中发布的警告,如最终图片所示。
这“几乎是 MWE”,但是可以安全地忽略 extra/interpolation 的 UDF interpol()
,从而使代码变得简单。
MWE 代码:
library(shiny)
library(shinyMatrix)
interpol <- function(a, b) { # [a] = modeled periods, [b] = matrix inputs
c <- b
c[,1][c[,1] > a] <- a
d <- diff(c[,1, drop = FALSE])
d[d <= 0] <- NA
d <- c(1,d)
c <- cbind(c,d)
c <- na.omit(c)
c <- c[,-c(3),drop=FALSE]
e <- rep(NA, a)
e[c[,1]] <- c[,2]
e[seq_len(min(c[,1])-1)] <- e[min(c[,1])]
if(max(c[,1]) < a){e[seq(max(c[,1]) + 1, a, 1)] <- 0}
e <- approx(seq_along(e)[!is.na(e)], e[!is.na(e)], seq_along(e))$y # Interpolates
return(e)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
h5(strong("Matrix 1:")),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(names = FALSE),
class = "numeric"),
h5(strong("Matrix 2:")),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, names = TRUE, delete = TRUE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session){
observeEvent(input$periods,{
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(c(input$periods,input$matrix2[1,2]), 1, 2, dimnames = list(NULL,c("X","Y")))
)
})
observeEvent(input$matrix1, {
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(c(input$matrix2[,1],input$matrix1[,1]), ncol = 2, dimnames = list(NULL,c("X","Y")))
)
})
observeEvent(input$matrix2, {
if(any(rownames(input$matrix2) == "")){
tmpMatrix <- input$matrix2
rownames(tmpMatrix) <- paste("Row", seq_len(nrow(input$matrix2)))
isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMatrix))
}
input$matrix2
})
output$plot <- renderPlot({
req(input$matrix2)
plot(interpol(input$periods, input$matrix2))
})
}
shinyApp(ui, server)
好的,这很简单。在 matrix1 的 observeEvent
中,我简单地将 matrix2 的两列输入分解为对象 col1
和 col2
,将 matrix1 的值代入组合 matrix2 列的向量中的正确位置inputs(joinCol
),并使用updateMatrixInput
函数更新matrix2,如下图:
observeEvent(input$matrix1, {
col1 <- input$matrix2[,1]
col2 <- input$matrix2[,2]
joinCol <- c(col1,col2)
joinCol[length(input$matrix2)/2+1] <- input$matrix1[,1]
updateMatrixInput(
session,
inputId = "matrix2",
value = matrix(joinCol,
ncol = 2,
dimnames = list(NULL,c("X","Y")))
)
})