在R中,为什么我在[:(下标)逻辑下标太长";中出现错误? [英] In R, why am I getting "Error in [: (subscript) logical subscript too long"?
本文介绍了在R中,为什么我在[:(下标)逻辑下标太长";中出现错误?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
下面的MWE代码1可以很好地计算2列数字的和积,并且求和输入矩阵水平扩展以适应其他求和方案。
下面的MWE代码2是对MWE代码1的修改,使输入矩阵也可以垂直扩展,因此用户可以添加要在求和乘积计算中求和的元素行。当我运行MWE代码2时,代码崩溃,在[:(下标)逻辑下标太长&qot;中出现错误。为什么我收到此错误?
下面的图片说明了该问题。
MWE代码1:
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
sumProd <- function(a, b) { # a = periods, b = matrix inputs
c <- rep(NA, a)
c[] <- sum(b[,1]) %*% sum(b[,2])
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'X-axis periods:', min=1, max=10, value=10),
matrixInput(
"myMatrixInput",
label = "Two columns to sumproduct are paired under each scenario heading:",
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 = FALSE, delta = 1, names = FALSE, delete = FALSE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session) {
observeEvent(input$myMatrixInput, {
tmpMatrix <- input$myMatrixInput
# Remove any empty matrix columns
empty_columns <- sapply(tmpMatrix, function(x) all(is.na(x) | x == ""))
tmpMatrix <- tmpMatrix[, !empty_columns, drop=FALSE]
# Assign column header names
colnames(tmpMatrix) <- paste("Scenario", rep(1:ncol(tmpMatrix), each = 2, length.out = ncol(tmpMatrix)))
isolate( # isolate update to prevent infinite loop
updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
)
})
plotData <- reactive({
tryCatch(
lapply(seq_len(ncol(input$myMatrixInput)/2),
function(i){
tibble(
Scenario = colnames(input$myMatrixInput)[i*2-1],
X = seq_len(input$periods),
Y = sumProd(input$periods,input$myMatrixInput[1,(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)
))
})
}
shinyApp(ui, server)
MWE代码2:
sumProd <- function(a, b) { # a = periods, b = matrix inputs
c <- rep(NA, a)
c[] <- sum(b[,1]) %*% sum(b[,2])
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'X-axis periods:', min=1, max=10, value=10),
matrixInput(
"myMatrixInput",
label = "Two columns to sumproduct are paired under each scenario heading:",
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() # < for vertical matrix expansion
observeEvent(input$myMatrixInput, {
if(any(colnames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
# Remove any empty matrix columns
empty_columns <- sapply(tmpMatrix, function(x) all(is.na(x) | x == ""))
tmpMatrix <- tmpMatrix[, !empty_columns, drop=FALSE]
# Assign column header names
colnames(tmpMatrix) <- paste("Scenario", rep(1:ncol(tmpMatrix), each = 2, length.out = ncol(tmpMatrix)))
isolate( # isolate update to prevent infinite loop
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 = sumProd(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)
))
})
}
shinyApp(ui, server)
推荐答案
的解决方案是简单地删除单个observeEvent()
下的自动矩阵空列删除,并修改sumProd()
忽略NA的(在sumProd()
中添加na.rm = T
到sum()
))。当子列(每个方案标题下的2列分组)的长度不相等时,矩阵中将出现NA,因此忽略NA可以解决问题。还删除了MWE2中的UDFsanitizedMat()
和自动空列删除功能以简化操作。
修订代码:
library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)
sumProd <- function(a, b) { # a = periods, b = matrix inputs
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T) # Added na.rm = T
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'X-axis periods:', min=1, max=10, value=10),
matrixInput(
"myMatrixInput",
label = "Two columns to sumproduct are paired under each scenario heading:",
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) {
observeEvent(input$myMatrixInput, {
if(any(colnames(input$myMatrixInput) == "")){
tmpMatrix <- input$myMatrixInput
colnames(tmpMatrix) <- paste("Scenario",rep(1:ncol(tmpMatrix),each=2,length.out=ncol(tmpMatrix)))
isolate(updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix))
}
input$myMatrixInput
})
plotData <- reactive({
tryCatch(
lapply(seq_len(ncol(input$myMatrixInput)/2), # column counter to set matrix index as it expands
function(i){
tibble(
Scenario = colnames(input$myMatrixInput)[i*2-1],
X = seq_len(input$periods),
Y = sumProd(input$periods,input$myMatrixInput[,(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)
))
})
}
shinyApp(ui, server)
这篇关于在R中,为什么我在[:(下标)逻辑下标太长";中出现错误?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文