如何针对每列移除数据中频数低于指定阈值的行？

我有一个数据框，其中多列存在低频次的类别水平（频次为0、1或2）。数据结构示例如下：

AppointmentMonth DayofWeek AppointmentHour   EncounterType
1               Sep       Mon              16    Office Visit
2               Jun       Tue              13    Office Visit
3               Sep       Mon              14 Procedure Visit
4               Dec       Thu              14    Office Visit
5               Mar       Tue              11    Office Visit
6               May       Fri              14    Office Visit
7               May       Tue              11    Office Visit
8               May       Tue               9    Office Visit
.......

查看列的频次表可以看到，部分水平的出现频次低于3，比如AppointmentHour列：

table(data$AppointmentHour)
8  9 10 11 12 13 14 15 16 17 
4  4  2  4  1  2  8  1  3  1 

我需要识别并移除每一列中频数低于阈值（这里设为3）的水平对应的所有行。之前尝试了@akrun的data.table代码，但它是基于多列组合的频次来过滤，不是针对单个列处理的：

library(data.table)

setDT(data)[data[, .I[.N >= 3], 
      by = .(AppointmentMonth, DayofWeek, AppointmentHour, EncounterType)]$V1]

测试数据 #

data <- structure(list(AppointmentMonth = structure(c(9L, 6L, 9L, 12L, 
3L, 5L, 5L, 5L, 7L, 10L, 9L, 12L, 7L, 3L, 11L, 9L, 11L, 12L, 
12L, 7L, 1L, 6L, 7L, 12L, 1L, 3L, 11L, 4L, 9L, 4L), levels = c("Jan", 
"Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", 
"Nov", "Dec"), class = c("ordered", "factor")), DayofWeek = structure(c(2L, 
3L, 2L, 5L, 3L, 6L, 3L, 3L, 3L, 5L, 4L, 2L, 2L, 4L, 2L, 5L, 3L, 
2L, 4L, 3L, 4L, 6L, 6L, 5L, 2L, 2L, 3L, 2L, 3L, 5L), levels = c("Sun", 
"Mon", "Tue", "Wed", "Thu", "Fri", "Sat"), class = c("ordered", 
"factor")), AppointmentHour = c(16L, 13L, 14L, 14L, 11L, 14L, 
11L, 9L, 9L, 11L, 12L, 10L, 16L, 15L, 8L, 8L, 11L, 8L, 14L, 8L, 
16L, 9L, 14L, 14L, 13L, 9L, 10L, 14L, 17L, 14L), EncounterType = structure(c(`Office Visit` = 1L, 
`Office Visit` = 1L, `Procedure Visit` = 2L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, Appointment = 3L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Procedure Visit` = 2L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Procedure Visit` = 2L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Office Visit` = 1L, `Office Visit` = 1L, `Office Visit` = 1L, 
`Office Visit` = 1L), levels = c("Office Visit", "Procedure Visit", 
"Appointment", "Treatment", "Telemedicine"), class = "factor")), row.names = c(NA, 
30L), class = "data.frame")

解决方案 #

方法1：用data.table挨个处理每一列 #

思路很简单：对每一列单独计算每个水平的出现次数，只保留次数≥阈值的水平对应的行，循环处理所有列即可：

library(data.table)
setDT(data)

# 设置阈值，这里为3
threshold <- 3

# 遍历每一列进行过滤
for(col in names(data)){
  # 计算当前列各水平的频次
  freq_data <- data[, .N, by = col][N >= threshold]
  # 保留当前列符合频次要求的行
  data <- data[get(col) %in% freq_data[[col]]]
}

方法2：用dplyr写管道式过滤 #

如果习惯tidyverse风格，用管道操作更清爽：

library(dplyr)

threshold <- 3

data_filtered <- data %>%
  # 保留AppointmentMonth中频数≥3的行
  filter(AppointmentMonth %in% names(which(table(.$AppointmentMonth) >= threshold))) %>%
  # 保留DayofWeek中频数≥3的行
  filter(DayofWeek %in% names(which(table(.$DayofWeek) >= threshold))) %>%
  # 保留AppointmentHour中频数≥3的行
  filter(AppointmentHour %in% names(which(table(.$AppointmentHour) >= threshold))) %>%
  # 保留EncounterType中频数≥3的行
  filter(EncounterType %in% names(which(table(.$EncounterType) >= threshold)))

方法3：写通用函数自动处理所有列 #

如果列数较多，写个函数批量处理更省事：

filter_low_freq <- function(df, threshold){
  for(col in names(df)){
    # 计算当前列的频次表
    freq_table <- table(df[[col]])
    # 筛选出需要保留的水平
    keep_levels <- names(freq_table[freq_table >= threshold])
    # 过滤数据框
    df <- df[df[[col]] %in% keep_levels, ]
  }
  return(df)
}

# 调用函数，传入原始数据和阈值
data_filtered <- filter_low_freq(data, threshold = 3)

验证过滤效果 #

过滤完成后可以检查各列的频次，确保所有水平的出现次数都达标：

# 查看AppointmentHour的频次
table(data_filtered$AppointmentHour)
# 批量查看所有列的频次
lapply(data_filtered, function(x) table(x))

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