ggplot2バイナリデータのbinned x軸を持つgeom_point

Question

バイナリデータのbinned x軸を持つscatterplotを作成しようとしています。 geom_pointをバイナリyで使用すると、プロットはかなり役に立たなくなります（図1参照）。図2に示すように、私はx軸の値に基づいてデータをビンし、次に各ビン内のavg xとavg yをgeom_point（各ビン内の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関数を書いた。

引数としてすべてnbins,bin_var,bin_funおよびsummary_funが必要で、すべての4つでデフォルトです。

• デフォルトのnbinsは、データポイントの数によって異なります。
• bin_varのデフォルトは "x"です。また、「y」に設定することもできます。これは、bin_funに供給される変数を指定します。
• bin_funはビニング関数です。デフォルトでは、目的のために書いたのはseq_cutです。独自のビニング機能を記述することもできます。データとnbinを引数として取るだけです。
• summary_funは、ビンを集約するために使用されるサマリー関数です。デフォルトではmeanです。 xとyの集約関数をfun.xとfun.yで個別に指定することもできます。
• yminとymaxを美学として使用するgeomを使用する場合は、fun.yminとfun.ymaxを指定することもできます。

aes（group = your_bins）を指定すると、bin_funは無視され、代わりにグループ化変数が使用されます。また、..count..としてアクセスできるカウント変数を作成することにも注意してください。（これはhomoskedasticityを示し、分散は約0.25ふさわしくとしてベルン（0.5の前提であるが）変量）

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

ないこの場合に非常に有用：あなたのケースでは

、あなたはこのようにそれを使用しますちょうど例えば：

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) 
}