R - 用 dplyr 截断的最佳方式

R - optimal way to truncate with dplyr

我正在使用 R 和 ggplot 可视化变量分布。但大多数时候,由于某些极值,我必须截断变量以生成更好的可视化效果。例如:

library(tidyverse)

data.frame(x = c(runif(500, min = 0, max = 1), 1e3)) %>%
  ggplot() + geom_density(aes(x = x))

我使用基本函数 quantile()ifelse() 来截断并获得更好的可视化效果。但我觉得它不是最优的,函数 quantile() 被重复了,意味着它被计算了两次。现在有人有更好的方法吗? (不保存上一步中的分位数)

data.frame(x = c(runif(500, min = 0, max = 1), 1e3)) %>%
  mutate_at(vars(x), list(~ ifelse(. > quantile(., .99), quantile(., .99), .))) %>% 
  ggplot() + geom_density(aes(x = x))

data.frame(x = c(runif(500, min = 0, max = 1), 1e3)) %>%
  mutate_at(vars(x), list(~ pmin(., quantile(., .99)))) %>% 
  ggplot() + geom_density(aes(x = x))

pmin 执行矢量方式分钟,ala

x <- sample(10)
x
#  [1] 10  9  6  4  5  3  2  1  7  8
pmin(x, 5)
#  [1] 5 5 5 4 5 3 2 1 5 5

而且您只计算一次分位数。

仅供参考,mutate_at 已被 superseded 使用 across

data.frame(x = c(runif(500, min = 0, max = 1), 1e3)) %>%
  mutate(across(x, ~ pmin(., quantile(., .99)))) %>% 
  ggplot() + geom_density(aes(x = x))

请注意,list(~ quantile(., 0.99)) 方法仍受支持,但当 list 时,命名约定不同。比较:

set.seed(42)
x <- data.frame(x = c(runif(500, min = 0, max = 1), 1e3))
x %>%
  mutate(across(x, list(~ pmin(., quantile(., .99))))) %>%
  head(.)
#           x       x_1
# 1 0.9148060 0.9148060
# 2 0.9370754 0.9370754
# 3 0.2861395 0.2861395
# 4 0.8304476 0.8304476
# 5 0.6417455 0.6417455
# 6 0.5190959 0.5190959
x %>%
  mutate(across(x, ~ pmin(., quantile(., .99)))) %>%
  head(.)
#           x
# 1 0.9148060
# 2 0.9370754
# 3 0.2861395
# 4 0.8304476
# 5 0.6417455
# 6 0.5190959

(其中 list 方法生成一个名为 x_1 的新列,但 ggplot2 仍在查看未截断的 x)。

与我共事的统计学家总是提倡 Winsorizing 函数。其中极值被不太极值代替。

https://en.wikipedia.org/wiki/Winsorizing

https://www.rdocumentation.org/packages/DescTools/versions/0.99.39/topics/Winsorize

library(DescTools)
data.frame(x = c(runif(500, min = 0, max = 1), 1e3)) %>%
  mutate(x = DescTools::Winsorize(x, probs = c(0, 0.99))) %>% 
  ggplot() + geom_density(aes(x = x))

从 DescTools 中提取的轻量级用户定义函数的函数:

Winsorize <- function(x, minval = NULL, maxval = NULL,
                      probs=c(0.05, 0.95), na.rm = FALSE, type=7) {
    
  if(is.null(minval) || is.null(maxval)){
    xq <- quantile(x=x, probs=probs, na.rm=na.rm, type=type)
    if(is.null(minval)) minval <- xq[1L]
    if(is.null(maxval)) maxval <- xq[2L]
  }
 
  x[xmaxval] <- maxval
 
  return(x)
}

来源 - https://github.com/AndriSignorell/DescTools/blob/master/R/DescTools.r