如何在tidytable中无循环拆分占总成交量25%的行

原始代码与需求 #

原始数据与前置计算 #

library(tidytable)

my_dt <- tidytable(
     price = c(4.5, 4.6, 4.7, 4.8, 5.1),
     volume = c(0.4,1.2,0.3,8.7,6.5)
)

total = my_dt %>% summarize(total = sum(volume)) %>% pull(total)

trim = total*0.25

需求说明 #

需要找到对应总成交量25%的price值，将该行拆分为“修剪”部分与非修剪部分，最终得到如下结果：

post_trim <- tidytable(
         price = c(4.5, 4.6, 4.7, 4.8, 4.8, 5.1),
         volume = c(0.4, 1.2, 0.3, 2.375, 6.325, 6.5),
         trim = c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE)
    )

无循环解决方案 #

利用tidytable的窗口函数与行拆分功能实现，代码如下：

library(tidytable)

my_dt <- tidytable(
  price = c(4.5, 4.6, 4.7, 4.8, 5.1),
  volume = c(0.4,1.2,0.3,8.7,6.5)
)

# 计算总成交量与目标修剪量
total_volume <- my_dt %>% summarize(total = sum(volume)) %>% pull(total)
trim_target <- total_volume * 0.25

post_trim <- my_dt %>%
  # 计算累计成交量（按price升序累计，匹配示例逻辑）
  mutate(cum_volume = cumsum(volume)) %>%
  # 标记完全属于修剪的行，同时计算拆分所需的成交量数值
  mutate(
    full_trim = cum_volume <= trim_target,
    trim_volume = ifelse(full_trim, volume, trim_target - lag(cum_volume, default = 0)),
    non_trim_volume = ifelse(full_trim, 0, volume - trim_volume)
  ) %>%
  # 对需要拆分的行进行复制（拆分为两行）
  uncount(case_when(
    full_trim ~ 1,
    trim_volume > 0 ~ 2,
    TRUE ~ 1
  )) %>%
  # 调整每行的volume值与trim标记
  mutate(
    volume = case_when(
      full_trim ~ volume,
      row_number() == which.max(cum_volume > trim_target) ~ trim_volume,
      TRUE ~ non_trim_volume
    ),
    trim = case_when(
      full_trim ~ TRUE,
      row_number() == which.max(cum_volume > trim_target) ~ TRUE,
      TRUE ~ FALSE
    )
  ) %>%
  # 保留目标列
  select(price, volume, trim)

# 输出结果
post_trim

代码逻辑说明 #

1. 累计成交量计算：通过cumsum计算每行的累计成交量，确定哪些行完全落在25%的修剪范围内，哪些行需要拆分。
2. 拆分数值计算：针对需要拆分的行，分别计算其修剪部分和非修剪部分的成交量。
3. 行拆分：使用uncount对需要拆分的行进行复制，生成两行数据。
4. 结果调整：为拆分后的行分配对应的成交量数值，并标记trim状态，最终得到目标结构的数据。

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