在R中基于指定列数值范围创建新数据框的实现需求

原始数据集 #

group  col_2  col_3   col_4
A       TT     12      21
A       RR     11      21
A       LL     13      22
A       QQ     11      24
A       PP     14      25
A       RR     15      26
A       TT     17      28
A       LL     16      29
B       DD     12      23
B       QQ     14      23
B       PP     13      25 
B       HH     11      25
B       LL     15      26
B       DD     17      28
B       QQ     14      29
B       HH     13      30
C       MM     18      21
C       JJ     15      22
C       LL     17      23
C       NN     14      24
C       EE     19      25
C       KK     15      28
C       NN     17      28
C       UU     10      29 
D       II     14      21
D       OO     15      23
D       PP     16      24 
D       LL     17      25 
D       MM     18      26
D       AA     10      28
D       HH     12      29
D       JJ     13      30 

需求说明 #

按group列分组，基于col_4的数值生成新数据框：

• 仅保留col_4在21-30范围内的数据
• 每个分组需对应3个区间：21-22、25-26、29-30，每个区间保留1行数据
• 区间内有多条数据时随机选取1条；无数据则填充NA
• 支持两种输出格式：宽格式（格式一）和长格式（格式二）

实现代码（R语言） #

使用dplyr和tidyr包完成数据处理：

library(dplyr)
library(tidyr)

# 构建原始数据框
df <- data.frame(
  group = c(rep("A",8), rep("B",8), rep("C",8), rep("D",8)),
  col_2 = c("TT","RR","LL","QQ","PP","RR","TT","LL",
            "DD","QQ","PP","HH","LL","DD","QQ","HH",
            "MM","JJ","LL","NN","EE","KK","NN","UU",
            "II","OO","PP","LL","MM","AA","HH","JJ"),
  col_3 = c(12,11,13,11,14,15,17,16,
            12,14,13,11,15,17,14,13,
            18,15,17,14,19,15,17,10,
            14,15,16,17,18,10,12,13),
  col_4 = c(21,21,22,24,25,26,28,29,
            23,23,25,25,26,28,29,30,
            21,22,23,24,25,28,28,29,
            21,23,24,25,26,28,29,30)
)

# 定义目标区间
target_ranges <- tibble(
  range = c("21-22", "25-26", "29-30"),
  lower = c(21,25,29),
  upper = c(22,26,30)
)

# 生成格式二（长格式）结果
result_long <- df %>%
  group_by(group) %>%
  group_modify(function(sub_df, grp) {
    map_dfr(1:nrow(target_ranges), function(i) {
      r <- target_ranges[i,]
      # 筛选当前区间数据
      filtered <- sub_df %>% filter(col_4 >= r$lower & col_4 <= r$upper)
      if(nrow(filtered) > 0) {
        sample_n(filtered, 1) %>% mutate(range = r$range)
      } else {
        tibble(group = grp$group, col_2 = NA, col_3 = NA, col_4 = NA, range = r$range)
      }
    })
  }) %>%
  ungroup()

# 生成格式一（宽格式）结果
result_wide <- result_long %>%
  pivot_wider(
    names_from = range,
    values_from = c(col_2, col_3, col_4),
    names_glue = "{range}_{.value}"
  ) %>%
  select(
    group,
    `21-22_col_2`, `21-22_col_3`, `21-22_col_4`,
    `25-26_col_2`, `25-26_col_3`, `25-26_col_4`,
    `29-30_col_2`, `29-30_col_3`, `29-30_col_4`
  ) %>%
  rename(
    col_2_2122 = `21-22_col_2`, col_3_2122 = `21-22_col_3`, col_4_2122 = `21-22_col_4`,
    col_2_2526 = `25-26_col_2`, col_3_2526 = `25-26_col_3`, col_4_2526 = `25-26_col_4`,
    col_2_2930 = `29-30_col_2`, col_3_2930 = `29-30_col_3`, col_4_2930 = `29-30_col_4`
  )

输出示例 #

格式二（长格式） #

# A tibble: 12 × 5
   group col_2 col_3 col_4 range  
   <chr> <chr> <dbl> <dbl> <chr>  
 1 A     TT       12    21 21-22  
 2 A     RR       15    26 25-26  
 3 A     LL       16    29 29-30  
 4 B     NA       NA    NA 21-22  
 5 B     HH       11    25 25-26  
 6 B     HH       13    30 29-30  
 7 C     MM       18    21 21-22  
 8 C     EE       19    25 25-26  
 9 C     UU       10    29 29-30  
10 D     II       14    21 21-22  
11 D     LL       17    25 25-26  
12 D     JJ       13    30 29-30  

格式一（宽格式） #

# A tibble: 4 × 10
  group col_2_2122 col_3_2122 col_4_2122 col_2_2526 col_3_2526 col_4_2526 col_2_2930 col_3_2930 col_4_2930
  <chr> <chr>           <dbl>      <dbl> <chr>           <dbl>      <dbl> <chr>           <dbl>      <dbl>
1 A     TT                12         21 RR                15         26 LL                16         29
2 B     NA                NA         NA HH                11         25 HH                13         30
3 C     MM                18         21 EE                19         25 UU                10         29
4 D     II                14         21 LL                17         25 JJ                13         30

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