获取数据框列中最接近的百分位数

Question

我有一个大型数据集，我使用 dplyr 的 percent_rank() function 根据回报日期对我的股票回报进行排名。 我的问题是我想在百分位水平上创建断点并且没有完全四舍五入的百分比。

更具体地说，我正在寻找最接近每 10 个百分位数 (.1) 的数字，这里是我数据集的一些值的提取：

sample_data[21:27,]
# A tibble: 7 x 4
  PERMNO Date           Ret Pct_Rank
   <dbl> <date>       <dbl>    <dbl>
1  10065 1969-07-31 -0.142     0.360
2  10065 1969-08-29  0.126     0.331
3  10092 2002-01-31 -0.0569    0.919
4  10092 2002-02-28 -0.134     0.907
5  10092 2002-03-28  0.218     0.893
6  10092 2002-04-30 -0.137     0.701
7  10092 2002-05-31  0.0477    0.461

我尝试做一个 for 循环来提取到十分位数的距离最小的行，然后替换它们。 当我想在包含数百万个观察值的原始数据集上使用它时，它似乎有效，但效率极低。

store_vec <- c()
for(i in seq(0.1, 1, 0.1)){
vec <- which.min(abs(sample_data$Pct_Rank - i))
store_vec <- c(store_vec, vec)
}

sample_data$Pct_Rank[store_vec] <- round(sample_data$Pct_Rank[store_vec], digits = 1)

• 预期结果：

sample_data[21:27,]
# A tibble: 7 x 4
  PERMNO Date           Ret Pct_Rank
   <dbl> <date>       <dbl>    <dbl>
1  10065 1969-07-31 -0.142     0.360
2  10065 1969-08-29  0.126     0.3  
3  10092 2002-01-31 -0.0569    0.919
4  10092 2002-02-28 -0.134     0.9  
5  10092 2002-03-28  0.218     0.893
6  10092 2002-04-30 -0.137     0.7  
7  10092 2002-05-31  0.0477    0.461

我最大的问题是我有一个庞大的数据集，查看多个时间段并且需要遍历每个月和库存，所以我的解决方案不可行大规模。

• 您对如何避免使用循环但获得相同结果有任何建议吗？

PS我不是高级程序员，如果我错过了一些细节，请原谅

用于复制的示例数据：

structure(list(PERMNO = c(10057, 10057, 10057, 10057, 10057, 
10057, 10057, 10057, 10057, 10057, 10057, 10065, 10065, 10065, 
10065, 10065, 10065, 10065, 10065, 10065, 10065, 10065, 10092, 
10092, 10092, 10092, 10092, 10092, 10092, 10092, 10092, 10092, 
10092), Date = structure(c(-3107, -3076, -3045, -3016, -2984, 
-2954, -2925, -2892, -2864, -2834, -2803, -427, -398, -366, -335, 
-307, -279, -246, -217, -185, -154, -125, 11718, 11746, 11774, 
11807, 11838, 11866, 11899, 11929, 11960, 11991, 12020), class = "Date"), 
    Ret = c(-0.018018018018018, 0.0229357798165138, -0.031390134529148, 
    -0.0972222222222222, 0.0615384615384615, 0.0386473429951691, 
    -0.0418604651162791, 0.087378640776699, 0.0491071428571429, 
    -0.0297872340425532, -0.0350877192982456, 0.125827814569536, 
    -0.0470588235294118, -0.0123456790123457, -0.04375, -0.0261437908496732, 
    -0.00671140939597315, 0.0135135135135135, -0.0333333333333333, 
    -0.172413793103448, -0.141666666666667, 0.12621359223301, 
    -0.0569146280579132, -0.134462678665961, 0.218348623853211, 
    -0.136546184738956, 0.0476744186046512, 0.148723640399556, 
    -0.0338164251207729, -0.0175000000000001, 0.20763358778626, 
    0.139907290349768, -0.11275415896488), Pct_Rank = c(0.386976744186044, 
    0.641597028783667, 0.713888888888882, 0.581330868761558, 
    0.435185185185187, 0.468952734012974, 0.414814814814816, 
    0.251154201292705, 0.356682027649771, 0.707834101382496, 
    0.602764976958531, 0.042535446205171, 0.0611902766135791, 
    0.0501672240802675, 0.0499999999999999, 0.030176026823135, 
    0.0309106098579783, 0.625104602510468, 0.741854636591494, 
    0.620517097581307, 0.359700249791842, 0.331136738056014, 
    0.919063270336911, 0.906880922950194, 0.892695006190697, 
    0.700745033112567, 0.460613598673312, 0.342963268675197, 
    0.23797780517879, 0.22267871815941, 0.426337448559662, 0.789279869067127, 
    0.935483870967767)), row.names = c(NA, -33L), groups = structure(list(
    date = structure(c(-3107, -3076, -3045, -3016, -2984, -2954, 
    -2925, -2892, -2864, -2834, -2803, -427, -398, -366, -335, 
    -307, -279, -246, -217, -185, -154, -125, 11718, 11746, 11774, 
    11807, 11838, 11866, 11899, 11929, 11960, 11991, 12020), class = "Date"), 
    .rows = list(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
        12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 
        23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L)), row.names = c(NA, 
-33L), class = c("tbl_df", "tbl", "data.frame"), .drop = TRUE), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"))

Answer 1

我想你正在寻找这个。 使用quantile生成十分位数，然后within数据中通过使用which.min差异最小的那些十分位数值创建"Pct_Rank"列。 在其他列中计算abs差异并使用ave对每个分位数组进行rank 。 仅替换rank == 1的那些值。

qrd <- quantile(sample_data$Pct_Rank, 0:10*.1)

sample_data <- within(sample_data, {
  Pct_dec <- sapply(Pct_Rank, function(x) qrd[which.min(abs(qrd - x))])
  Pct_diff <- abs(Pct_rank - Pct_dec)
  Pct_rank <- ave(Pct_Rank, Pct_dec, FUN=rank)
  Pct_Rank.copy <- Pct_dec 
  Pct_Rank.copy[Pct_rank == 1] <- Pct_dec[Pct_rank == 1] 
  # rm(Pct_dec, Pct_diff, Pct_rank)  ## uncomment/edit this line to remove unwanted columns
})

sample_data[1:10, ]
#    PERMNO       Date         Ret  Pct_Rank Pct_dec Pct_Rank.copy Pct_rank Pct_diff
# 1   10057 1961-06-30 -0.01801802 0.3869767    0.38          0.38        1     0.62
# 2   10057 1961-07-31  0.02293578 0.6415970    0.63          0.63        3     2.37
# 3   10057 1961-08-31 -0.03139013 0.7138889    0.71          0.71        3     2.29
# 4   10057 1961-09-29 -0.09722222 0.5813309    0.59          0.59        1     0.41
# 5   10057 1961-10-31  0.06153846 0.4351852    0.44          0.44        3     2.56
# 6   10057 1961-11-30  0.03864734 0.4689527    0.44          0.44        5     4.56
# 7   10057 1961-12-29 -0.04186047 0.4148148    0.44          0.44        1     0.56
# 8   10057 1962-01-31  0.08737864 0.2511542    0.23          0.23        3     2.77
# 9   10057 1962-02-28  0.04910714 0.3566820    0.34          0.34        3     2.66
# 10  10057 1962-03-30 -0.02978723 0.7078341    0.71          0.71        2     1.29