используя stat_function и facet_wrap вместе в ggplot2 в R

Я пытаюсь построить данные типа решетки с помощью ggplot2, а затем наложить нормальное распределение на образцы данных, чтобы проиллюстрировать, насколько далеко от нормальных лежат базовые данные. Я хотел бы, чтобы обычный dist был сверху, чтобы иметь такое же среднее значение и стандартное отклонение, что и у панели.

вот пример:

library(ggplot2)

#make some example data
dd<-data.frame(matrix(rnorm(144, mean=2, sd=2),72,2),c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

#This works
pg <- ggplot(dd) + geom_density(aes(x=Predicted_value)) +  facet_wrap(~State_CD)
print(pg)

Все это отлично работает и дает хороший трехпанельный график данных. Как мне добавить обычный дист поверх? Кажется, я бы использовал stat_function, но это не работает:

#this fails
pg <- ggplot(dd) + geom_density(aes(x=Predicted_value)) + stat_function(fun=dnorm) +  facet_wrap(~State_CD)
print(pg)

Похоже, что stat_function не работает с функцией facet_wrap. Как мне заставить этих двоих хорошо играть?

------------ ИЗМЕНИТЬ ---------

Я попытался объединить идеи из двух приведенных ниже ответов, но меня все еще нет:

используя комбинацию обоих ответов, я могу взломать это:

library(ggplot)
library(plyr)

#make some example data
dd<-data.frame(matrix(rnorm(108, mean=2, sd=2),36,2),c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

DevMeanSt <- ddply(dd, c("State_CD"), function(df)mean(df$Predicted_value)) 
colnames(DevMeanSt) <- c("State_CD", "mean")
DevSdSt <- ddply(dd, c("State_CD"), function(df)sd(df$Predicted_value) )
colnames(DevSdSt) <- c("State_CD", "sd")
DevStatsSt <- merge(DevMeanSt, DevSdSt)

pg <- ggplot(dd, aes(x=Predicted_value))
pg <- pg + geom_density()
pg <- pg + stat_function(fun=dnorm, colour='red', args=list(mean=DevStatsSt$mean, sd=DevStatsSt$sd))
pg <- pg + facet_wrap(~State_CD)
print(pg)

что действительно близко ... за исключением того, что что-то не так с нормальным построением dist:

введите описание изображения здесь

что я здесь делаю не так?


person JD Long    schedule 04.09.2009    source источник
comment
Не могли бы вы в будущем использовать имена переменных со смешанным регистром или подчеркиваниями, но не с обоими сразу. Это убивает меня!   -  person hadley    schedule 04.09.2009
comment
хорошо, хорошо, это хороший момент. :)   -  person JD Long    schedule 04.09.2009
comment
Я переместил свой ответ в область вопросов. Я должен был положить это туда для начала. Приношу свои извинения тем, кто оставил комментарии, так как они не были переведены. Я буду более вдумчиво относиться к тому, как я это сделаю в будущем.   -  person JD Long    schedule 04.09.2009


Ответы (6)


stat_function предназначен для наложения одной и той же функции на каждой панели. (Нет очевидного способа согласовать параметры функции с разными панелями).

Как предлагает Ян, лучший способ - самостоятельно сгенерировать нормальные кривые и построить их как отдельный набор данных (именно здесь вы раньше ошибались - слияние просто не имеет смысла для этого примера и если вы посмотрите внимательно, вы увидите, что получается странный узор с зубьями).

Вот как я подхожу к решению проблемы:

dd <- data.frame(
  predicted = rnorm(72, mean = 2, sd = 2),
  state = rep(c("A", "B", "C"), each = 24)
) 

grid <- with(dd, seq(min(predicted), max(predicted), length = 100))
normaldens <- ddply(dd, "state", function(df) {
  data.frame( 
    predicted = grid,
    density = dnorm(grid, mean(df$predicted), sd(df$predicted))
  )
})

ggplot(dd, aes(predicted))  + 
  geom_density() + 
  geom_line(aes(y = density), data = normaldens, colour = "red") +
  facet_wrap(~ state) 

введите описание изображения здесь

person hadley    schedule 04.09.2009
comment
Это становится понятным после того, как вы это объясните. Мне не было интуитивно понятно, что stat_function была разработана для одиночных кривых. Я просто предположил, что делаю это неправильно. Спасибо, что нашли время привести пример, это фантастически полезно. - person JD Long; 04.09.2009
comment
Неужели по-прежнему stat_function не может предоставить разные кривые для каждой панели? Кажется, можно просто передать именованный список функций и сопоставить эти имена с категориальной переменной, заданной для facet_wrap, или предоставить функцию в качестве аргумента в исходной таблице данных? - person cboettig; 20.12.2012
comment
@cboettig нет и вряд ли когда-нибудь будет. Именованный список не будет работать для нескольких переменных фасетирования. - person hadley; 31.12.2012
comment
@hadley Я не понимаю в чем проблема. Почему нельзя stat_function просто сослаться на часть фрейма данных, нанесенную на определенную панель, для оценки ее аргументов? - person jhin; 02.03.2015

Я думаю, вам нужно предоставить больше информации. Кажется, это работает:

 pg <- ggplot(dd, aes(Predicted_value)) ## need aesthetics in the ggplot
 pg <- pg + geom_density() 
 ## gotta provide the arguments of the dnorm
 pg <- pg + stat_function(fun=dnorm, colour='red',            
            args=list(mean=mean(dd$Predicted_value), sd=sd(dd$Predicted_value)))
 ## wrap it!
 pg <- pg + facet_wrap(~State_CD)
 pg

Мы предоставляем одинаковые значения среднего и стандартного отклонения для каждой панели. Получение конкретных средств панели и стандартных отклонений оставлено в качестве упражнения для читателя *;)

'*' Другими словами, не знаю, как это можно сделать ...

person Eduardo Leoni    schedule 04.09.2009
comment
Средние значения и стандартные отклонения для каждой панели можно получить с помощью библиотеки (plyr) и ddply (dd,. (State_CD), summarize, ...) - person Nova; 11.09.2015
comment
Хорошее усилие, но ... OP указано наверху "I would like to have the normal dist on top to have the same mean and stdev as the panel." - person PatrickT; 12.10.2017

Если вы хотите использовать ggformula, это довольно просто. (Также можно смешивать, сопоставлять и использовать ggformula только для наложения распределения, но я полностью проиллюстрирую подход ggformula.)

library(ggformula)
theme_set(theme_bw())

gf_dens( ~ Sepal.Length | Species, data = iris) %>%
  gf_fitdistr(color = "red") %>% 
  gf_fitdistr(dist = "gamma", color = "blue")

Создано 15 января 2019 г. пакетом REPEX (v0.2.1)

person rpruim    schedule 16.01.2019
comment
Ответ отличный, но код должен соответствовать вопросу: library (ggformula); theme_set (theme_bw ()); dd ‹- data.frame (matrix (rnorm (144, mean = 2, sd = 2), 72, 2), c (rep (A, 24), rep (B, 24), rep (C, 24)) ); colnames (dd) ‹- c (x_value, Predicted_value, State_CD); gf_dens (~ Predicted_value | State_CD, data = dd)% ›% gf_fitdistr (dist = dnorm, color = blue) - person Colibri; 04.07.2020

Если вы не хотите создавать линейный график нормального распределения «вручную», по-прежнему используйте stat_function и отображайте графики бок о бок - тогда вы можете рассмотреть возможность использования функции «multiplot», опубликованной в «Поваренной книге для R» как альтернатива facet_wrap. Вы можете скопировать код мультиплота в свой проект отсюда.

После копирования кода сделайте следующее:

# Some fake data (copied from hadley's answer)
dd <- data.frame(
  predicted = rnorm(72, mean = 2, sd = 2),
  state = rep(c("A", "B", "C"), each = 24)
) 

# Split the data by state, apply a function on each member that converts it into a 
# plot object, and return the result as a vector.
plots <- lapply(split(dd,dd$state),FUN=function(state_slice){ 
  # The code here is the plot code generation. You can do anything you would 
  # normally do for a single plot, such as calling stat_function, and you do this 
  # one slice at a time.
  ggplot(state_slice, aes(predicted)) + 
    geom_density() + 
    stat_function(fun=dnorm, 
                  args=list(mean=mean(state_slice$predicted), 
                            sd=sd(state_slice$predicted)),
                  color="red")
})

# Finally, present the plots on 3 columns.
multiplot(plotlist = plots, cols=3)

введите описание изображения здесь

person AmitA    schedule 11.12.2014

Я думаю, что лучше всего провести линию вручную с помощью geom_line.

dd<-data.frame(matrix(rnorm(144, mean=2, sd=2),72,2),c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")
dd$Predicted_value<-dd$Predicted_value*as.numeric(dd$State_CD) #make different by state

##Calculate means and standard deviations by level
means<-as.numeric(by(dd[,2],dd$State_CD,mean))
sds<-as.numeric(by(dd[,2],dd$State_CD,sd))

##Create evenly spaced evaluation points +/- 3 standard deviations away from the mean
dd$vals<-0
for(i in 1:length(levels(dd$State_CD))){
    dd$vals[dd$State_CD==levels(dd$State_CD)[i]]<-seq(from=means[i]-3*sds[i], 
                            to=means[i]+3*sds[i],
                            length.out=sum(dd$State_CD==levels(dd$State_CD)[i]))
}
##Create normal density points
dd$norm<-with(dd,dnorm(vals,means[as.numeric(State_CD)],
                        sds[as.numeric(State_CD)]))


pg <- ggplot(dd, aes(Predicted_value)) 
pg <- pg + geom_density() 
pg <- pg + geom_line(aes(x=vals,y=norm),colour="red") #Add in normal distribution
pg <- pg + facet_wrap(~State_CD,scales="free")
pg
person Ian Fellows    schedule 04.09.2009

Первоначально опубликовано как ответ на этот вопрос, я было предложено поделиться своим решением и здесь.

Меня тоже разочаровало наложение теоретических плотностей на эмпирические данные, поэтому я написал функцию, которая автоматизировала этот процесс. С 2009 года, когда этот вопрос был впервые задан, ggplot2 значительно расширил возможности расширения, поэтому я поместил его в пакет расширений на github.

library(ggplot2)
library(ggh4x)

set.seed(0)

# Make the example data
dd <- data.frame(matrix(rnorm(144, mean=2, sd=2),72,2),
                 c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

ggplot(dd, aes(Predicted_value)) +
  geom_density() +
  stat_theodensity(colour = "red") +
  facet_wrap(~ State_CD)

Создано 2021-01-28 с помощью пакета REPEX (v0.3.0)

person teunbrand    schedule 28.01.2021