GGPLOT có thể tạo bản tóm tắt dữ liệu 2D không?

Question

Tôi muốn vẽ giá trị trung bình (hoặc hàm khác) của thời gian phản ứng như một hàm của vị trí của đích trong mặt phẳng x y. Như dữ liệu thử nghiệm:

library(ggplot2) 
xs <- runif(100,-1,1) 
ys <- runif(100,-1,1) 
rts <- rnorm(100) 
testDF <- data.frame("x"=xs,"y"=ys,"rt"=rts) 

Tôi biết tôi có thể làm điều này:

p <- ggplot(data = testDF,aes(x=x,y=y))+geom_bin2d(bins=10) 

Những gì tôi muốn để có thể làm, là điều tương tự nhưng vẽ một chức năng của dữ liệu trong mỗi bin thay vì đếm. Tôi có thể làm được không?

Hoặc tôi có cần phải tạo phương tiện có điều kiện trước tiên trong R (ví dụ: drt <- tapply(testDF$rt,list(cut(testDF$x,10),cut(testDF$y,10)),mean)) và sau đó vẽ đồ thị đó?

Cảm ơn bạn.

Answer 1

Điều này hóa ra khó hơn tôi tưởng.

Bạn có thể gần lừa ggplot vào làm điều này, bằng cách cung cấp một thẩm mỹ weights, nhưng điều đó chỉ mang lại cho bạn tổng trọng lượng trong thùng rác, không phải giá trị trung bình (và bạn phải chỉ rõ drop=FALSE để giữ lại giá trị bin tiêu cực). Bạn cũng có thể truy lục số lượng hoặc mật độ trong một thùng, nhưng cả hai đều không giải quyết được vấn đề.

Đây là những gì tôi đã kết thúc với:

## breaks vector (slightly coarser than the 10x10 spec above; 
## even 64 bins is a lot for binning only 100 points) 
bvec <- seq(-1,1,by=0.25) 

## helper function 
tmpf <- function(x,y,z,FUN=mean,breaks) { 
    midfun <- function(x) (head(x,-1)+tail(x,-1))/2 
    mids <- list(x=midfun(breaks$x),y=midfun(breaks$y)) 
    tt <- tapply(z,list(cut(x,breaks$x),cut(y,breaks$y)),FUN) 
    mt <- melt(tt) 
    ## factor order gets scrambled (argh), reset it 
    mt$X1 <- factor(mt$X1,levels=rownames(tt)) 
    mt$X2 <- factor(mt$X2,levels=colnames(tt)) 
    transform(X, 
      x=mids$x[mt$X1], 
      y=mids$y[mt$X2]) 
} 

ggplot(data=with(testDF,tmpf(x,y,rt,breaks=list(x=bvec,y=bvec))), 
     aes(x=x,y=y,fill=value))+ 
    geom_tile()+ 
    scale_x_continuous(expand=c(0,0))+ ## expand to fill plot region 
    scale_y_continuous(expand=c(0,0)) 

này giả định độ rộng bin bình đẳng, vv có thể được mở rộng ... nó thực sự là quá xấu đó (như xa như tôi có thể nói) stat_bin2d doesn' t chấp nhận một hàm do người dùng chỉ định.

Answer 2

Cập nhật Với việc phát hành ggplot2 0.9.0, nhiều chức năng này được bao gồm trong các bổ sung mới stat_summary2d và stat_summary_bin.

đây là một ý chính cho câu trả lời này: https://gist.github.com/1341218

đây là một sửa đổi nhỏ của stat_bin2d để chấp nhận chức năng tùy ý:

StatAggr2d <- proto(Stat, { 
    objname <- "aggr2d" 
    default_aes <- function(.) aes(fill = ..value..) 
    required_aes <- c("x", "y", "z") 
    default_geom <- function(.) GeomRect 

    calculate <- function(., data, scales, binwidth = NULL, bins = 30, breaks = NULL, origin = NULL, drop = TRUE, fun = mean, ...) { 

    range <- list(
     x = scales$x$output_set(), 
     y = scales$y$output_set() 
    ) 

    # Determine binwidth, if omitted 
    if (is.null(binwidth)) { 
     binwidth <- c(NA, NA) 
     if (is.integer(data$x)) { 
     binwidth[1] <- 1 
     } else { 
     binwidth[1] <- diff(range$x)/bins 
     } 
     if (is.integer(data$y)) { 
     binwidth[2] <- 1 
     } else { 
     binwidth[2] <- diff(range$y)/bins 
     }  
    } 
    stopifnot(is.numeric(binwidth)) 
    stopifnot(length(binwidth) == 2) 

    # Determine breaks, if omitted 
    if (is.null(breaks)) { 
     if (is.null(origin)) { 
     breaks <- list(
      fullseq(range$x, binwidth[1]), 
      fullseq(range$y, binwidth[2]) 
     ) 
     } else { 
     breaks <- list(
      seq(origin[1], max(range$x) + binwidth[1], binwidth[1]), 
      seq(origin[2], max(range$y) + binwidth[2], binwidth[2]) 
     ) 
     } 
    } 
    stopifnot(is.list(breaks)) 
    stopifnot(length(breaks) == 2) 
    stopifnot(all(sapply(breaks, is.numeric))) 
    names(breaks) <- c("x", "y") 

    xbin <- cut(data$x, sort(breaks$x), include.lowest=TRUE) 
    ybin <- cut(data$y, sort(breaks$y), include.lowest=TRUE) 

    if (is.null(data$weight)) data$weight <- 1 
    ans <- ddply(data.frame(data, xbin, ybin), .(xbin, ybin), function(d) data.frame(value = fun(d$z))) 

    within(ans,{ 
     xint <- as.numeric(xbin) 
     xmin <- breaks$x[xint] 
     xmax <- breaks$x[xint + 1] 

     yint <- as.numeric(ybin) 
     ymin <- breaks$y[yint] 
     ymax <- breaks$y[yint + 1] 
    }) 
    } 
}) 

stat_aggr2d <- StatAggr2d$build_accessor() 

và cách dùng:

ggplot(data = testDF,aes(x=x,y=y, z=rts))+stat_aggr2d(bins=3) 
ggplot(data = testDF,aes(x=x,y=y, z=rts))+ 
    stat_aggr2d(bins=3, fun = function(x) sum(x^2)) 

Đồng thời, đây là xe trượt tuyết t sửa đổi stat_binhex:

StatAggrhex <- proto(Stat, { 
    objname <- "aggrhex" 

    default_aes <- function(.) aes(fill = ..value..) 
    required_aes <- c("x", "y", "z") 
    default_geom <- function(.) GeomHex 

    calculate <- function(., data, scales, binwidth = NULL, bins = 30, na.rm = FALSE, fun = mean, ...) { 
    try_require("hexbin") 
    data <- remove_missing(data, na.rm, c("x", "y"), name="stat_hexbin") 

    if (is.null(binwidth)) { 
     binwidth <- c( 
     diff(scales$x$input_set())/bins, 
     diff(scales$y$input_set())/bins 
    ) 
    } 

    try_require("hexbin") 

    x <- data$x 
    y <- data$y 

    # Convert binwidths into bounds + nbins 
    xbnds <- c(
     round_any(min(x), binwidth[1], floor) - 1e-6, 
     round_any(max(x), binwidth[1], ceiling) + 1e-6 
    ) 
    xbins <- diff(xbnds)/binwidth[1] 

    ybnds <- c(
     round_any(min(y), binwidth[1], floor) - 1e-6, 
     round_any(max(y), binwidth[2], ceiling) + 1e-6 
    ) 
    ybins <- diff(ybnds)/binwidth[2] 

    # Call hexbin 
    hb <- hexbin(
     x, xbnds = xbnds, xbins = xbins, 
     y, ybnds = ybnds, shape = ybins/xbins, 
     IDs = TRUE 
    ) 
    value <- tapply(data$z, hb@cID, fun) 

    # Convert to data frame 
    data.frame(hcell2xy(hb), value) 
    } 


}) 

stat_aggrhex <- StatAggrhex$build_accessor() 

và cách dùng:

ggplot(data = testDF,aes(x=x,y=y, z=rts))+stat_aggrhex(bins=3) 
ggplot(data = testDF,aes(x=x,y=y, z=rts))+ 
    stat_aggrhex(bins=3, fun = function(x) sum(x^2))