ggplot2帶有binned x軸的二進制數據的geom_point

Question

我正在嘗試爲二進制數據創建一個帶有binned x軸的scatterplot。當我用二進制y使用geom_point時，這個圖很沒用（見圖1）。如圖2所示，我想根據x軸的值對數據進行分類，然後使用geom_point（每個bin中的obs數量映射到每個bin的大小）繪製每個bin內的avg x和avg y點）。我可以通過聚合數據來做到這一點，但我想知道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。你的方法是有效的，但我會用略微不同的方式，使用plyr包而不是aggregate。

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作爲參數，默認爲全部四個。

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

不是很有用（儘管這表明同方差和方差約爲0.25作爲應景伯爾尼的假設（0.5）個變量）：

在你的情況，你可以使用它像這樣但僅僅是爲了例如：

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