优化R语言中调整频率后计算向量众数的函数以提升性能

你的代码运行慢甚至崩溃，核心原因是依赖tidyverse的table转tibble加一系列dplyr操作，这些步骤在处理10000个样本时会产生巨大的内存和计算开销。下面是完全基于基础R的高效优化方案：

优化后的调整众数函数 #

freq_adj_mode <- function(x) {
  # 用tabulate快速统计1-5的出现次数，比table高效数倍
  counts <- tabulate(x, nbins = 5)
  # 直接调整1和5的频率（索引1对应数值1，索引5对应数值5）
  counts[c(1, 5)] <- counts[c(1, 5)] * 2
  # 找到调整后频率最大的数值位置
  max_indices <- which(counts == max(counts))
  # 处理多众数情况：有多个最大值时返回均值，否则返回对应数值
  if (length(max_indices) > 1) {
    mean(max_indices)
  } else {
    max_indices[1]
  }
}

优化点说明 #

• 替换table为tabulate：tabulate专门针对整数向量计数，返回紧凑的数值向量，没有table的因子转换和额外属性开销，速度远快于table。
• 抛弃tibble和dplyr管道：直接操作数值向量，避免了数据结构转换、管道调用的额外开销，内存占用也大幅降低。
• 简化逻辑：利用取值范围固定为1-5的特点，直接通过索引定位1和5，省略了原代码中因子转数值的隐式操作。

高效生成样本并计算 #

用矩阵存储样本，配合apply批量处理，比循环单个样本效率更高：

set.seed(123) # 设置随机种子保证结果可重复
# 生成10000个样本，每列是一个包含100个1-5整数的样本
samples <- replicate(10000, sample(1:5, 100, replace = TRUE))
# 按列计算每个样本的调整众数
adjusted_modes <- apply(samples, 2, freq_adj_mode)

效率对比 #

用microbenchmark测试单个样本的处理速度，优化后的函数比原函数快几十倍：

library(microbenchmark)
test_sample <- sample(1:5, 100, replace = TRUE)
microbenchmark(
  原函数 = {
    tab <- table(test_sample) %>% as_tibble()
    tab <- tab %>% mutate(adj.freq = ifelse(x %in% c(1,5),2*n,n))
    max.tab <- tab %>% filter(adj.freq==max(adj.freq))
    mode.response <- max.tab$x %>% as.numeric()
    ifelse(length(mode.response)>1,mean(mode.response),mode.response[1])
  },
  优化函数 = freq_adj_mode(test_sample),
  times = 1000
)

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