ggplot2 바이너리 데이터의 binned x 축이있는 geom_point

Question

바이너리 데이터의 binned x-axis로 scatterplot을 생성하려고합니다. 이진 y와 함께 geom_point을 사용할 때, 플롯은 꽤 쓸모가 없습니다 (그림 1 참조). 그림 2에서 볼 수 있듯이 x 축의 값을 기준으로 데이터를 비우고 geom_point을 사용하여 각 bin 내의 avg x 및 avg y를 그립니다 (각 bin의 obs 수를 포인트). 데이터를 집계하여이 작업을 수행 할 수 있지만 ggplot이 직접 수행 할 수 있는지 궁금합니다. 나는 stat_bindot 등으로 놀았지만 해결책을 찾지 못했습니다. 어떤 아이디어? 아래는 몇 가지 코드입니다.

감사합니다.

# simulate data 
n=1000 
y=rbinom(n,1,0.5) 
x=runif(n) 
data=data.frame(x,y) 

# figure 1 - geom_point with binary data, pretty useless! 
ggplot(data,aes(x=x,y=y)) + geom_point() + ylim(0,1) 

# let's create an aggregated dataset with bins 
bin=cut(data$x,seq(0,1,0.05)) 
# I am sure the aggregation can be done in a better way... 
data.bin=aggregate(data,list(bin),function(x) { return(c(mean(x),length(x)))}) 

# figure 2 - geom_point with binned x-axis, much nicer! 
ggplot(data.bin,aes(x=x[,1],y=y[,1],size=x[,2])) + geom_point() + ylim(0,1) 

도 1 및 2 :

Answer 1

@Kohske가 수행하는 직접적인 방법은 없다 말했듯이 ggplot2 단계; 미리 데이터를 요약하고이를 ggplot으로 전달해야합니다. 귀하의 접근 방식은 작동하지만, 다소 다른 방식으로 수행했을 것입니다. aggregate 대신 plyr 패키지를 사용하십시오.

library("plyr") 
data$bin <- cut(data$x,seq(0,1,0.05)) 
data.bin <- ddply(data, "bin", function(DF) { 
    data.frame(mean=numcolwise(mean)(DF), length=numcolwise(length)(DF)) 
}) 
ggplot(data.bin,aes(x=mean.x,y=mean.y,size=length.x)) + geom_point() + 
    ylim(0,1) 

장점

은, 내 의견으로는, 당신은 더 나은 이름을 가진 간단한 데이터 프레임이 방법보다는 약간의 열이 행렬이다 데이터 프레임을 얻을 수 있다는 것입니다. 그러나 그것은 아마도 정확성보다는 개인적인 스타일의 문제 일 것입니다.

Answer 2

이 목적을 위해 새 Stat 함수를 작성했습니다.

모두 4 개의 기본값으로 nbins, bin_var, bin_fun 및 summary_fun이 인수로 사용됩니다.

• 기본값은 nbins은 데이터 요소의 수에 따라 다릅니다.
• bin_var의 기본값은 "x"입니다. 또한 "y"로 설정할 수 있습니다. 이 변수는 bin_fun에 공급되는 변수를 지정합니다.
• bin_fun은 비닝 함수입니다. 기본적으로, 그것은 목적을 위해 쓴 seq_cut입니다. 직접 비닝 기능을 작성할 수도 있습니다. 데이터와 nbins를 인수로 가져와야합니다.
• summary_fun은 저장소를 집계하는 데 사용되는 요약 함수입니다. 기본적으로 mean입니다. fun.x 및 fun.y을 사용하여 x 및 y에 대한 집계 함수를 개별적으로 지정할 수도 있습니다.
• ymin 및 ymax을 미학으로 사용하는 기하학을 사용하는 경우 fun.ymin 및 fun.ymax을 지정할 수도 있습니다.

aes (group = your_bins)를 지정하면 bin_fun이 무시되고 그룹화 변수가 대신 사용됩니다. ..count..으로 액세스 할 수있는 카운트 변수를 생성합니다.귀하의 경우에는

, 당신은 다음과 같이 사용 :

p <- ggplot(data, aes(x, y)) + 
    geom_point(aes(size = ..count..), stat = "binner") + 
    ylim(0, 1) 

하지 매우 유용합니다 (이 경우이 homoskedasticity을 설명하고, 분산이 베른의 가정 (0.5 약 0.25 걸맞게 등을 있음) variates 있지만) 그러나 단지 예 :

p + geom_linerange(stat = "binner", 
        fun.ymin = function(y) mean(y) - var(y)/2, 
        fun.ymax = function(y) mean(y) + var(y)/2) 

코드 :

library(proto) 

stat_binner <- function (mapping = NULL, data = NULL, geom = "point", position = "identity", ...) { 
    StatBinner$new(mapping = mapping, data = data, geom = geom, position = position, ...) 
} 

StatBinner <- proto(ggplot2:::Stat, { 
    objname <- "binner" 

    default_geom <- function(.) GeomPoint 
    required_aes <- c("x", "y") 

    calculate_groups <- function(., data, scales, bin_var = "x", nbins = NULL, bin_fun = seq_cut, summary_fun = mean, 
         fun.data = NULL, fun.y = NULL, fun.ymax = NULL, fun.ymin = NULL, 
         fun.x = NULL, fun.xmax = NULL, fun.xmin = NULL, na.rm = FALSE, ...) { 
    data <- remove_missing(data, na.rm, c("x", "y"), name = "stat_binner") 

    # Same rules as binnedplot in arm package 
    n <- nrow(data) 
    if (is.null(nbins)) { 
     nbins <- if (n >= 100) floor(sqrt(n)) 
       else if (n > 10 & n < 100) 10 
       else floor(n/2) 
    } 

    if (length(unique(data$group)) == 1) { 
     data$group <- bin_fun(data[[bin_var]], nbins) 
    } 

    if (!missing(fun.data)) { 
     # User supplied function that takes complete data frame as input 
     fun.data <- match.fun(fun.data) 
     fun <- function(df, ...) { 
     fun.data(df$y, ...) 
     } 
    } else { 
     if (!is.null(summary_fun)) { 
     if (!is.null(fun.x)) message("fun.x overriden by summary_fun") 
     if (!is.null(fun.y)) message("fun.y overriden by summary_fun") 
     fun.x <- fun.y <- summary_fun 
     } 

     # User supplied individual vector functions 
     fs_x <- compact(list(xmin = fun.x, x = fun.x, xmax = fun.xmax)) 
     fs_y <- compact(list(ymin = fun.ymin, y = fun.y, ymax = fun.ymax)) 

     fun <- function(df, ...) { 
     res_x <- llply(fs_x, function(f) do.call(f, list(df$x, ...))) 
     res_y <- llply(fs_y, function(f) do.call(f, list(df$y, ...))) 
     names(res_y) <- names(fs_y) 
     names(res_x) <- names(fs_x) 
     as.data.frame(c(res_y, res_x)) 
     } 
    } 
    summarise_by_x_and_y(data, fun, ...) 
    } 


}) 

summarise_by_x_and_y <- function(data, summary, ...) { 
    summary <- ddply(data, "group", summary, ...) 
    count <- ddply(data, "group", summarize, count = length(y)) 

    unique <- ddply(data, "group", ggplot2:::uniquecols) 
    unique$y <- NULL 
    unique$x <- NULL 

    res <- merge(merge(summary, unique, by = "group"), count, by = "group") 

    # Necessary for, eg, colour aesthetics 
    other_cols <- setdiff(names(data), c(names(summary), names(unique))) 
    if (length(other_cols) > 0) { 
    other <- ddply(data[, c(other_cols, "group")], "group", numcolwise(mean)) 
    res <- merge(res, other, by = "group") 
    } 

    res 
} 


seq_cut <- function(x, nbins) { 
    bins <- seq(min(x), max(x), length.out = nbins) 
    findInterval(x, bins, rightmost.closed = TRUE) 
}