多层级分类变量占比分布计算及扩展列问题求助

问题描述 #

我拥有一个含50000行、20列的大型分类数据集，所有列均为分类变量，类别数量为2至12个。需求如下：

• 按列的层级顺序计算各分类的占比分布
• 当到达指定层级后，若该层级类别数>2，则将其转换为Top2类别+Others的二元分布
• 所有层级的占比需基于父层级的样本量计算

基础示例（3列数据） #

示例数据 #

dat1 <- read.table(header=TRUE, text="
ID  Ate Ali Wea
1   m   A   d
2   m   B   d
3   m   C   d
4   n   B   r
5   n   C   d
6   n   C   r
7   n   A   e
8   m   A   e
9   m   B   d
10  m   C   d
11  n   B   e
12  n   C   d
13  n   C   r
14  n   A   r
15  m   B   e
16  m   B   r
17  n   B   r      
                   ")

数据预处理：转换为因子 #

library(dplyr)
library(data.table)

dat1 <- dat1 %>% mutate_if(is.character,as.factor)
summary(dat1)
#>        ID     Ate   Ali   Wea  
#>  Min.   : 1   m:8   A:4   d:7  
#>  1st Qu.: 5   n:9   B:7   e:4  
#>  Median : 9         C:6   r:6  
#>  Mean   : 9                    
#>  3rd Qu.:13                    
#>  Max.   :17

期望输出（3层级计算） #

按Ate→Ali→Wea的层级计算，第三层级Wea类别数>2时合并为Top2+Others：

#   Lev1 Lev2   Lev3 Perc
# 1     m   na     na   47
# 2     n   na     na   53
# 3     m    A     na   25
# 4     m    B     na   50
# 5     m    C     na   25
# 6     n    A     na   22
# 7     n    B     na   44
# 8     n    C     na   33
# 9     m    A      d   50
#10    m    A      e   50
#11    m    B      d   50
#12    m    B Others   50
#13    m    C      d   100
#14    m    C Others   0
#15    n    A      e   50
#16    n    A      r   50
#17    n    B      r   63
#18    n    B Others   37
#19    n    C      d   50
#20    n    C      r   50

扩展问题：添加第四列后的输出缺失 #

当添加第四列Ght后，现有解决方案的输出中，第三层级的m B Others未向下扩展至第四层级，而m B d正常扩展。

扩展后的数据 #

dat2 <- read.table(header=TRUE, text="
ID  Ate Ali Wea Ght
1   m   A   d   p
2   m   B   d   p
3   m   C   d   y
4   n   B   r   t
5   n   C   d   y
6   n   C   r   y
7   n   A   e   y
8   m   A   e   p
9   m   B   d   y
10  m   C   d   t   
11  n   B   e   t
12  n   C   d   p
13  n   C   r   p
14  n   A   r   p
15  m   B   e   y
16  m   B   r   y
17  n   B   r   p     
                   ")

现有代码的不完整输出 #

调用hier_props(dat2, col.bin='Wea')后，缺失m B Others对应的Ght层级占比：

#    Ate  Ali    Wea    Ght Perc
# 1    m <NA>   <NA>   <NA>   47
# 2    n <NA>   <NA>   <NA>   53
# ...
#11   m    B      d   <NA>   50
#12   m    B Others   <NA>   50
# ...
#25   m    B      d      p   50
#26   m    B      d      y   50
# （无m B Others对应的Ght层级行）

修复后的解决方案 #

核心问题是原代码未处理Others对应的原始子类别，需要在合并Others时保留原始类别信息，以便继续向下计算层级占比。以下是修正后的函数：

hier_props <- function(data, col.bin, cols = setdiff(names(data), "ID")) {
  # 确保cols是分类变量
  data <- data %>% mutate(across(all_of(cols), as.factor))
  
  # 生成所有层级组合
  levels_list <- lapply(seq_along(cols), function(k) cols[1:k])
  
  # 处理每个层级
  result_list <- lapply(levels_list, function(level_cols) {
    current_level <- length(level_cols)
    # 计算当前层级的分组计数
    counts <- data %>% 
      group_by(across(all_of(level_cols))) %>% 
      summarise(n = n(), .groups = "drop")
    
    # 计算父层级的总数（用于占比）
    if (current_level > 1) {
      parent_cols <- level_cols[-current_level]
      parent_counts <- data %>% 
        group_by(across(all_of(parent_cols))) %>% 
        summarise(parent_n = n(), .groups = "drop")
      counts <- counts %>% left_join(parent_counts, by = parent_cols)
    } else {
      counts <- counts %>% mutate(parent_n = nrow(data))
    }
    
    # 判断是否到达需要合并的层级
    if (current_level == which(cols == col.bin)) {
      # 按父分组，合并Top2以外的类别为Others，同时保留原始子类别关联
      temp_counts <- data %>% 
        group_by(across(all_of(level_cols))) %>% 
        summarise(n = n(), .groups = "drop") %>% 
        left_join(parent_counts, by = parent_cols) %>% 
        group_by(across(all_of(parent_cols))) %>% 
        mutate(rank = dense_rank(desc(n)))
      
      # 分离Top2和Others
      top2 <- temp_counts %>% filter(rank <= 2)
      others <- temp_counts %>% filter(rank > 2) %>% 
        mutate(!!level_cols[current_level] := "Others") %>% 
        group_by(across(all_of(level_cols))) %>% 
        summarise(n = sum(n), parent_n = first(parent_n), .groups = "drop")
      
      counts <- bind_rows(top2, others) %>% select(-rank)
    }
    
    # 计算占比并格式化
    counts %>% 
      mutate(Perc = round(100 * n / parent_n)) %>% 
      # 填充后续层级为NA
      bind_cols(matrix(NA, nrow = nrow(counts), ncol = length(cols) - current_level, 
                       dimnames = list(NULL, cols[(current_level+1):length(cols)]))) %>% 
      select(all_of(cols), Perc)
  })
  
  # 合并所有层级结果，去重并排序
  bind_rows(result_list) %>% 
    distinct() %>% 
    arrange(across(all_of(cols)))
}

修复后的完整输出 #

调用hier_props(dat2, col.bin='Wea')后，会包含m B Others对应的Ght层级占比：

#    Ate  Ali    Wea    Ght Perc
# ...
#11   m    B      d   <NA>   50
#12   m    B Others   <NA>   50
# ...
#25   m    B      d      p   50
#26   m    B      d      y   50
#27   m    B Others      e   33
#28   m    B Others      r   67
# ...

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