busta di ombreggiatura ggplot2 delle serie temporali

Question

Sto tracciando i risultati di 50 - 100 esperimenti. Ogni esperimento genera una serie storica. Posso tracciare una trama di spaghetti di tutte le serie temporali, ma quello che mi piacerebbe avere è una specie di mappa della densità per il pennacchio delle serie temporali. (qualcosa di simile al ombreggiatura grigia nel pannello inferiore in questa figura: http://www.ipcc.ch/graphics/ar4-wg1/jpg/fig-6-14.jpg)

posso 'sorta di' faccio con binning 2d o binhex, ma il risultato potrebbe essere più bella (vedi esempio sotto).

Ecco un codice che riproduce un diagramma di plume per dati fittizi (utilizza ggplot2 e reshape2).

# mock data: random walk plus a sinus curve. 
# two envelopes for added contrast. 
tt=10*sin(c(1:100)/(3*pi)) 
rr=apply(matrix(rnorm(5000),100,50),2,cumsum) +tt 
rr2=apply(matrix(rnorm(5000),100,50),2,cumsum)/1.5 +tt 

# stuff data into a dataframe and melt it. 
df=data.frame(c(1:100),cbind(rr,rr2)) 
names(df)=c("step",paste("ser",c(1:100),sep="")) 
dfm=melt(df,id.vars = 1) 

# ensemble average 
ensemble_av=data.frame(step=df[,1],ensav=apply(df[,-1],1,mean)) 
ensemble_av$variable=as.factor("Mean") 


ggplot(dfm,aes(step,value,group=variable))+ 
    stat_binhex(alpha=0.2) + geom_line(alpha=0.2) + 
    geom_line(data=ensemble_av,aes(step,ensav,size=2))+ 
    theme(legend.position="none") 

Qualcuno sa di un modo carino di ottenere una busta ombreggiata con sfumature. Ho anche provato geom_ribbon ma questo non ha dato alcuna indicazione di variazioni di densità lungo il pennacchio. binhex lo fa, ma non con risultati esteticamente gradevoli.

Answer 1

quantili Calcolare: Nastri

qs = data.frame(
    do.call(
     rbind, 
     tapply(
     dfm$value, dfm$step, function(i){quantile(i)})), 
    t=1:100) 

head(qs) 
     X0.  X25.  X50.  X75.  X100. t 
1 -0.8514179 0.4197579 0.7681517 1.396382 2.883903 1 
2 -0.6506662 1.2019163 1.6889073 2.480807 5.614209 2 
3 -0.3182652 2.0480082 2.6206045 4.205954 6.485394 3 
4 -0.1357976 2.8956990 4.2082762 5.138747 8.860838 4 
5 0.8988975 3.5289219 5.0621513 6.075937 10.253379 5 
6 2.0027973 4.5398120 5.9713921 7.015491 11.494183 6 

Trama:

ggplot() + 
geom_ribbon(data=qs, aes(x=t, ymin=X0., ymax=X100.),fill="gray30", alpha=0.2) + 
geom_ribbon(data=qs, aes(x=t, ymin=X25., ymax=X75.),fill="gray30", alpha=0.2) 

Questo per due intervalli quantile, (0-100) e (25-75). Avrai bisogno di più argomenti per quantile e più strati del nastro per più quantili, e devi anche regolare i colori.

Answer 2

Sulla base dell'idea di Spacedman, ho trovato un modo per aggiungere più intervalli in modo automatico: ho computo quantili per ogni step, raggrupparli da coppie di simmetriche valori e quindi utilizzare geom_ribbon nel giusto ordine ...

library(tidyr) 
library(dplyr) 
condquant <- dfm %>% group_by(step) %>% 
    do(quant = quantile(.$value, probs = seq(0,1,.05)), probs = seq(0,1,.05)) %>% 
    unnest() %>% 
    mutate(delta = 2*round(abs(.5-probs)*100)) %>% 
    group_by(step, delta) %>% 
    summarize(quantmin = min(quant), quantmax= max(quant)) 

ggplot() + 
    geom_ribbon(data = condquant, aes(x = step, ymin = quantmin, ymax = quantmax, 
            group = reorder(delta, -delta), fill = as.numeric(delta)), 
       alpha = .5) + 
    scale_fill_gradient(low = "grey10", high = "grey95") + 
    geom_line(data = dfm, aes(x = step, y = value, group=variable), alpha=0.2) + 
    geom_line(data=ensemble_av,aes(step,ensav),size=2)+ 
    theme(legend.position="none") 

Answer 3

Grazie Erwan e Spacedman.

Evitando 'tidyr' ('dplyr' e 'magrittr') la mia versione di Erwans risposta diventa

probs=c(0:10)/10 # use fewer quantiles than Erwan 
arr=t(apply(df[,-1],1,quantile,prob=probs)) 
dfq=data.frame(step=df[,1],arr) 
names(dfq)=c("step",colnames(arr)) 
dfqm=melt(dfq,id.vars=c(1)) 
# add inter-quantile (per) range as delta 
dfqm$delta=dfqm$variable 
levels(dfqm$delta)=abs(probs-rev(probs))*100 


dfplot=ddply(dfqm,.(step,delta),summarize, 
    quantmin=min(value), 
    quantmax=max(value)) 

ggplot() + 
    geom_ribbon(data = dfplot, aes(x = step, ymin = quantmin, 
           ymax =quantmax,group=rev(delta), 
           fill = as.numeric(delta)), 
      alpha = .5) + 
    scale_fill_gradient(low = "grey25", high = "grey75") + 
    geom_line(data=ensemble_av,aes(step,ensav),size=2) + 
    theme(legend.position="none")