Shiny库存仪表板侧边栏数量统计报错：$运算符不适用于原子向量

问题背景 #

为小型公司开发库存零件追踪的Shiny基础仪表板，包含SQLite数据库创建、条目增删改功能，期望侧边栏统计框实现：

• 搜索框匹配条目的quantity列总和
• 搜索框为空时显示全部总量

当前侧边栏触发报错：Error: $ operator is invalid for atomic vectors，尝试grepl、contains等筛选方法未解决。

报错原因分析 #

1. DT搜索输入访问错误：应用启动时input$responses_table_search未初始化，直接访问input$responses_table_search$value会触发报错（NULL不是列表类型，无法使用$操作符）
2. quantity列类型混乱：表单中selectInput返回字符型值，保存到数据库后未转换为数值型，导致求和计算异常

修复方案 #

1. 安全处理DT搜索输入 #

用input[["responses_table_search"]][["value"]]安全访问搜索值，结合isTruthy()判断有效性，避免未初始化时的报错；同时用str_to_lower()统一大小写，提升搜索兼容性。

2. 统一quantity列数值类型 #

在表单数据保存、编辑、数据库读取环节，强制将quantity转换为数值型，确保求和逻辑正常运行。

3. 优化筛选逻辑 #

当搜索框为空时直接返回全部数据，简化判断逻辑。

修复后的完整代码 #

library(DBI)
library(RSQLite)
library(shiny)
library(DT)
library(pool)
library(shinyjs)
library(uuid)
library(dplyr)
library(shinythemes)
library(shinyWidgets)
library(stringr)
library(shinydashboard)

# 创建SQLite数据库连接池
pool <- dbPool(RSQLite::SQLite(), dbname = "Inventorydb.sqlite")

# 初始化空数据框
responses_df <- data.frame(
  row_id             = character(),
  part_number        = character(),
  order_number       = character(), 
  quantity           = as.numeric(),
  metal_finished     = character(),
  anodized           = character(),
  comments           = character(),
  date               = as.Date(character()),
  stringsAsFactors   = FALSE
)

# 仅当表不存在时创建数据库表
if (!dbExistsTable(pool, "responses_df")) {
  dbWriteTable(pool, "responses_df", responses_df, overwrite = FALSE, append = FALSE)
}

# 必填字段标记函数
labelMandatory <- function(label) {
  tagList(
    label,
    span("*", class = "mandatory_star")
  )
}

appCSS <- ".mandatory_star { color: red; }"

# UI部分
ui <- dashboardPage(
  dashboardHeader(title = "Company X"),
  dashboardSidebar(
    width = 250,
    box(
      title = "Total Quantity",
      width = "100%",
      solidHeader = TRUE,
      verbatimTextOutput("total_quantity"),
      footer = "Total Quantity",
      status = "primary"
    )
  ),
  dashboardBody(
    useShinyjs(),
    inlineCSS(appCSS),
    fluidRow(
      actionButton("add_button", "Add", icon("plus")),
      actionButton("edit_button", "Edit", icon("edit")),
      actionButton("copy_button", "Copy", icon("copy")),
      actionButton("delete_button", "Delete", icon("trash-alt"))
    ),
    fluidRow(
      dataTableOutput("responses_table")
    )
  )
)

# Server部分
server <- function(input, output, session) {
  
  # 响应式读取数据库数据，确保quantity为数值型
  responses_df <- reactive({
    input$submit
    input$submit_edit
    input$copy_button
    input$delete_button
    
    dbReadTable(pool, "responses_df") %>%
      mutate(quantity = as.numeric(quantity))
  })
  
  # 必填字段检查逻辑
  fieldsMandatory <- c("part_number", "order_number", "quantity", "metal_finished", "anodized")
  
  observe({
    mandatoryFilled <- vapply(fieldsMandatory, function(x) {
      !is.null(input[[x]]) && input[[x]] != ""
    }, logical(1))
    shinyjs::toggleState(id = "submit", condition = all(mandatoryFilled))
  })
  
  # 数据录入表单弹窗
  entry_form <- function(button_id){
    showModal(
      modalDialog(
        div(id=("entry_form"),
            tags$head(tags$style(".modal-dialog{ width:500px}")),
            tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible}"))),
            fluidPage(
              fluidRow(
                textInput("part_number", labelMandatory("Part Number"), placeholder = "Enter Text...", width = '456px')
              ),
              fluidRow(
                textInput("order_number", labelMandatory("Order Number"), placeholder = "Enter Text...", width = '456px')
              ),
              selectInput("quantity", labelMandatory("Quantity Removed"), multiple = FALSE, choices = 1:500),
              splitLayout(
                cellWidths = c("226px", "226px"),
                cellArgs = list(style = "vertical-align: top"),
                selectInput("metal_finished", labelMandatory("Metal Finished?"), multiple = FALSE, choices = c("", "Yes", "No")),
                selectInput("anodized", labelMandatory("Anodized?"), multiple = FALSE, choices = c("", "Yes", "No"))
              ),
              textAreaInput("comments", labelMandatory("Comments"), placeholder = "Enter comments here...", height = 200, width = "456px"),
              helpText(labelMandatory(""), paste("Mandatory field.")),
              actionButton(button_id, "Submit")
            ),
            easyClose = TRUE
        )
      )
    )
  }
  
  # 表单数据处理，确保quantity为数值型
  fieldsAll <- c("part_number", "order_number", "quantity", "metal_finished", "anodized", "comments")
  
  formData <- reactive({
    data.frame(
      row_id              = UUIDgenerate(),
      part_number         = input$part_number,
      order_number        = input$order_number,
      quantity            = as.numeric(input$quantity),
      metal_finished      = input$metal_finished,
      anodized            = input$anodized,
      comments            = input$comments,
      date                = as.character(format(Sys.Date(), format="%Y-%m-%d")),
      stringsAsFactors    = FALSE
    )
  })
  
  # 添加数据到数据库
  appendData <- function(data){
    query <- sqlAppendTable(pool, "responses_df", data, row.names = FALSE)
    dbExecute(pool, query)
  }
  
  observeEvent(input$add_button, priority = 20,{
    entry_form("submit")
  })
  
  observeEvent(input$submit, priority = 20,{
    appendData(formData())
    shinyjs::reset("entry_form")
    removeModal()
  })
  
  # 删除数据逻辑（添加确认弹窗）
  deleteData <- function(){
    SQL_df <- responses_df()
    row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"]
    lapply(row_selection, function(nr){
      dbExecute(pool, sprintf('DELETE FROM "responses_df" WHERE "row_id" = ?'), param = list(nr))
    })
  }
  
  observeEvent(input$delete_button, priority = 20,{
    if(length(input$responses_table_rows_selected)>=1 ){
      showModal(modalDialog(
        title = "Are you sure?",
        actionButton("confirm_delete", "Confirm Delete"),
        easyClose = TRUE
      ))
    } else {
      showModal(modalDialog(
        title = "Warning",
        paste("Please select row(s)." ),easyClose = TRUE
      ))
    }
  })
  
  observeEvent(input$confirm_delete, {
    deleteData()
    removeModal()
  })
  
  # 复制数据逻辑
  unique_id <- function(data){
    replicate(nrow(data), UUIDgenerate())
  }
  
  copyData <- function(){
    SQL_df <- responses_df()
    row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"]
    SQL_df <- SQL_df %>% filter(row_id %in% row_selection)
    SQL_df$row_id <- unique_id(SQL_df)
    
    query <- sqlAppendTable(pool, "responses_df", SQL_df, row.names = FALSE)
    dbExecute(pool, query)
  }
  
  observeEvent(input$copy_button, priority = 20,{
    if(length(input$responses_table_rows_selected)>=1 ){
      copyData()
    } else {
      showModal(modalDialog(
        title = "Warning",
        paste("Please select row(s)." ),easyClose = TRUE
      ))
    }
  })
  
  # 编辑数据逻辑
  observeEvent(input$edit_button, priority = 20,{
    SQL_df <- responses_df()
    
    if(length(input$responses_table_rows_selected) > 1 ){
      showModal(modalDialog(
        title = "Warning",
        paste("Please select only one row." ),easyClose = TRUE
      ))
    } else if(length(input$responses_table_rows_selected) < 1){
      showModal(modalDialog(
        title = "Warning",
        paste("Please select a row." ),easyClose = TRUE
      ))
    } else {
      entry_form("submit_edit")
      
      selected_row <- SQL_df[input$responses_table_rows_selected, ]
      updateTextInput(session, "part_number", value = selected_row$part_number)
      updateTextInput(session, "order_number", value = selected_row$order_number)
      updateSelectInput(session, "quantity", selected = as.character(selected_row$quantity))
      updateSelectInput(session, "metal_finished", value = selected_row$metal_finished)
      updateSelectInput(session, "anodized", selected = selected_row$anodized)
      updateTextAreaInput(session, "comments", value = selected_row$comments)
    }
  })
  
  observeEvent(input$submit_edit, priority = 20, {
    SQL_df <- responses_df()
    row_selection <- SQL_df[input$responses_table_row_last_clicked, "row_id"]
    dbExecute(pool, sprintf('UPDATE "responses_df" SET "part_number" = ?, "order_number" = ?, "quantity" = ?, "metal_finished" = ?, "anodized" = ?,
                            "comments" = ? WHERE "row_id" = ?'),
              param = list(
                input$part_number,
                input$order_number,
                as.numeric(input$quantity),
                input$metal_finished,
                input$anodized,
                input$comments,
                row_selection
              ))
    removeModal()
  })
  
  # 基于搜索框过滤数据
  filtered_data <- reactive({
    data <- responses_df()
    
    # 安全处理搜索输入
    search_val <- input[["responses_table_search"]][["value"]]
    if (isTruthy(search_val)) {
      data <- data %>%
        filter(str_detect(str_to_lower(order_number), str_to_lower(search_val)))
    }
    
    data
  })
  
  # 渲染侧边栏总数量
  output$total_quantity <- renderText({
    total <- sum(filtered_data()$quantity, na.rm = TRUE)
    paste("Total Quantity: ", total)
  })
  
  # 渲染数据表格
  output$responses_table <- DT::renderDataTable({
    table <- responses_df() %>% select(-row_id)
    names(table) <- c("Part Number", "Order Number", "Quantity", "Metal Finished", "Anodized", "Comments", "Date")
    
    datatable(
      table,
      rownames = FALSE,
      extensions = 'Buttons',
      options = list(
        dom = 'Bfrtip',
        buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
        searching = TRUE,
        lengthChange = TRUE
      )
    )
  })
  
}

# 启动应用
shinyApp(ui = ui, server = server)

关键修改点说明 #

• 数据库表创建优化：添加判断避免重复创建表
• 数值类型统一：全流程确保quantity为数值型，解决求和异常
• 搜索输入安全处理：避免未初始化时的$操作符报错
• 删除功能优化：添加确认弹窗，防止误删
• 日期格式标准化：使用%Y-%m-%d格式存储日期，避免格式混乱

内容的提问来源于stack exchange，提问作者Matthew Rogers