在R Shiny中,如何随着用户输入的扩展而动态扩展函数的使用?



下面的MWE代码插入用户输入(侧栏面板中2列矩阵输入网格中的Y值,id =input1)超过X个周期(侧栏中每个滑块输入,id =periods)。自定义插值函数interpol()在服务器部分由results <- function(){interpol(...)}触发。用户可以通过点击单个动作按钮来添加或修改场景,这将触发包含第二个可扩展矩阵输入(id =input2)的模态。插值结果显示在主面板的图形中。到目前为止一切顺利,一切正常。

按照草案,results函数只处理第一个矩阵输入,包括在第二个矩阵输入中对其执行的任何修改。

我的问题是:如何扩展results函数以包含场景>在第二个可扩展矩阵输入中加入1,并自动将它们包含在输出图中?我一直在努力使用for循环来做到这一点,但不太知道怎么做。我避免了for循环,而是依赖于lapply和related。但在实践中,用户最多不会输入超过20-30个场景,也许for循环是一个无害的选择。但我对任何解决方案都持开放态度,我当然不会执着于for循环!

兆瓦代码:

library(shiny)
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(
sidebarLayout(
sidebarPanel(uiOutput("panel"),actionButton("showInput2","Modify/add interpolation")),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output, session){

results <- function(){interpol(req(input$periods),req(input$input1))}

output$panel <- renderUI({
tagList(
sliderInput('periods','Interpolate over periods (X):',min=2,max=12,value=6),
uiOutput("input1"))
})
output$input1 <- renderUI({
matrixInput("input1", 
label = "Interpolation 1 (Y values):",
value =  matrix(if(isTruthy(input$input2)){c(input$input2[1],input$input2[2])} 
else {c(1,5)},                        # matrix values
1, 2,                                   # matrix row/column count
dimnames = list(NULL,c("Start","End"))  # matrix column header
),
rows =  list(names = FALSE),
class = "numeric")
})

observeEvent(input$showInput2,{
showModal(
modalDialog(
matrixInput("input2",
label = "Automatically numbered scenarios (input into blank cells to add):",
value = if(isTruthy(input$input2)){input$input2}
else if(isTruthy(input$input1)){input$input1},
rows =  list(names = FALSE),
cols =  list(extend = TRUE,
delta = 2,
delete = TRUE,
multiheader=TRUE),
class = "numeric"),
footer = modalButton("Close")
))
})
observe({
req(input$input2)
mm <- input$input2
colnames(mm) <- paste(trunc(1:ncol(mm)/2)+1, " (start|end)")
isolate(updateMatrixInput(session, "input2", mm))
})

output$plot1 <-renderPlot({
req(results())
plot(results(),type="l", xlab = "Periods (X)", ylab = "Interpolated Y values")
})

}
shinyApp(ui, server)

由于用户一次只能(大概)添加一个场景,我不认为for循环会有帮助。我处理这种情况的方法是将额外的数据绑定到observeEvent中的适当反应。然后,这将自动触发必要输出中的更新。下面是一个MWE来说明这个技术。

library(shiny)
library(tidyverse)
ui <- fluidPage(
actionButton("add", "Add scenario"),
plotOutput("plot"),
)
server <- function(input, output, session) {
v <- reactiveValues(results=tibble(Scenario=1, X=1:10, Y=runif(10)))

observeEvent(input$add, {
newData <- tibble(Scenario=max(v$results$Scenario) + 1, X=1:10, Y=runif(10))
v$results <- v$results %>% bind_rows(newData)
})

output$plot <- renderPlot({
v$results %>% ggplot() + geom_point(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
}
shinyApp(ui, server)

最新更新