R：创建一个函数来识别任意百分位数

我正在使用 R 编程语言。

我有以下数据集：

library(dplyr)

var1 = rnorm(10000, 100,100)
var2 = rnorm(10000, 100,100)
var3 = rnorm(10000, 100,100)
var4 = rnorm(10000, 100,100)
id = 1:10000

final = data.frame(id, var1, var2, var3, var4)

假设我想根据另一个变量（例如 var3）的十分位值创建一个新变量。我可以使用以下代码来执行此操作：

final_without_function = final %>%
  mutate(class3 = case_when(ntile(var3, 10) == 1 ~ paste0(round(min(var3), 2), " to ", round(quantile(var3, 0.1), 2), " decile 1"),
                            ntile(var3, 10) == 2 ~ paste0(round(quantile(var3, 0.1), 2), " to ", round(quantile(var3, 0.2), 2), " decile 2"),
                            ntile(var3, 10) == 3 ~ paste0(round(quantile(var3, 0.2), 2), " to ", round(quantile(var3, 0.3), 2), " decile 3"),
                            ntile(var3, 10) == 4 ~ paste0(round(quantile(var3, 0.3), 2), " to ", round(quantile(var3, 0.4), 2), " decile 4"),
                            ntile(var3, 10) == 5 ~ paste0(round(quantile(var3, 0.4), 2), " to ", round(quantile(var3, 0.5), 2), " decile 5"),
                            ntile(var3, 10) == 6 ~ paste0(round(quantile(var3, 0.5), 2), " to ", round(quantile(var3, 0.6), 2), " decile 6"),
                            ntile(var3, 10) == 7 ~ paste0(round(quantile(var3, 0.6), 2), " to ", round(quantile(var3, 0.7), 2), " decile 7"),
                            ntile(var3, 10) == 8 ~ paste0(round(quantile(var3, 0.7), 2), " to ", round(quantile(var3, 0.8), 2), " decile 8"),
                            ntile(var3, 10) == 9 ~ paste0(round(quantile(var3, 0.8), 2), " to ", round(quantile(var3, 0.9), 2), " decile 9"),
                            ntile(var3, 10) == 10 ~ paste0(round(quantile(var3, 0.9), 2), " to ", round(max(var3), 2), " decile 10")))

假设现在我不想按“10”组进行操作，而是想按“5”组进行操作 - 我需要手动更改上述代码。我正在寻找一种更方便的方法来做到这一点。

我尝试编写这个函数来执行此操作：

percentile_classifier <- function(x, n_percentiles) {
  # Calculate the percentiles
  percentiles <- quantile(x, probs = seq(0, 1, 1/n_percentiles))

  # Create a character vector to store the labels
  labels <- character(length(x))

  # Loop through each percentile and assign the corresponding label to each element in the vector
  for (i in 1:length(percentiles)) {
    lower <- percentiles[i]
    upper <- ifelse(i == length(percentiles), max(x), percentiles[i+1])
    label <- paste0(round(lower, 2), " to ", round(upper, 2), " percentile ", i)
    labels[x >= lower & x < upper] <- label
  }

  # Return the labels
  return(labels)
}

但是当我尝试调用这个函数时：

final <- final %>% mutate(class3 = percentile_classifier(var3, 20))

我不确定我是否正确地做到了这一点。

有人可以告诉我我这样做是否正确吗？

Thanks!

Note:我所说的根据“分组”数据计算的百分位数是什么意思：

final = final %>% group_by (factor_var_5,factor_var_6, factor_var_7) %>%
  mutate(class3 = case_when(ntile(var3, 10) == 1 ~ paste0(round(min(var3), 2), " to ", round(quantile(var3, 0.1), 2), " decile 1"),
                            ntile(var3, 10) == 2 ~ paste0(round(quantile(var3, 0.1), 2), " to ", round(quantile(var3, 0.2), 2), " decile 2"),
                            ntile(var3, 10) == 3 ~ paste0(round(quantile(var3, 0.2), 2), " to ", round(quantile(var3, 0.3), 2), " decile 3"),
                            ntile(var3, 10) == 4 ~ paste0(round(quantile(var3, 0.3), 2), " to ", round(quantile(var3, 0.4), 2), " decile 4"),
                            ntile(var3, 10) == 5 ~ paste0(round(quantile(var3, 0.4), 2), " to ", round(quantile(var3, 0.5), 2), " decile 5"),
                            ntile(var3, 10) == 6 ~ paste0(round(quantile(var3, 0.5), 2), " to ", round(quantile(var3, 0.6), 2), " decile 6"),
                            ntile(var3, 10) == 7 ~ paste0(round(quantile(var3, 0.6), 2), " to ", round(quantile(var3, 0.7), 2), " decile 7"),
                            ntile(var3, 10) == 8 ~ paste0(round(quantile(var3, 0.7), 2), " to ", round(quantile(var3, 0.8), 2), " decile 8"),
                            ntile(var3, 10) == 9 ~ paste0(round(quantile(var3, 0.8), 2), " to ", round(quantile(var3, 0.9), 2), " decile 9"),
                            ntile(var3, 10) == 10 ~ paste0(round(quantile(var3, 0.9), 2), " to ", round(max(var3), 2), " decile 10")))

您的代码非常接近，但不太正确。如果我们在一个很好的小示例而不是 10,000 行数据帧上运行它，这一点就很清楚了：

set.seed(42)
n = 15
var1 = rnorm(n, 100,100)
id = 1:n

final = data.frame(id, var1)

# final %>% mutate(result = percentile_classifier(var1, 5))
#    id      var1                        result
# 1   1 237.09584 149.57 to 239.91 percentile 4
# 2   2  43.53018  -38.89 to 83.76 percentile 1
# 3   3 136.31284  92.45 to 149.57 percentile 3
# 4   4 163.28626 149.57 to 239.91 percentile 4
# 5   5 140.42683  92.45 to 149.57 percentile 3
# 6   6  89.38755   83.76 to 92.45 percentile 2
# 7   7 251.15220 239.91 to 328.66 percentile 5
# 8   8  90.53410   83.76 to 92.45 percentile 2
# 9   9 301.84237 239.91 to 328.66 percentile 5
# 10 10  93.72859  92.45 to 149.57 percentile 3
# 11 11 230.48697 149.57 to 239.91 percentile 4
# 12 12 328.66454                               ## Problem - the max isn't labeled
# 13 13 -38.88607  -38.89 to 83.76 percentile 1
# 14 14  72.12112  -38.89 to 83.76 percentile 1
# 15 15  86.66787   83.76 to 92.45 percentile 2

我们可以看到最大值没有得到标签。知道了问题所在，就很容易找到这个bug了。您的函数分配标签labels[x >= lower & x < upper] <- label，但当然最大值永远不会是严格小于本身就是最高的upper价值。您可以通过将其视为特殊情况来修复该错误。

相反，让我们依赖基本函数cut这是 R 的内置方式来对这样的值进行分箱。 （参见?cut帮助页面或 Stack Overflow 常见问题解答如何对数值进行分箱 https://stackoverflow.com/q/5570293/903061更多细节。）

cut有一个内置参数决定是否包含端点。它还默认为排除最低点并包括最高点的间隔，但这可以通过参数进行自定义right如果你想改变它。

ptile <- function(x, n_percentiles) {
  # Calculate the percentiles
  pct <- quantile(x, probs = seq(0, 1, 1/n_percentiles))

  # Create a character vector to store the labels
  labels <- sprintf("%.2f to %.2f percentile %d",
                    head(pct, -1), tail(pct, -1), seq_len(n_percentiles))

  cut(x, breaks = pct, labels = labels, include.lowest = TRUE)
}

final %>% mutate(result = ptile(var1, 5))
#    id      var1                        result
# 1   1 237.09584 149.57 to 239.91 percentile 4
# 2   2  43.53018  -38.89 to 83.76 percentile 1
# 3   3 136.31284  92.45 to 149.57 percentile 3
# 4   4 163.28626 149.57 to 239.91 percentile 4
# 5   5 140.42683  92.45 to 149.57 percentile 3
# 6   6  89.38755   83.76 to 92.45 percentile 2
# 7   7 251.15220 239.91 to 328.66 percentile 5
# 8   8  90.53410   83.76 to 92.45 percentile 2
# 9   9 301.84237 239.91 to 328.66 percentile 5
# 10 10  93.72859  92.45 to 149.57 percentile 3
# 11 11 230.48697 149.57 to 239.91 percentile 4
# 12 12 328.66454 239.91 to 328.66 percentile 5
# 13 13 -38.88607  -38.89 to 83.76 percentile 1
# 14 14  72.12112  -38.89 to 83.76 percentile 1
# 15 15  86.66787   83.76 to 92.45 percentile 2