facet_grid - usando stat_function y facet_wrap juntos en GGPLOT2 en R

facet_wrap ggplot

Question

Estoy intentando trazar datos de tipo reticulado con GGPLOT2 y luego superponer una distribución normal sobre los datos de muestra para ilustrar qué tan lejos de lo normal son los datos subyacentes. Me gustaría tener el dist normal encima para tener la misma media y stdev 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)

Todo funciona muy bien y produce un buen gráfico de tres paneles de los datos. ¿Cómo agrego el dist normal en la parte superior? Parece que usaría stat_function, pero esto falla:

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

Parece que la función stat_ no se lleva bien con la función facet_wrap. ¿Cómo logro que estos dos jueguen bien?

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

Traté de integrar ideas de dos de las respuestas a continuación y todavía no estoy allí:

usando una combinación de ambas respuestas, 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)

lo cual está muy cerca ... excepto que algo está mal con el trazado de dist tradicional:

¿Qué estoy haciendo mal aquí?

Answer 1

Creo que debes 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 de media y sd para cada panel. Obtener los medios específicos del panel y las desviaciones estándar se deja como un ejercicio para el lector *;)

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

Answer 2

Creo que tu mejor opción es dibujar 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 3

Si no desea generar el gráfico de líneas de distribución normal "a mano", aún usar stat_function y mostrar gráficos uno al lado del otro, entonces podría considerar usar la función "multiplot" publicada en "Cookbook for R" como una alternativa a facet_wrap. Puede copiar el código multiplot a su proyecto desde 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 4

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

Como sugiere Ian, la mejor manera es generar usted mismo las curvas normales, y trazarlas como un conjunto de datos por separado (aquí es donde antes se equivocaba; la fusión simplemente no tiene sentido para este ejemplo y si mira cuidadosamente, lo hará ver por qué estás obteniendo el extraño patrón de diente de sierra).

Así es como resolvería el 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)