在 R Shiny 中，如何将额外的用户输入读取到函数中并绘制结果？
In R Shiny, how to read additional user inputs into a function and plot the results?
下面的“MWE 代码 1”按预期工作。它将用户在滑块输入周期 (id = input1) 中输入的值插入到矩阵 (id = input2) 中。单击触发模态的单个操作按钮会生成其他场景（供以后使用）。出于说明目的，每个场景都由随机变量线性调整。
我正在尝试调整上面的内容，其中额外的用户输入矩阵（总是在 2 的列分组中，用于插入 2 个值）被自动添加到 results 函数并绘制，没有单击操作按钮。
下面的“MWE代码2”是我这个实现的开始，以我目前的知识结束。 （请注意以 2 列为一组扩展的输入矩阵，以及 runif() 充气器的消除，因为大概每个添加的场景都会不同）。我怎样才能修改 MWE 代码 2 来完成这个？我卡住了。
MWE 代码 1：
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2):",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=runif(1)+results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
}
shinyApp(ui, server)
MWE 代码 2：
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2) where first row lists scenario number:",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
cols = list(extend = TRUE, delta = 2, delete = TRUE, names = TRUE,
editableNames = FALSE, multiheader=TRUE),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
observe({
req(input$input2)
mm <- input$input2
colnames(mm) <- trunc(1:ncol(mm)/2)+1
isolate(updateMatrixInput(session, "input2", mm))
})
}
shinyApp(ui, server)
请参阅下面的说明图片：
编辑： 我建议使用基于行的矩阵输入。这使您的生活变得更加轻松，因为您不必在将矩阵传递给自定义函数等之前重塑矩阵。
请检查以下内容：
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
interpol <- function(a, b) {
# a = periods, b = matrix inputs
c <- rep(NA, a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
return(c)
}
ui <- fluidPage(
titlePanel("myMatrixInput"),
sidebarLayout(
sidebarPanel(
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput) where first row lists scenario number:",
value = matrix(c(10, 1, 5), 1, 3, dimnames = list("Scenario 1", c("Periods", "Value 1", "Value 2"))),
cols = list(
extend = FALSE,
names = TRUE,
editableNames = FALSE
),
rows = list(names = TRUE,
delete = TRUE,
extend = TRUE,
delta = 1),
class = "numeric"
),
actionButton("add", "Add scenario")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
sanitizedMat <- reactiveVal()
observeEvent(input$myMatrixInput, {
if(any(rownames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
}
sanitizedMat(na.omit(input$myMatrixInput))
})
plotData <- reactive({
req(dim(sanitizedMat())[1] >= 1)
lapply(seq_len(nrow(sanitizedMat())),
function(i){
tibble(
Scenario = rownames(sanitizedMat())[i],
X = seq_len(sanitizedMat()[i, 1]),
Y = interpol(sanitizedMat()[i, 1], sanitizedMat()[i, 2:3])
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)
初始答案
不需要计算 numScenarios，因为它们是由矩阵的维度定义的。这同样适用于您稍后将添加的模式 - 只需监视数据的维度以更改绘图 - 无论哪个输入更改反应数据集。
作为一般建议，我建议使用长格式的 data.frames 而不是矩阵来准备绘图（例如使用 ggplot 或 plotly）。例如，请参阅我的回答 。
请检查以下内容：
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
interpol <- function(a, b) {
# a = periods, b = matrix inputs
c <- rep(NA, a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
return(c)
}
ui <- fluidPage(
sliderInput(
'mySliderInput',
'Periods to interpolate (mySliderInput):',
min = 2,
max = 10,
value = 10
),
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput):",
value = matrix(c(1, 5), 1, 2, dimnames = list(NULL, c("Value 1", "Value 2"))),
cols = list(
extend = TRUE,
delta = 2,
delete = TRUE
),
rows = list(names = FALSE),
class = "numeric"
),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
observeEvent(input$add, {
showModal(modalDialog(footer = modalButton("Close")))
})
plotData <- reactive({
req(dim(input$myMatrixInput)[2] >= 2)
# req(dim(input$myMatrixInput)[2]%%2 == 0)
req(input$mySliderInput)
if(as.logical(dim(input$myMatrixInput)[2]%%2)){
myVector <- head(as.vector(input$myMatrixInput), -1)
} else {
myVector <- as.vector(input$myMatrixInput)
}
myMatrix <- matrix(myVector, ncol = 2)
lapply(seq_len(length(myVector)/2),
function(i){
tibble(
Scenario = i,
X = seq_len(input$mySliderInput),
Y = interpol(req(input$mySliderInput), req(myMatrix[i,]))
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)
以上编辑效果非常好。哇。现在，下面对您的编辑进行的简单编辑只是将要插值的周期拉出输入矩阵并返回到单个滑块输入中，因为在完整模型中，这意味着所有输入变量的建模周期必须相同。但是，您的 3 列矩阵输入在另一件事上也对我有帮助，谢谢。此外，我删除了“添加场景”操作按钮，因为自动扩展的输入矩阵不再需要它。我确实从中学到了很多东西。
编辑您的编辑：
ui <- fluidPage(
titlePanel("myMatrixInput"),
sidebarLayout(
sidebarPanel(
sliderInput('periods','Periods to interpolate:',min=2,max=10,value=10),
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput):",
value = matrix(c(1, 5), 1, 2, dimnames = list("Scenario 1", c("Value 1", "Value 2"))),
cols = list(extend = FALSE,
names = TRUE,
editableNames = FALSE),
rows = list(names = TRUE,
delete = TRUE,
extend = TRUE,
delta = 1),
class = "numeric"
),
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
sanitizedMat <- reactiveVal()
observeEvent(input$myMatrixInput, {
if(any(rownames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
}
sanitizedMat(na.omit(input$myMatrixInput))
})
plotData <- reactive({
req(dim(sanitizedMat())[1] >= 1)
lapply(seq_len(nrow(sanitizedMat())),
function(i){
tibble(
Scenario = rownames(sanitizedMat())[i],
X = 1:input$periods,
Y = interpol(input$periods, sanitizedMat()[i, 1:2])
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)
下面的“MWE 代码 1”按预期工作。它将用户在滑块输入周期 (id = input1) 中输入的值插入到矩阵 (id = input2) 中。单击触发模态的单个操作按钮会生成其他场景（供以后使用）。出于说明目的，每个场景都由随机变量线性调整。
我正在尝试调整上面的内容，其中额外的用户输入矩阵（总是在 2 的列分组中，用于插入 2 个值）被自动添加到 results 函数并绘制，没有单击操作按钮。
下面的“MWE代码2”是我这个实现的开始，以我目前的知识结束。 （请注意以 2 列为一组扩展的输入矩阵，以及 runif() 充气器的消除，因为大概每个添加的场景都会不同）。我怎样才能修改 MWE 代码 2 来完成这个？我卡住了。
MWE 代码 1：
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2):",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=runif(1)+results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
}
shinyApp(ui, server)
MWE 代码 2：
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2) where first row lists scenario number:",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
cols = list(extend = TRUE, delta = 2, delete = TRUE, names = TRUE,
editableNames = FALSE, multiheader=TRUE),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
observe({
req(input$input2)
mm <- input$input2
colnames(mm) <- trunc(1:ncol(mm)/2)+1
isolate(updateMatrixInput(session, "input2", mm))
})
}
shinyApp(ui, server)
请参阅下面的说明图片：
编辑： 我建议使用基于行的矩阵输入。这使您的生活变得更加轻松，因为您不必在将矩阵传递给自定义函数等之前重塑矩阵。
请检查以下内容：
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
interpol <- function(a, b) {
# a = periods, b = matrix inputs
c <- rep(NA, a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
return(c)
}
ui <- fluidPage(
titlePanel("myMatrixInput"),
sidebarLayout(
sidebarPanel(
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput) where first row lists scenario number:",
value = matrix(c(10, 1, 5), 1, 3, dimnames = list("Scenario 1", c("Periods", "Value 1", "Value 2"))),
cols = list(
extend = FALSE,
names = TRUE,
editableNames = FALSE
),
rows = list(names = TRUE,
delete = TRUE,
extend = TRUE,
delta = 1),
class = "numeric"
),
actionButton("add", "Add scenario")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
sanitizedMat <- reactiveVal()
observeEvent(input$myMatrixInput, {
if(any(rownames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
}
sanitizedMat(na.omit(input$myMatrixInput))
})
plotData <- reactive({
req(dim(sanitizedMat())[1] >= 1)
lapply(seq_len(nrow(sanitizedMat())),
function(i){
tibble(
Scenario = rownames(sanitizedMat())[i],
X = seq_len(sanitizedMat()[i, 1]),
Y = interpol(sanitizedMat()[i, 1], sanitizedMat()[i, 2:3])
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)
初始答案
不需要计算 numScenarios，因为它们是由矩阵的维度定义的。这同样适用于您稍后将添加的模式 - 只需监视数据的维度以更改绘图 - 无论哪个输入更改反应数据集。
作为一般建议，我建议使用长格式的 data.frames 而不是矩阵来准备绘图（例如使用 ggplot 或 plotly）。例如，请参阅我的回答
请检查以下内容：
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
interpol <- function(a, b) {
# a = periods, b = matrix inputs
c <- rep(NA, a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
return(c)
}
ui <- fluidPage(
sliderInput(
'mySliderInput',
'Periods to interpolate (mySliderInput):',
min = 2,
max = 10,
value = 10
),
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput):",
value = matrix(c(1, 5), 1, 2, dimnames = list(NULL, c("Value 1", "Value 2"))),
cols = list(
extend = TRUE,
delta = 2,
delete = TRUE
),
rows = list(names = FALSE),
class = "numeric"
),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
observeEvent(input$add, {
showModal(modalDialog(footer = modalButton("Close")))
})
plotData <- reactive({
req(dim(input$myMatrixInput)[2] >= 2)
# req(dim(input$myMatrixInput)[2]%%2 == 0)
req(input$mySliderInput)
if(as.logical(dim(input$myMatrixInput)[2]%%2)){
myVector <- head(as.vector(input$myMatrixInput), -1)
} else {
myVector <- as.vector(input$myMatrixInput)
}
myMatrix <- matrix(myVector, ncol = 2)
lapply(seq_len(length(myVector)/2),
function(i){
tibble(
Scenario = i,
X = seq_len(input$mySliderInput),
Y = interpol(req(input$mySliderInput), req(myMatrix[i,]))
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)
以上编辑效果非常好。哇。现在，下面对您的编辑进行的简单编辑只是将要插值的周期拉出输入矩阵并返回到单个滑块输入中，因为在完整模型中，这意味着所有输入变量的建模周期必须相同。但是，您的 3 列矩阵输入在另一件事上也对我有帮助，谢谢。此外，我删除了“添加场景”操作按钮，因为自动扩展的输入矩阵不再需要它。我确实从中学到了很多东西。
编辑您的编辑：
ui <- fluidPage(
titlePanel("myMatrixInput"),
sidebarLayout(
sidebarPanel(
sliderInput('periods','Periods to interpolate:',min=2,max=10,value=10),
matrixInput(
"myMatrixInput",
label = "Values to interpolate (myMatrixInput):",
value = matrix(c(1, 5), 1, 2, dimnames = list("Scenario 1", c("Value 1", "Value 2"))),
cols = list(extend = FALSE,
names = TRUE,
editableNames = FALSE),
rows = list(names = TRUE,
delete = TRUE,
extend = TRUE,
delta = 1),
class = "numeric"
),
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
sanitizedMat <- reactiveVal()
observeEvent(input$myMatrixInput, {
if(any(rownames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
}
sanitizedMat(na.omit(input$myMatrixInput))
})
plotData <- reactive({
req(dim(sanitizedMat())[1] >= 1)
lapply(seq_len(nrow(sanitizedMat())),
function(i){
tibble(
Scenario = rownames(sanitizedMat())[i],
X = 1:input$periods,
Y = interpol(input$periods, sanitizedMat()[i, 1:2])
)
}) %>% bind_rows()
})
output$plot <- renderPlot({
req(nrow(plotData()) > 0)
plotData() %>% ggplot() + geom_line(aes(
x = X,
y = Y,
colour = as.factor(Scenario)
))
})
}
shinyApp(ui, server)