基于字符串向量过滤数据集时触发order函数参数错误

错误原因 #

当你选择的关键词对应的单组（keyword + gmb_id）数据行数少于3行时，zoo::rollapply计算的rolling_volatility会全为NA，后续na.omit()会删除所有行，导致最终数据框为空。DT组件在渲染空数据框时，内部排序逻辑调用order函数时出现"argument 1 is not a vector"错误。

另外，你的示例数据中每个关键词仅对应1条数据，无论选择哪个关键词，都会触发这个问题。

解决方法 #

方案1：移除na.omit()，保留含NA的行 #

直接去掉na.omit()，保留所有行（包括rolling_volatility为NA的行），这样数据框不会为空，DT可以正常渲染，同时可以在DT中对NA值进行格式化。

方案2：仅处理数据行数足够的分组 #

在group_by后添加filter(n() >= 3)，只保留数据行数≥3的分组，避免生成全NA的滚动波动率列。

修改后的代码（方案1） #

library(shiny)
library(shinydashboard)
library(dplyr)
library(plotly)
library(DT)
library(zoo)
library(shinyWidgets)

# Sample data
sample_data <- tibble::tibble(
  keyword = c("closing costs", "competitive commission", "curb appeal", "expert negotiation", 
              "home inspection", "market analysis", "mortgage pre-approval", "open house", 
              "price reduction", "staging tips"),
  gmb_id = rep("43763", 10),
  date = seq.Date(from = as.Date("2025-03-10"), by = "1 day", length.out = 10),
  pin_count = rep(39, 10),
  gmb_return = runif(10, -0.05, 0.05),
  gmb_abs_return = abs(runif(10, -0.05, 0.05))
)

# 为测试滚动波动率，调整示例数据：每个关键词对应3条数据
sample_data <- sample_data %>%
  slice(rep(1:n(), each = 3)) %>%
  mutate(date = seq.Date(from = as.Date("2025-03-10"), by = "1 day", length.out = n()))

ui <- dashboardPage(
  dashboardHeader(title = "🔧 Toy Pin Volatility"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Pin Volatility per Keyword", tabName = "pin_tab", icon = icon("map-pin")),
      pickerInput(
        inputId = "selected_keywords_pins",
        label = "Select Keyword(s)",
        choices = unique(sample_data$keyword),
        selected = unique(sample_data$keyword)[1:3],
        multiple = TRUE,
        options = list(`actions-box` = TRUE, `none-selected-text` = "请选择关键词")
      )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "pin_tab",
        
        fluidRow(
          box(width = 12, DTOutput("volatility_table_pins"))
        )
      )
    )
  )
)

server <- function(input, output, session) {
  rolling_pins <- reactive({
    req(input$selected_keywords_pins)
    
    sample_data %>%
      filter(trimws(keyword) %in% trimws(input$selected_keywords_pins)) %>%
      arrange(keyword, gmb_id, date) %>%
      group_by(keyword, gmb_id) %>%
      mutate(
        rolling_volatility = zoo::rollapply(gmb_abs_return,
                                            width = 3,
                                            FUN = sd,
                                            fill = NA,
                                            align = "right")
      ) %>%
      ungroup()
      # 移除na.omit()，保留含NA的行
  })
  
  output$volatility_table_pins <- renderDT({
    datatable(
      rolling_pins(),
      options = list(pageLength = 10, scrollX = TRUE),
      rownames = FALSE,
      # 格式化NA值为短横线，提升可读性
      formatStyle("rolling_volatility", na.string = "-")
    )
  })
}

shinyApp(ui, server)

修改说明 #

1. 调整示例数据，每个关键词重复3次，确保能计算出有效的滚动波动率（前两行仍为NA）。
2. 移除na.omit()，避免数据框为空触发错误。
3. 在DT中设置na.string = "-"，将NA值显示为短横线，优化展示效果。
4. 给pickerInput添加none-selected-text选项，提升用户体验。

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