时间戳

首页 > 解决方案 > 在 R Shiny 中，如何将其他用户输入读入函数并绘制结果？

r - 在 R Shiny 中，如何将其他用户输入读入函数并绘制结果？

问题描述

下面的“MWE 代码 1”按预期工作。input2它在滑块输入周期 (id = ) 上插入用户输入到矩阵 (id = ) 的值input1。单击触发模式的单个操作按钮会生成其他场景（供以后使用）。出于说明目的，每个场景都由随机变量线性调整。

我正在尝试调整上述内容，其中额外的用户输入到矩阵中（总是在 2 的列分组中，用于插入 2 个值）被自动添加到results函数并绘制，而无需单击操作按钮。

下面的“MWE code 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)

请参阅下面的说明图：

在此处输入图像描述

在此处输入图像描述

在此处输入图像描述

标签： rshinyshiny-reactivity

解决方案

编辑：我建议使用基于行的矩阵输入。这使您的生活变得更加轻松，因为您不必在将矩阵传递给自定义函数等之前对其进行整形。

请检查以下内容：

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)

结果2

初步答案

无需计算它们，numScenarios因为它们是由矩阵的尺寸定义的。这同样适用于您稍后将添加的模式 - 只需监视数据的维度以更改绘图 - 无论哪个输入更改反应数据集。

作为一般建议，我建议使用data.frame长格式的 s 而不是矩阵来准备绘图（例如使用 ggplot 或 plotly）。例如，请参阅我的答案here。

请检查以下内容：

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)

推荐阅读