Сложенная гистограмма из уже суммированных подсчетов с использованием ggplot2

Question

Мне нужна помощь в раскраске гигаграммы ggplot2, сгенерированной из уже суммированных данных подсчета.

Данные являются чем-то вроде подсчета # самцов и # самок, живущих в нескольких разных областях. Это достаточно легко построить гистограмму для общего счета (то есть мужчины + женщины):

set.seed(1) 
N=100; 
X=data.frame(C1=rnbinom(N,15,0.1), C2=rnbinom(N,15,0.1),C=rep(0,N)); 
X$C=X$C1+X$C2; 
ggplot(X,aes(x=C)) + geom_histogram() 

Однако, я хотел бы, чтобы цвет каждый бар в зависимости от относительного вклада С1 и С2, так что я получаю та же самая гистограмма (т. е. общая высота бара), как в приведенном выше примере, плюс я вижу долю лиц типа «C1» и «C2», как в штабелированной гистограмме.

Предложения для чистого способа сделать это с помощью ggplot2, используя данные типа «X» в примере?

Answer 1

Очень быстро, вы можете сделать то, что ОП хочет с помощью stat="identity" опции и plyr пакет вручную вычислить гистограмму, например, так:

library(plyr) 

X$mid <- floor(X$C/20)*20+10 
X_plot <- ddply(X, .(mid), summarize, total=length(C), split=sum(C1)/sum(C)*length(C)) 

ggplot(data=X_plot) + geom_histogram(aes(x=mid, y=total), fill="blue", stat="identity") + geom_histogram(aes(x=mid, y=split), fill="deeppink", stat="identity") 

Мы в основном просто создайте столбец «mids» для определения местоположения столбцов, а затем сделайте два графика: один с подсчетом для общего числа (C) и один с столбцами, скорректированными на счет одного из столбцов (C1). Вы должны быть в состоянии настроить здесь.

Обновление 1: Я понял, что сделал небольшую ошибку при вычислении средних частот. Исправлено. Кроме того, я не знаю, почему я использовал выражение «ddply» для вычисления средних значений. Это было глупо. Новый код более четкий и более сжатый.

Обновление 2: Я вернулся, чтобы посмотреть комментарий и заметил что-то слегка ужасное: я использовал суммы в качестве частот гистограммы. Я немного очистил код и добавил предложения от комментариев относительно синтаксиса окраски.

Answer 2

Как насчет:

library("reshape2") 
mm <- melt(X[,1:2]) 
ggplot(mm,aes(x=value,fill=variable))+geom_histogram(position="stack") 

Answer 3

Вот взлом с использованием ggplot_build. Идея заключается в том, чтобы сначала получить свой старый/оригинальный сюжет:

p <- ggplot(data = X, aes(x=C)) + geom_histogram() 

хранящегося в p. Затем используйте ggplot_build(p)$data[[1]] для извлечения данных, в частности, столбцы xmin и xmax (чтобы получить тот же брейки/binwidths гистограммы) и count столбца (нормализовать процентный count Вот код:.

# get old plot 
p <- ggplot(data = X, aes(x=C)) + geom_histogram() 
# get data of old plot: cols = count, xmin and xmax 
d <- ggplot_build(p)$data[[1]][c("count", "xmin", "xmax")] 
# add a id colum for ddply 
d$id <- seq(nrow(d)) 

Как для получения данных в настоящее время, что я понимаю из вашего поста это Возьмем, к примеру, первый бар в вашем участке имеет счетчик 2 и простирается от xmin = 147 до xmax = 156.8 Когда мы проверяем X для этих значений:?...

X[X$C >= 147 & X$C <= 156.8, ] # count = 2 as shown below 
# C1 C2 C 
# 19 91 63 154 
# 75 86 70 156 

Здесь я вычисляю (91+86)/(154+156)*(count=2) = 1.141935 и (63+70)/(154+156) * (count=2) = 0.8580645 как два нормализованных значения для каждого бара, который мы будем генерировать.

require(plyr) 
dd <- ddply(d, .(id), function(x) { 
    t <- X[X$C >= x$xmin & X$C <= x$xmax, ] 
    if(nrow(t) == 0) return(c(0,0)) 
    p <- colSums(t)[1:2]/colSums(t)[3] * x$count 
}) 

# then, it just normal plotting 
require(reshape2) 
dd <- melt(dd, id.var="id") 
ggplot(data = dd, aes(x=id, y=value)) + 
     geom_bar(aes(fill=variable), stat="identity", group=1) 

И это оригинальный сюжет:

И это то, что я получаю:

Edit: Если вы хотите получить ломается, тогда вы можете получить соответствующие координаты x старый сюжет и использовать его здесь вместо id:

p <- ggplot(data = X, aes(x=C)) + geom_histogram() 
d <- ggplot_build(p)$data[[1]][c("count", "x", "xmin", "xmax")] 
d$id <- seq(nrow(d)) 

require(plyr) 
dd <- ddply(d, .(id), function(x) { 
    t <- X[X$C >= x$xmin & X$C <= x$xmax, ] 
    if(nrow(t) == 0) return(c(x$x,0,0)) 
    p <- c(x=x$x, colSums(t)[1:2]/colSums(t)[3] * x$count) 
}) 

require(reshape2) 
dd.m <- melt(dd, id.var="V1", measure.var=c("V2", "V3")) 
ggplot(data = dd.m, aes(x=V1, y=value)) + 
     geom_bar(aes(fill=variable), stat="identity", group=1)