usando stat_function y facet_wrap juntos en ggplot2 en R

Question

Estoy intentando representar gráficamente los datos de tipo de celosía con ggplot2 y luego superponer una distribución normal en los datos de la muestra para ilustrar cómo lejos normal de los datos subyacentes es. Me gustaría tener la dist normales en la parte superior para tener la misma media y DESVEST que el panel.

he aquí un ejemplo:

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)

Que todo funciona muy bien y produce un gráfico agradable de tres paneles de los datos. ¿Cómo agrego el dist normales en la parte superior? Parece que yo usaría stat_function, pero esto no funciona:

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

Parece que el stat_function no se lleva bien con la función de facet_wrap. ¿Cómo consigo estos dos para jugar muy bien?

------------ EDITAR ---------

He intentado integrar las ideas de dos de las respuestas a continuación y estoy todavía no existe:

utilizando una combinación de las dos respuestas que puedo hackear esto:

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)

, que está muy cerca ... excepto algo está mal con el trazado dist normales:

¿Qué estoy haciendo mal aquí?

Answer 1

stat_function está diseñado para superponer la misma función en cada panel. (No hay manera obvia para que coincida con los parámetros de la función de los diferentes paneles).

Como Ian sugiere, la mejor manera es generar las curvas normales a sí mismo, y la trama de ellos como un separada conjunto de datos (aquí es donde usted iba mal antes - la fusión simplemente no tiene sentido para este ejemplo y si se fijan bien verá que es por eso que está recibiendo el patrón de diente de sierra extraña).

Así es como me gustaría ir sobre la solución del problema:

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) 

Answer 2

Creo que es necesario proporcionar más información. Esto parece funcionar:

 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

Estamos proporcionando el mismo parámetro media y SD para cada panel. Conseguir medios de panel específico y las desviaciones estándar se deja como ejercicio para el lector *;)

'*' En otras palabras, no está seguro de cómo se puede hacer ...

Answer 3

Creo que lo mejor es trazar la línea manualmente con 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

Answer 4

Si no desea generar la distribución normal de línea gráfica "a mano", siguen utilizando stat_function, y mostrar gráficos de lado a lado - entonces usted podría considerar el uso de la función "G. múltiple", publicado en "libro de cocina para R" como una alternativa a facet_wrap. Usted puede copiar el código G. múltiple a su proyecto de aquí .

Después de copiar el código, haga lo siguiente:

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

Answer 5

Si usted está dispuesto a utilizar ggformula, entonces esto es bastante fácil. (También es posible mezclar y combinar y utilizar ggformula sólo por la superposición de la distribución, pero voy a ilustrar el enfoque completo en ggformula.)

library(ggformula)
theme_set(theme_bw())

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

^{Creado el 15/01/2019 por el reprex paquete (v0.2.1)}