Istogramma simmetrico e violino simile alla trama?

Question

Come è possibile creare un istogramma in cui il centro di ciascuna barra si trova lungo un asse comune? Questo apparirebbe come una trama di violino con bordi a forma di gradino.

Mi piacerebbe farlo in Lattice e non mi interessa personalizzare le funzioni del pannello, ecc., Ma sarei felice di utilizzare la grafica di base R o anche ggplot2. (Non mi sono ancora gettato in ggplot2, ma a un certo punto lo farò.)

(Perché voglio fare questo? Penso che potrebbe essere un utile sostituto per una trama di violino quando i dati sono discreti e si verifica in alcuni valori numerici equidistanti di [5-50] .Ogni bin rappresenta quindi un punto, naturalmente potrei semplicemente generare un normale istogramma, ma penso che a volte sia utile visualizzare sia un box-and-whisker trama e trama di un violino: con dati discreti a intervalli regolari, un istogramma simmetrico con lo stesso orientamento di un boxplot consente di confrontare la struttura dettagliata dei dati con il boxplot, proprio come fa un diagramma di violino. In questo caso l'istogramma simmetrico potrebbe essere più informativo di una trama di violino. (Un beanplot potrebbe essere un'altra alternativa per quello che ho appena descritto, anche se in realtà i miei dati non sono letteralmente discreti, ma convergono in prossimità di una serie di valori regolari. Questo rende il pacchetto beanplot di R meno utile per me, a meno che non normalizzi i valori mappandoli al valore normale più vicino.)

Ecco un sottoinsieme di 30 osservazioni di alcuni dati, che viene generato da un agente- simulazione basata:

df30 <- data.frame(crime.v=c(0.2069526, 0.2063516, 0.06919754, 
0.2080366, -0.06975912, 0.206277, 0.3457634, 0.2058985, 0.3428499, 
0.3428159, 0.06746109, -0.07068694, 0.4826098, -0.06910966, 0.06769761, 
0.2098732, 0.3482267, 0.3483602, 0.4829777, 0.06844112, 0.2093492, 
0.4845478, 0.2093505, 0.3482845, 0.3459249, 0.2106339, 0.2098397, 
0.4844956, 0.2108985, 0.2107984), bias=c("beast", "beast", "beast", 
"beast", "beast", "beast", "beast", "beast", "beast", "beast", "beast", 
"beast", "beast", "beast", "beast", "virus", "virus", "virus", "virus", 
"virus", "virus", "virus", "virus", "virus", "virus", "virus", "virus", 
"virus", "virus", "virus")) 

un dataframe nome df con un set completo di 600 osservazioni in un file RDATA può essere scaricato da questo link: CVexample.rdata.

I valori crime.v sono tutti vicino ad una delle seguenti, che chiamerò foci:

[1] -0.89115386 -0.75346155 -0.61576924 -0.47807693 -0.34038463 -0.20269232 -0.06500001 
[8] 0.07269230 0.21038460 0.34807691 0.48576922 0.62346153 0.76115383 0.89884614 

(I valori crime.v sono effettivamente medie di 13 variabili, i cui valori possono variare da -1 a 1, ma che finiscono per convergere in valori che si trovano nelle vicinanze di .9 o -.9. Le medie di 13 valori intorno a 0,9 o -9 sono un po 'vicine ai fuochi. In pratica ho determinato i valori appropriati per i fuochi esaminando il dati, poiché sono necessarie alcune variazioni aggiuntive.)

Una trama di violino può essere prodotta con:

require(lattice) 
bwplot(crime.v ~ bias, data=df30, ylim=c(-1,1), panel=panel.violin) 

Se si esegue questo con il set di dati più grandi, vedrete che una delle trame violino prodotta è multimodale, mentre l'altro non lo è. Tuttavia, questo non sembra riflettere una differenza nei dati sottostanti i due grafici del violino; è un artefatto dovuto alla posizione dei fuochi in relazione alla trama, per quanto posso dire. Posso attenuare la differenza modificando i parametri di density passati a panel.violin, ma sarebbe più semplice rappresentare solo quanti punti ci sono in ogni cluster.

Grazie!

Answer 1

Ecco una possibilità utilizzando la grafica di base:

tmp <- tapply(iris$Petal.Length, iris$Species, function(x) hist(x, plot=FALSE)) 

plot.new() 
tmp.r <- do.call(range, lapply(tmp, `[[`, 'breaks')) 
plot.window(xlim=c(1/2,length(tmp)+1/2), ylim=tmp.r) 
abline(v=seq_along(tmp)) 

for(i in seq_along(tmp)) { 
    h <- tmp[[i]] 
    rf <- h$counts/sum(h$counts) 
    rect(i-rf/2, head(h$breaks, -1), i+rf/2, tail(h$breaks, -1)) 
} 

axis(1, at=seq_along(tmp), labels=names(tmp)) 
axis(2) 
box() 

è possibile modificare le diverse parti alle proprie preferenze e il tutto potrebbe facilmente essere avvolto in una funzione.

Answer 2

Ecco una funzione del pannello reticolo basata sulla risposta di @ GregSnow utilizzando la grafica di base. Non avrei potuto farlo senza che Greg fornisse un solido punto di partenza, quindi tutto il merito va a Greg.La mia funzione di pannello non è molto sofisticata e potrebbe benissimo spezzarsi su qualcosa di semplice, ma gestirà gli orientamenti orizzontali e verticali e ti consentirà di fornire un vettore di interruzioni o di lasciarlo fuori. Rimuove anche i raccoglitori alle estremità vuote. La funzione del pannello utilizza il comportamento predefinito di hist per breaks anziché histogram, che è più complicato. Commenti su metodi migliori sono i benvenuti.

Poiché gli istogrammi simmetrici o centrati non hanno un nome esistente, per quanto ne so, e ricordano un giocattolo della Torre di Hanoi, forse dovrebbero essere chiamati "istogrammi della Torre di Hanoi". Quindi la funzione è chiamata panel.hanoi.

semplice esempio di utilizzo con la definizione di DF30 sopra:

bwplot(crime.v ~ bias, data=df30, panel=panel.hanoi) 

Ecco un esempio più complesso utilizzando i dati forniti nel collegamento in questione (grafico a fine risposta).

bwplot(crime.v ~ bias, data=df, ylim=c(-1,1), pch="|", coef=0, panel=function(...){panel.hanoi(col="pink", breaks=cv.ints, ...); panel.bwplot(...)}) 

questo esempio viene aggiunto ylim per specificare che la trama dovrebbe andare da -1 a 1, e sovrappone una bwplot sulla parte superiore della trama Hanoi. pch e coef influenzano l'aspetto del bwplot. L'esempio utilizza anche la seguente definizione per centrare ogni casella della trama Hanoi attorno ai luoghi in cui i miei punti di dati tendono a mentire (vedi domanda iniziale):

cv.ints <- c(-1.000000000, -0.960000012, -0.822307704, -0.684615396, -0.546923088, -0.409230781, -0.271538473, -0.133846165, 0.003846142, 0.141538450, 0.279230758, 0.416923065, 0.554615373, 0.692307681, 0.829999988, 0.967692296, 1.000000000) 

Ecco la funzione del pannello:

panel.hanoi <- function(x, y, horizontal, breaks="Sturges", ...) { # "Sturges" is hist()'s default 

    if (horizontal) { 
    condvar <- y # conditioning ("independent") variable 
    datavar <- x # data ("dependent") variable 
    } else { 
    condvar <- x 
    datavar <- y 
    } 

    conds <- sort(unique(condvar)) 

    # loop through the possible values of the conditioning variable 
    for (i in seq_along(conds)) { 

     h <- hist(datavar[condvar == conds[i]], plot=F, breaks) # use base hist(ogram) function to extract some information 

    # strip outer counts == 0, and corresponding bins 
    brks.cnts <- stripOuterZeros(h$breaks, h$counts) 
    brks <- brks.cnts[[1]] 
    cnts <- brks.cnts[[2]] 

    halfrelfs <- (cnts/sum(cnts))/2 # i.e. half of the relative frequency 
    center <- i 

    # All of the variables passed to panel.rec will usually be vectors, and panel.rect will therefore make multiple rectangles. 
    if (horizontal) { 
     panel.rect(head(brks, -1), center - halfrelfs, tail(brks, -1), center + halfrelfs, ...) 
    } else { 
     panel.rect(center - halfrelfs, head(brks, -1), center + halfrelfs, tail(brks, -1), ...) 
    } 
    } 
} 

# function to strip counts that are all zero on ends of data, along with the corresponding breaks 
stripOuterZeros <- function(brks, cnts) { do.call("stripLeftZeros", stripRightZeros(brks, cnts)) } 

stripLeftZeros <- function(brks, cnts) { 
    if (cnts[1] == 0) { 
    stripLeftZeros(brks[-1], cnts[-1]) 
    } else { 
    list(brks, cnts) 
    } 
} 

stripRightZeros <- function(brks, cnts) { 
    len <- length(cnts) 
    if (cnts[len] ==0) { 
    stripRightZeros(brks[-(len+1)], cnts[-len]) 
    } else { 
    list(brks, cnts) 
    } 
}