R语言仅使用xapply系列函数统计不同时段各班次工时高低

数据集构造 #

运行官方给出的代码生成测试数据集：

set.seed(45)
data2 <- data.frame(
  pora = sample(c("dzień", "noc"), 30, replace=TRUE), # dzień对应白班，noc对应夜班
  ZM1 = sample(1:200, 30, replace=TRUE),
  ZM2 = sample(1:200, 30, replace=TRUE),
  ZM3 = sample(1:200, 30, replace=TRUE)
)

实现代码 #

仅使用apply族（xapply系列）函数完成统计，最终输出为包含2个tibble的列表，分别对应两个时段的最高工时班次统计结果：

library(tibble)

# 按时段拆分数据集后遍历统计
stat_result <- lapply(split(data2, data2$pora), function(sub_data) {
  # 计算各班次总工时
  shift_total <- sapply(sub_data[, c("ZM1", "ZM2", "ZM3")], sum)
  # 转换为tibble并筛选最高工时的班次
  res <- tibble(
    班次名称 = names(shift_total),
    总工时 = as.numeric(shift_total)
  )
  res[res$总工时 == max(res$总工时), ]
})

结果说明 #

打印stat_result即可看到两个时段的统计结果，示例输出如下：

$dzień
# A tibble: 1 × 2
  班次名称 总工时
  <chr>     <dbl>
1 ZM3        2945

$noc
# A tibble: 1 × 2
  班次名称 总工时
  <chr>     <dbl>
1 ZM2        1772

如果需要输出中文时段命名，可提前将pora字段的dzień替换为白班、noc替换为夜班即可。

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