多个密度图使用plyr绘制不同的组（基于因子水平）

Question

我正在尝试从函数输出多个密度图，方法是将数据框划分为多个部分，使得每个级别的密度对应yvar。

set.seed(1234)
Aa = c(rnorm(40000, 50, 10))
Bb = c(rnorm(4000, 70, 10))
Cc = c(rnorm(400, 75, 10))
Dd = c(rnorm(40, 80, 10))
yvar = c(Aa, Bb, Cc, Dd)
    gen <- c(rep("Aa", length(Aa)),rep("Bb", length(Bb)), rep("Cc", length(Cc)),
  rep("Dd", length(Dd)))
mydf <- data.frame(gen, yvar)

minyvar <- min(yvar)
maxyvar <- max(yvar)

par(mfrow = c(length(levels(mydf$gen)),1))

plotdensity <- function (xf, minyvar, maxyvar){
plot(density(xf), xlim=c(minyvar, maxyvar), main = paste (names(xf), 
  "distribution", sep = ""))
dens <- density(xf)
x1 <- min(which(dens$x >= quantile(xf, .80)))
x2 <- max(which(dens$x <  max(dens$x)))
with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="blu4"))
abline(v= mean(xf),  col = "black", lty = 1, lwd =2)
}

require(plyr)
ddply(mydf, .(mydf$gen), plotdensity, yvar, minyvar, maxyvar)

Error in .fun(piece, ...) : unused argument(s) (111.544494112914)

我的具体期望是每个地块都以等级名称命名，例如Aa，Bb，Cc，Dd 图表的排列参见参数集，以便我们比较密度变化和均值。紧凑 - 图表之间的空间不足。

帮助表示感谢。

编辑： 下面的图表是单独生成的，但我想开发一个可以适用于x级别的函数的函数。

Answer 1

我看到@Andrie只是打败了我。我仍然会发布我的答案，因为只填充分布的某些分位数需要稍微不同的方法。

set.seed(1234)
Aa = c(rnorm(40000, 50, 10))
Bb = c(rnorm(4000, 70, 10))
Cc = c(rnorm(400, 75, 10))
Dd = c(rnorm(40, 80, 10))
yvar = c(Aa, Bb, Cc, Dd)
gen <- c(rep("Aa", length(Aa)),rep("Bb", length(Bb)), rep("Cc", length(Cc)),
            rep("Dd", length(Dd)))
mydf <- data.frame(grp = gen,x = c(Aa,Bb,Cc,Dd))

#Calculate the densities and an indicator for the desire quantile
# for later use in subsetting
mydf <- ddply(mydf,.(grp),.fun = function(x){
    tmp <- density(x$x)
    x1 <- tmp$x
    y1 <- tmp$y
    q80 <- x1 >= quantile(x$x,0.8)
    data.frame(x=x1,y=y1,q80=q80)
})

#Separate data frame for the means
mydfMean <- ddply(mydf,.(grp),summarise,mn = mean(x))

ggplot(mydf,aes(x = x)) + 
    facet_wrap(~grp) +
    geom_line(aes(y = y)) + 
    geom_ribbon(data = subset(mydf,q80),aes(ymax = y),ymin = 0, fill = "black") +
    geom_vline(data = mydfMean,aes(xintercept = mn),colour = "black")

Answer 2

以下是ggplot中的一种方法：

set.seed(1234)
mydf <- rbind(
    data.frame(gen="Aa", yvar= rnorm(40000, 50, 10)),
    data.frame(gen="Bb", yvar=rnorm(4000, 70, 10)),
    data.frame(gen="Cc", yvar=rnorm(400, 75, 10)),
    data.frame(gen="Dd", yvar=rnorm(40, 80, 10))
)

labels <- ddply(mydf, .(gen), nrow)
means  <- ddply(mydf, .(gen), summarize, mean=mean(yvar))

ggplot(mydf, aes(x=yvar)) + 
    stat_density(fill="blue") + 
    facet_grid(gen~.) + 
    theme_bw() +
    geom_vline(data=means, aes(xintercept=mean), colour="red") + 
    geom_text(data=labels, aes(label=paste("n =", V1)), x=5, y=0, 
        hjust=0, vjust=0) +
    opts(title="Distribution")

Answer 3

真诚地感谢乔丹和安德烈，以下只是汇编了我最喜欢的两篇帖子，只是一些读者可能想看到的。

require(ggplot2)
set.seed(1234)
Aa = c(rnorm(40000, 50, 10))
Bb = c(rnorm(4000, 70, 10))
Cc = c(rnorm(400, 75, 10))
Dd = c(rnorm(40, 80, 10))
yvar = c(Aa, Bb, Cc, Dd)
gen <- c(rep("Aa", length(Aa)),rep("Bb", length(Bb)), rep("Cc", length(Cc)),
            rep("Dd", length(Dd)))
mydf <- data.frame(grp = gen,x = c(Aa,Bb,Cc,Dd))
mydf1 <- mydf 
#Calculate the densities and an indicator for the desire quantile
# for later use in subsetting
mydf <- ddply(mydf,.(grp),.fun = function(x){
    tmp <- density(x$x)
    x1 <- tmp$x
    y1 <- tmp$y
    q80 <- x1 >= quantile(x$x,0.8)
    data.frame(x=x1,y=y1,q80=q80)
})
    #Separate data frame for the means
mydfMean <- ddply(mydf,.(grp),summarise,mn = mean(x))
labels <- ddply(mydf1, .(grp), nrow)
       ggplot(mydf,aes(x = x)) + 
            facet_grid(grp~.)  +
            geom_line(aes(y = y)) + 
            geom_ribbon(data = subset(mydf,q80),aes(ymax = y),ymin = 0, 
fill = "black")            +       
 geom_vline(data = mydfMean,aes(xintercept = mn),
colour = "black") +         geom_text(data=labels, 
aes(label=paste("n =", labels$V1)), x=5, y=0,
                 hjust=0, vjust=0) +    
opts(title="Distribution") +  theme_bw()