在 R Shiny 中,如何用 observe 替换 observeEvent?
In R Shiny, how to replace observeEvent with observe?
以下几乎是 MWE 代码使用 observeEvent
将用户输入链接到三个对象。底部的图像也显示并解释了这三个对象:
第一个对象是建模周期数的滑块输入,称为变量 X。
第二个对象是一个 1x1 矩阵,用户在其中输入单个变量 Y。
第三个对象是一个垂直可扩展的矩阵,用户在其中输入一系列值 X|Y。
该图的基础计算是一个简单的和积,用作此 MWE 的占位符简化。
用户输入链接显示在底部的图像中。
如何在每种情况下用 observe
替换下面 MWE 中使用的两个 observeEvents
?如果可能的话。 (根据我对 observe
函数作用的研究,我相信这将为我遇到的另一个问题提供解决方案)。在我有限的 Shiny 体验中,我只使用了 observeEvents
。
MWE 代码:
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumProd <- function(a, b) {
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T)
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
cols = list(names = FALSE),
class = "numeric"),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = 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, {
tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
updateMatrixInput(session,inputId="matrix2",value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
)
})
plotData <- reactive({
tryCatch(
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(input$periods),
Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)
图像显示了 3 个对象之间的用户输入链接:
我查看了 post ,它很好地说明了 observe
和 observeEvent
在某些情况下的互换性。基于 post,我想出了以下 observeEvent
与 observe
的替换:
sumProd <- function(a, b) {
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T)
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
cols = list(names = FALSE),
class = "numeric"),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session){
observe({
input$periods
if(input$periods!=0){
isolate(
updateMatrixInput(
session, inputId = "matrix2",
value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
)
)
}
})
observe({
input$matrix1
if(input$matrix1!=0){
tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
isolate(
updateMatrixInput(
session,inputId="matrix2",
value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
)
)
}
})
plotData <- reactive({
tryCatch(
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(input$periods),
Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)
以下几乎是 MWE 代码使用 observeEvent
将用户输入链接到三个对象。底部的图像也显示并解释了这三个对象:
第一个对象是建模周期数的滑块输入,称为变量 X。
第二个对象是一个 1x1 矩阵,用户在其中输入单个变量 Y。
第三个对象是一个垂直可扩展的矩阵,用户在其中输入一系列值 X|Y。
该图的基础计算是一个简单的和积,用作此 MWE 的占位符简化。
用户输入链接显示在底部的图像中。
如何在每种情况下用 observe
替换下面 MWE 中使用的两个 observeEvents
?如果可能的话。 (根据我对 observe
函数作用的研究,我相信这将为我遇到的另一个问题提供解决方案)。在我有限的 Shiny 体验中,我只使用了 observeEvents
。
MWE 代码:
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumProd <- function(a, b) {
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T)
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
cols = list(names = FALSE),
class = "numeric"),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = 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, {
tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
updateMatrixInput(session,inputId="matrix2",value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
)
})
plotData <- reactive({
tryCatch(
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(input$periods),
Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)
图像显示了 3 个对象之间的用户输入链接:
我查看了 post observe
和 observeEvent
在某些情况下的互换性。基于 post,我想出了以下 observeEvent
与 observe
的替换:
sumProd <- function(a, b) {
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T)
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
cols = list(names = FALSE),
class = "numeric"),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session){
observe({
input$periods
if(input$periods!=0){
isolate(
updateMatrixInput(
session, inputId = "matrix2",
value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
)
)
}
})
observe({
input$matrix1
if(input$matrix1!=0){
tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
isolate(
updateMatrixInput(
session,inputId="matrix2",
value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
)
)
}
})
plotData <- reactive({
tryCatch(
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(input$periods),
Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)