geom_boxplot의 위스커 정의 변경

Question

위스커가 0.25 - 1.5 IQR/0.75 + IQR 대신 5 백 95 분위로 정의 된 박스 플롯을 생성하기 위해 ggplot2/geom_boxplot을 사용하려고합니다. 이러한 새로운 위스커의 아웃 라이어가 플롯됩니다. 평소처럼 geom_boxplot 미학에는 ymax/ymin이 포함되어 있습니다. 그러나 여기에 값을 입력하는 방법은 분명하지 않습니다.

stat_quantile(quantiles = c(0.05, 0.25, 0.5, 0.75, 0.95)) 

도울 수있을 것입니다,하지만 적절한 geom_boxplot을 설정하려면이 통계의 결과() 미학 관련하는 방법을 알고하지 않습니다 : 것 같다 내가했습니다

geom_boxplot(aes(ymin, lower, middle, upper, ymax)) 

을 사람들이 박스 플롯과 같은 객체를 수동으로 작성한다고 언급 한 다른 게시물을 보았습니다.하지만 오히려 전체 boxplot gestalt를 그대로 유지하면서 두 변수의 의미를 수정했습니다. stat_summary와

Answer 1

geom_boxplot 그것을 할 수 있습니다

# define the summary function 
f <- function(x) { 
    r <- quantile(x, probs = c(0.05, 0.25, 0.5, 0.75, 0.95)) 
    names(r) <- c("ymin", "lower", "middle", "upper", "ymax") 
    r 
} 

# sample data 
d <- data.frame(x=gl(2,50), y=rnorm(100)) 

# do it 
ggplot(d, aes(x, y)) + stat_summary(fun.data = f, geom="boxplot") 

# example with outliers 
# define outlier as you want  
o <- function(x) { 
    subset(x, x < quantile(x)[2] | quantile(x)[4] < x) 
} 

# do it 
ggplot(d, aes(x, y)) + 
    stat_summary(fun.data=f, geom="boxplot") + 
    stat_summary(fun.y = o, geom="point") 

Answer 2

ggplot2_2.1.0에 수염 엔드 포인트를 지정하는 것이 가능하다. ?geom_boxplot의 예제에서 복사 :

# It's possible to draw a boxplot with your own computations if you 
# use stat = "identity": 
y <- rnorm(100) 
df <- data.frame(
    x = 1, 
    y0 = min(y), 
    y25 = quantile(y, 0.25), 
    y50 = median(y), 
    y75 = quantile(y, 0.75), 
    y100 = max(y) 
) 
ggplot(df, aes(x)) + 
    geom_boxplot(
    aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100), 
    stat = "identity" 
) 

Answer 3

건물 @ konvas의 대답에, ggproto 시스템을 사용하여 자신 만의 통계를 정의 ggplot2.0.x, 당신이 할 수있는 extend ggplot부터.

ggplot2 stat_boxplot 코드를 복사하고 몇 가지 편집함으로써, 당신은 신속 인수 (qs) 대신 stat_boxplot 사용하는 coef 인수로 사용할 백분위 소요 새로운 스탯 (stat_boxplot_custom)를 정의 할 수 있습니다. 새로운 통계는 여기에 정의됩니다 :

# modified from https://github.com/tidyverse/ggplot2/blob/master/R/stat-boxplot.r 
library(ggplot2) 
stat_boxplot_custom <- function(mapping = NULL, data = NULL, 
        geom = "boxplot", position = "dodge", 
        ..., 
        qs = c(.05, .25, 0.5, 0.75, 0.95), 
        na.rm = FALSE, 
        show.legend = NA, 
        inherit.aes = TRUE) { 
    layer(
     data = data, 
     mapping = mapping, 
     stat = StatBoxplotCustom, 
     geom = geom, 
     position = position, 
     show.legend = show.legend, 
     inherit.aes = inherit.aes, 
     params = list(
     na.rm = na.rm, 
     qs = qs, 
     ... 
    ) 
) 
} 

그런 다음 레이어 기능이 정의됩니다. b/c I는 stat_boxplot에서 직접 복사 했으므로 :::을 사용하여 몇 가지 내부 ggplot2 함수에 액세스해야합니다. 여기에는 StatBoxplot에서 직접 복사 한 많은 내용이 포함되지만 핵심 영역은 qs 인수 (stats <- as.numeric(stats::quantile(data$y, qs))compute_group 함수 내부)에서 직접 통계를 계산하는 것입니다.

StatBoxplotCustom <- ggproto("StatBoxplotCustom", Stat, 
    required_aes = c("x", "y"), 
    non_missing_aes = "weight", 

    setup_params = function(data, params) { 
    params$width <- ggplot2:::"%||%"(
     params$width, (resolution(data$x) * 0.75) 
    ) 

    if (is.double(data$x) && !ggplot2:::has_groups(data) && any(data$x != data$x[1L])) { 
     warning(
     "Continuous x aesthetic -- did you forget aes(group=...)?", 
     call. = FALSE 
    ) 
    } 

    params 
    }, 

    compute_group = function(data, scales, width = NULL, na.rm = FALSE, qs = c(.05, .25, 0.5, 0.75, 0.95)) { 

    if (!is.null(data$weight)) { 
     mod <- quantreg::rq(y ~ 1, weights = weight, data = data, tau = qs) 
     stats <- as.numeric(stats::coef(mod)) 
    } else { 
    stats <- as.numeric(stats::quantile(data$y, qs)) 
    } 
    names(stats) <- c("ymin", "lower", "middle", "upper", "ymax") 
    iqr <- diff(stats[c(2, 4)]) 

    outliers <- (data$y < stats[1]) | (data$y > stats[5]) 

    if (length(unique(data$x)) > 1) 
    width <- diff(range(data$x)) * 0.9 

    df <- as.data.frame(as.list(stats)) 
    df$outliers <- list(data$y[outliers]) 

    if (is.null(data$weight)) { 
     n <- sum(!is.na(data$y)) 
    } else { 
     # Sum up weights for non-NA positions of y and weight 
     n <- sum(data$weight[!is.na(data$y) & !is.na(data$weight)]) 
    } 

    df$notchupper <- df$middle + 1.58 * iqr/sqrt(n) 
    df$notchlower <- df$middle - 1.58 * iqr/sqrt(n) 

    df$x <- if (is.factor(data$x)) data$x[1] else mean(range(data$x)) 
    df$width <- width 
    df$relvarwidth <- sqrt(n) 
    df 
    } 
) 

이 코드가 포함 된 gist here도 있습니다. 참으로 (! ​​감사) 수염을 변경 않는,

library(ggplot2) 
y <- rnorm(100) 
df <- data.frame(x = 1, y = y) 
# whiskers extend to 5/95th percentiles by default 
ggplot(df, aes(x = x, y = y)) + 
    stat_boxplot_custom() 
# or extend the whiskers to min/max 
ggplot(df, aes(x = x, y = y)) + 
    stat_boxplot_custom(qs = c(0, 0.25, 0.5, 0.75, 1))