Несколько графиков плотности различных групп (на основе факторного уровня) с помощью plyr - PullRequest
Новая
       21

Несколько графиков плотности различных групп (на основе факторного уровня) с помощью plyr

9 голосов
/ 13 ноября 2011

Я пытаюсь вывести график с множественной плотностью из функции, разделив информационный кадр на части так, чтобы отдельные плотности для каждого уровня фактора соответствовали yvar.назван по имени уровня, например, Aa, Bb, Cc, Dd Расположение графиков см. в наборе параметров, так что мы сравниваем изменения плотности и средние значениякомпактный - мало места между графиками.

Помощь приветствуется.

Редактирование: Следующие графики создаются индивидуально, хотя я хочу разработать функцию, которая может быть применима к уровню x для фактора.

enter image description here

Ответы [ 3 ]

11 голосов
/ 13 ноября 2011

Я вижу, что @Андри только что побил меня. Я все еще собираюсь опубликовать свой ответ, так как заполнение только определенных квантилей распределения требует немного другого подхода. 

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

enter image description here

8 голосов
/ 13 ноября 2011

Вот способ сделать это в 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")

enter image description here

3 голосов
/ 14 ноября 2011

С искренней благодарностью Джорану и Андри, следующее - просто сборник моих любимых сверху двух постов, которые могут захотеть увидеть только некоторые читатели. 

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

enter image description here

...