2014-11-05 19 views
23

Sto cercando di replicare questo enter image description here con R ggplot. Ho esattamente gli stessi dati:ggplot2 grafico torta e ciambella sullo stesso grafico

browsers<-structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L, 
2L, 1L, 5L, 5L, 4L), .Label = c("Chrome", "Firefox", "MSIE", 
"Opera", "Safari"), class = "factor"), version = structure(c(5L, 
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("Chrome 10.0", 
"Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0", 
"MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0" 
), class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58, 
13.12, 5.43, 9.91, 1.42, 4.55, 1.65), ymax = c(10.85, 18.2, 51.26, 
54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73), ymin = c(0, 
10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 
90.08)), .Names = c("browser", "version", "share", "ymax", "ymin" 
), row.names = c(NA, -11L), class = "data.frame") 

e sembra che questo:

> browsers 
    browser  version share ymax ymin 
1  MSIE  MSIE 6.0 10.85 10.85 0.00 
2  MSIE  MSIE 7.0 7.35 18.20 10.85 
3  MSIE  MSIE 8.0 33.06 51.26 18.20 
4  MSIE  MSIE 9.0 2.81 54.07 51.26 
5 Firefox Firefox 3.5 1.58 55.65 54.07 
6 Firefox Firefox 3.6 13.12 68.77 55.65 
7 Firefox Firefox 4.0 5.43 74.20 68.77 
8 Chrome Chrome 10.0 9.91 84.11 74.20 
9 Safari Safari 4.0 1.42 85.53 84.11 
10 Safari Safari 5.0 4.55 90.08 85.53 
11 Opera Opera 11.x 1.65 91.73 90.08 

Finora, ho tracciati i singoli componenti (cioè il grafico ad anello delle versioni, e il grafico a torta di i browser) in questo modo:

ggplot(browsers) + geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + 
coord_polar(theta="y") + xlim(c(0, 4)) 

enter image description here

ggplot(browsers) + geom_bar(aes(x = factor(1), fill = browser),width = 1) + 
coord_polar(theta="y") 

enter image description here

Il problema è, come faccio a combinare i due a guardare come l'immagine più in alto? Ho provato molti modi, ad esempio:

ggplot(browsers) + geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +   geom_bar(aes(x = factor(1), fill = browser),width = 1) + coord_polar(theta="y") + xlim(c(0, 4)) 

Ma tutti i miei risultati sono sia contorto o terminare con un messaggio di errore.

+0

Mi chiedo se questo è qualcosa che il '' Rcircos' o pacchetti circlize' può maniglia. – jazzurro

+0

@jazzurro oh non so di quei pacchetti ... li controlleremo! grazie;) – maryam

+0

Non sono sicuro se ti permettono di avere la grafica che desideri. Ma, vedendo cerchi interni ed esterni, ho pensato che potrebbe esserci qualcosa per te nei pacchetti. – jazzurro

risposta

17

Trovo che sia più semplice lavorare in coordinate rettangolari e, quando questo è corretto, passare a coordinate polari. La coordinata x diventa raggio in polar. Così, in coordinate rettangolari, la trama interno va da zero a un numero, come 3, e la fascia esterna va da 3 a 4.

Ad esempio

ggplot(browsers) + 
    geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + 
    geom_rect(aes(fill=browser, ymax=ymax, ymin=ymin, xmax=3, xmin=0)) + 
    xlim(c(0, 4)) + 
    theme(aspect.ratio=1) 

enter image description here

Poi, quando si passa al polar, si ottiene qualcosa come quello che stai cercando.

ggplot(browsers) + 
    geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + 
    geom_rect(aes(fill=browser, ymax=ymax, ymin=ymin, xmax=3, xmin=0)) + 
    xlim(c(0, 4)) + 
    theme(aspect.ratio=1) + 
    coord_polar(theta="y") 

enter image description here

Questo è un inizio, ma potrebbe essere necessario calibrare la dipendenza y (o angolo) e anche elaborare l'etichettatura/legenda/colorazione ... Utilizzando rect sia per il anelli interni ed esterni, che dovrebbero semplificare la regolazione della colorazione. Inoltre, può essere utile usare la funzione reshape2 :: melt per riorganizzare i dati in modo che la legenda esca corretta usando il gruppo (o il colore).

+0

Sei in grado di ottenere la trama che vuoi, o c'è ancora una domanda ? Forse puoi aggiornare la domanda originale con questo approccio. – user3969377

+0

@ user3969377 wow, questo è sicuramente quello che stavo cercando. Ho intenzione ora di mettere a punto l'estetica e buono per andare! Stavo iniziando a pensare che non fosse davvero possibile in ggplot. la tua spiegazione ha aiutato una tonnellata !! grazie mille! Nel caso in cui incappassi in qualche problema è ok se ti do un urlo ?? – maryam

+0

Se hai un'altra domanda, pubblicala come una domanda diversa. Vado a letto. Ti suggerisco di modificare y in modo che dipenda dai valori numerici, anziché dai fattori, in modo da avere un migliore controllo dell'angolo. Inoltre, leggi su fusione. – user3969377

27

Edit 2

La mia risposta originale è veramente stupido. Ecco una versione molto più breve che fa la maggior parte del lavoro con un'interfaccia molto più semplice.

#' x  numeric vector for each slice 
#' group vector identifying the group for each slice 
#' labels vector of labels for individual slices 
#' col colors for each group 
#' radius radius for inner and outer pie (usually in [0,1]) 

donuts <- function(x, group = 1, labels = NA, col = NULL, radius = c(.7, 1)) { 
    group <- rep_len(group, length(x)) 
    ug <- unique(group) 
    tbl <- table(group)[order(ug)] 

    col <- if (is.null(col)) 
    seq_along(ug) else rep_len(col, length(ug)) 
    col.main <- Map(rep, col[seq_along(tbl)], tbl) 
    col.sub <- lapply(col.main, function(x) { 
    al <- head(seq(0, 1, length.out = length(x) + 2L)[-1L], -1L) 
    Vectorize(adjustcolor)(x, alpha.f = al) 
    }) 

    plot.new() 

    par(new = TRUE) 
    pie(x, border = NA, radius = radius[2L], 
     col = unlist(col.sub), labels = labels) 

    par(new = TRUE) 
    pie(x, border = NA, radius = radius[1L], 
     col = unlist(col.main), labels = NA) 
} 

par(mfrow = c(1,2), mar = c(0,4,0,4)) 
with(browsers, 
    donuts(share, browser, sprintf('%s: %s%%', version, share), 
      col = c('cyan2','red','orange','green','dodgerblue2')) 
) 

with(mtcars, 
    donuts(mpg, interaction(gear, cyl), rownames(mtcars)) 
) 

enter image description here


Original post

Voi ragazzi non avete givemedonutsorgivemedeath funzione? La grafica di base è sempre la strada da percorrere per cose molto dettagliate come questa. Non potevo pensare ad un modo elegante per tracciare le etichette della torta centrale, però.

givemedonutsorgivemedeath('~/desktop/donuts.pdf') 

Mi dà

enter image description here

Si noti che in ?pie vedete

Pie charts are a very bad way of displaying information. 

codice:

browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L, 
    2L, 1L, 5L, 5L, 4L), .Label = c("Chrome", "Firefox", "MSIE", 
    "Opera", "Safari"), class = "factor"), version = structure(c(5L, 
    6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("Chrome 10.0", 
    "Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0", 
    "MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"), 
    class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58, 
    13.12, 5.43, 9.91, 1.42, 4.55, 1.65), ymax = c(10.85, 18.2, 51.26, 
    54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73), ymin = c(0, 
    10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 
    90.08)), .Names = c("browser", "version", "share", "ymax", "ymin"), 
    row.names = c(NA, -11L), class = "data.frame") 

browsers$total <- with(browsers, ave(share, browser, FUN = sum)) 

givemedonutsorgivemedeath <- function(file, width = 15, height = 11) { 
    ## house keeping 
    if (missing(file)) file <- getwd() 
    plot.new(); op <- par(no.readonly = TRUE); on.exit(par(op)) 

    pdf(file, width = width, height = height, bg = 'snow') 

    ## useful values and colors to work with 
    ## each group will have a specific color 
    ## each subgroup will have a specific shade of that color 
    nr <- nrow(browsers) 
    width <- max(sqrt(browsers$share))/0.8 

    tbl <- with(browsers, table(browser)[order(unique(browser))]) 
    cols <- c('cyan2','red','orange','green','dodgerblue2') 
    cols <- unlist(Map(rep, cols, tbl)) 

    ## loop creates pie slices 
    plot.new() 
    par(omi = c(0.5,0.5,0.75,0.5), mai = c(0.1,0.1,0.1,0.1), las = 1) 
    for (i in 1:nr) { 
    par(new = TRUE) 

    ## create color/shades 
    rgb <- col2rgb(cols[i]) 
    f0 <- rep(NA, nr) 
    f0[i] <- rgb(rgb[1], rgb[2], rgb[3], 190/sequence(tbl)[i], maxColorValue = 255) 

    ## stick labels on the outermost section 
    lab <- with(browsers, sprintf('%s: %s', version, share)) 
    if (with(browsers, share[i] == max(share))) { 
     lab0 <- lab 
    } else lab0 <- NA 

    ## plot the outside pie and shades of subgroups 
    pie(browsers$share, border = NA, radius = 5/width, col = f0, 
     labels = lab0, cex = 1.8) 

    ## repeat above for the main groups 
    par(new = TRUE) 
    rgb <- col2rgb(cols[i]) 
    f0[i] <- rgb(rgb[1], rgb[2], rgb[3], maxColorValue = 255) 

    pie(browsers$share, border = NA, radius = 4/width, col = f0, labels = NA) 
    } 

    ## extra labels on graph 

    ## center labels, guess and check? 
    text(x = c(-.05, -.05, 0.15, .25, .3), y = c(.08, -.12, -.15, -.08, -.02), 
     labels = unique(browsers$browser), col = 'white', cex = 1.2) 

    mtext('Browser market share, April 2011', side = 3, line = -1, adj = 0, 
     cex = 3.5, outer = TRUE) 
    mtext('stackoverflow.com:::maryam', side = 3, line = -3.6, adj = 0, 
     cex = 1.75, outer = TRUE, font = 3) 
    mtext('/questions/26748069/ggplot2-pie-and-donut-chart-on-same-plot', 
     side = 1, line = 0, adj = 1.0, cex = 1.2, outer = TRUE, font = 3) 
    dev.off() 
} 

givemedonutsorgivemedeath('~/desktop/donuts.pdf') 

Edit 1

width <- 5 

tbl <- table(browsers$browser)[order(unique(browsers$browser))] 
col.main <- Map(rep, seq_along(tbl), tbl) 
col.sub <- lapply(col.main, function(x) 
    Vectorize(adjustcolor)(x, alpha.f = seq_along(x)/length(x))) 

plot.new() 

par(new = TRUE) 
pie(browsers$share, border = NA, radius = 5/width, 
    col = unlist(col.sub), labels = browsers$version) 

par(new = TRUE) 
pie(browsers$share, border = NA, radius = 4/width, 
    col = unlist(col.main), labels = NA) 
+1

Questa è una parte del pacchetto rawr ??? Molto bella.+1 – jazzurro

+0

forse presto. è difficile generalizzare cose come questa – rawr

+0

Inizialmente pensavo di avere questo nel tuo pacchetto! Questo grafico è fantastico. – jazzurro

5

ho creato un generale funzione ciambelle impiego trama per fare questo, che potrebbe

  • Draw anello trama, cioè disegnare grafico a torta per panel e colorare ciascun settore circolare data percentuale pctr e colors cols. La larghezza dell'anello può essere regolata da outradius>radius>innerradius.
  • Sovrapporre più plot di suoneria.

La funzione principale in realtà disegna un grafico a barre e lo piega in un anello, quindi è qualcosa tra un grafico a torta e un grafico a barre.

Esempio grafico a torta, due anelli:

Pie 1

browser grafico a torta

Pie 2

donuts_plot <- function(
         panel = runif(3), # counts 
         pctr = c(.5,.2,.9), # percentage in count 
         legend.label='', 
         cols = c('chartreuse', 'chocolate','deepskyblue'), # colors 
         outradius = 1, # outter radius 
         radius = .7, # 1-width of the donus 
         add = F, 
         innerradius = .5, # innerradius, if innerradius==innerradius then no suggest line 
         legend = F, 
         pilabels=F, 
         legend_offset=.25, # non-negative number, legend right position control 
         borderlit=c(T,F,T,T) 
         ){ 
    par(new=add) 
    if(sum(legend.label=='')>=1) legend.label=paste("Series",1:length(pctr)) 
    if(pilabels){ 
     pie(panel, col=cols,border = borderlit[1],labels = legend.label,radius = outradius) 
    } 
    panel = panel/sum(panel) 

    pctr2= panel*(1 - pctr) 
    pctr3 = c(pctr,pctr) 
    pctr_indx=2*(1:length(pctr)) 
    pctr3[pctr_indx]=pctr2 
    pctr3[-pctr_indx]=panel*pctr 
    cols_fill = c(cols,cols) 
    cols_fill[pctr_indx]='white' 
    cols_fill[-pctr_indx]=cols 
    par(new=TRUE) 
    pie(pctr3, col=cols_fill,border = borderlit[2],labels = '',radius = outradius) 
    par(new=TRUE) 
    pie(panel, col='white',border = borderlit[3],labels = '',radius = radius) 
    par(new=TRUE) 
    pie(1, col='white',border = borderlit[4],labels = '',radius = innerradius) 
    if(legend){ 
     # par(mar=c(5.2, 4.1, 4.1, 8.2), xpd=TRUE) 
     legend("topright",inset=c(-legend_offset,0),legend=legend.label, pch=rep(15,'.',length(pctr)), 
       col=cols,bty='n') 
    } 
    par(new=FALSE) 
} 
## col- > subcor(change hue/alpha) 
subcolors <- function(.dta,main,mainCol){ 
    tmp_dta = cbind(.dta,1,'col') 
    tmp1 = unique(.dta[[main]]) 
    for (i in 1:length(tmp1)){ 
     tmp_dta$"col"[.dta[[main]] == tmp1[i]] = mainCol[i] 
    } 
    u <- unlist(by(tmp_dta$"1",tmp_dta[[main]],cumsum)) 
    n <- dim(.dta)[1] 
    subcol=rep(rgb(0,0,0),n); 
    for(i in 1:n){ 
     t1 = col2rgb(tmp_dta$col[i])/256 
     subcol[i]=rgb(t1[1],t1[2],t1[3],1/(1+u[i])) 
    } 
    return(subcol); 
} 
### Then get the plot is fairly easy: 
# INPUT data 
browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L, 
               2L, 1L, 5L, 5L, 4L), 
               .Label = c("Chrome", "Firefox", "MSIE","Opera", "Safari"),class = "factor"), 
          version = structure(c(5L,6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), 
               .Label = c("Chrome 10.0", "Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", 
                  "MSIE 7.0","MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"), 
               class = "factor"), 
          share = c(10.85, 7.35, 33.06, 2.81, 1.58,13.12, 5.43, 9.91, 1.42, 4.55, 1.65), 
          ymax = c(10.85, 18.2, 51.26,54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73), 
          ymin = c(0,10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53,90.08)), 
         .Names = c("browser", "version", "share", "ymax", "ymin"), 
         row.names = c(NA, -11L), class = "data.frame") 
## data clean 
browsers=browsers[order(browsers$browser,browsers$share),] 
arr=aggregate(share~browser,browsers,sum) 
### choose your cols 
mainCol = c('chartreuse3', 'chocolate3','deepskyblue3','gold3','deeppink3') 
donuts_plot(browsers$share,rep(1,11),browsers$version, 
     cols=subcolors(browsers,"browser",mainCol), 
     legend=F,pilabels = T,borderlit = rep(F,4)) 
donuts_plot(arr$share,rep(1,5),arr$browser, 
     cols=mainCol,pilabels=F,legend=T,legend_offset=-.02, 
     outradius = .71,radius = .0,innerradius=.0,add=T, 
     borderlit = rep(F,4)) 
###end of line 
Problemi correlati