2

バイナリデータのビニングされたx軸を使用して散布図を作成しようとしています。バイナリyで使用する場合geom_point、プロットはかなり役に立ちません（図1を参照）。図2に示すように、x軸の値に基づいてデータをビンに入れ、次にgeom_point（各ビンのobsの数をポイントのサイズにマッピングする）を使用して各ビン内の平均xと平均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：

4

2 に答える 2

5

この目的のために、新しいStat関数を作成しました。

、、を引数として取りnbins、デフォルトは4つすべてです。bin_varbin_funsummary_fun

  • のデフォルトはnbins、データポイントの数によって異なります。
  • のデフォルトbin_varは「x」です。「y」に設定することもできます。これは、に供給される変数を指定しますbin_fun。
  • bin_funビニング関数です。デフォルトでは、それseq_cutは私が目的のために書いたものです。独自のビニング関数を作成することもできます。データとnbinを引数として取る必要があります。
  • summary_funビンを集約するために使用される要約関数です。デフォルトでは、ですmean。xとyの集計関数をとで個別に指定することもできfun.xますfun.y。
  • 美学としてyminとをとるgeomを使用する場合は、とを指定することもできます。ymaxfun.yminfun.ymax

aes（group = your_bins）を指定した場合、bin_funは無視され、代わりにグループ化変数が使用されることに注意してください。また、としてアクセスできるカウント変数が作成されることにも注意してください..count..。

あなたの場合、あなたはそれを次のように使用します：

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

この場合はあまり有用ではありませんが（これは等分散性を示しており、Bern（0.5）変量の仮定にふさわしい分散は約0.25ですが）、例としてだけです。

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

geom_pointおよびgeom_linerangeとstat_binner

コード：

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)
}
于 2014-07-28T12:17:33.407 に答える
3

ggplot2@Kohskeが言ったように、 ;でそれを行う直接的な方法はありません。データを事前に要約して、に渡す必要があり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)

ここに画像の説明を入力してください

私の意見では、いくつかの列が行列であるデータフレームではなく、この方法でより適切な名前の単純なデータフレームを取得できるという利点があります。しかし、それはおそらく正確さよりも個人的なスタイルの問題です。

于 2012-04-09T19:26:02.633 に答える