在 R 中，如何为二维扩展的矩阵创建动态矩阵索引？

Question

这个post有点过分了。将post一个更简单的问题解决同样的问题...

下面的 MWE 代码改编自一个水平扩展的矩阵，但现在我试图让它在水平和垂直两个方向上扩展。我遇到“错误 [: (下标) 逻辑下标太长”，在某些情况下矩阵输入无响应，如底部图像所示。

我很确定问题的核心在于埋在 lapply(...Y = interpol(input$periods, sanitizedMat()[,(i*2-1):(i*2), drop = FALSE])...

中的矩阵索引

有什么解决办法吗？

我想这需要掌握动态矩阵索引和嵌套 lapply and/or sapply 函数。

自定义 interpol() 函数工作正常，尽管它看起来很糟糕。它允许用户在时间范围内构建值曲线（受每个滑块输入的总体“建模周期”限制），每个场景中的左侧子列指定周期，右侧子列指定值在那段时间申请，并且它：

运行错误检查和一些输入更正
如果第 1 行周期 > 1，则相应的右列值在这些初始周期内保持不变
如果子列中的最后一个周期小于每个滑块输入的最大周期（对于总体建模周期），则剩余周期为 0
任何具有周期间隙的右列值都会被插值，如底部图像所示。这个函数的主要objective是插值

矩阵输入水平扩展以用于其他场景。垂直扩展以扩展情景曲线。底部的图片说明了一切。

MWE 代码：

library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)

interpol <- function(a, b) {
  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
  return(e)
}

ui <- fluidPage(
  sliderInput('periods', 'Periods to model:', min=1, max=10, value=10),
  matrixInput(
    "myMatrixInput",
    label = "Build curves: input periods and variables in left and right columns for each scenario (period gaps interpolated)",
    value =  matrix(c(1, 5), 1, 2, dimnames = list(NULL, rep("Scenario 1", 2))),
    cols = list(extend = TRUE, delta = 2, names = TRUE,  delete = TRUE, multiheader = TRUE),
    rows = list(extend = TRUE, delta = 1, names = FALSE, delete = FALSE),
    class = "numeric"),
  plotOutput("plot")
)

server <- function(input, output, session) {
  sanitizedMat <- reactiveVal() # < necessary for vertical matrix expansion
  observeEvent(input$myMatrixInput, {
    if(any(colnames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      empty_columns <- sapply(tmpMatrix, function(x) all(is.na(x) | x == ""))
      tmpMatrix <- tmpMatrix[, !empty_columns, drop = FALSE]
      colnames(tmpMatrix) <- paste("Scenario", rep(1:ncol(tmpMatrix), each = 2, length.out = ncol(tmpMatrix)))
      isolate(updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix))
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    tryCatch( 
      lapply(seq_len(ncol(sanitizedMat())/2),
             function(i){
               tibble(
                 Scenario = colnames(sanitizedMat())[i*2-1],
                 X = seq_len(input$periods),
                 Y = interpol(input$periods, sanitizedMat()[,(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)

Answer 1

有关解决方案和代码示例，请参阅 post In R, why am I getting "Error in [: (subscript) logical subscript too long"? 的答案。

解决这个问题的关键是在单个 observeEvent() 下消除自动矩阵空列删除并在运行 UDF interpol() 时忽略 NA。当用户添加新场景时子列（1 个场景 header 下的 2 列分组）长度不等时，较短的子列将在某些行中具有 NA。只需忽略计算中的 NA 即可解决问题。

在 R 中，如何为二维扩展的矩阵创建动态矩阵索引？

In R, how to create a dynamic matrix index for a matrix that expands in 2 dimensions?

r

matrix

lapply

sapply

shiny