Circular Stacked Bar Grundstück in R

Question

Ich stieß auf dieses ehrfürchtige und relativ einfache Paket seen here, das schöne normalisierte gestapelte Balkendiagramme in polarer Form like so erstellen kann. Ich hoffe, ein ähnliches Diagramm zu erstellen, aber das ist nicht normalisiert und kann stattdessen rohe Werte als Eingabe haben.

Auf seinem Blog zeigt er, dass jemand eine un-normalisierte Version seines Code gemacht, die Grundstücke wie diese produzieren kann:

Dies ist fast genau das, was ich brauche, aber ich kann nicht herausfinden, wie zu stapeln die Balken eine Grafik zu erzeugen, wie so (sorry für Qualität):

Hier einige Spielzeug-Daten, die eine Teilmenge der realen Daten, die ich verwende und dass folgt sein Eingabeformat:

family item score value 
Group 1 Disease 1 Genetics 1 
Group 1 Disease 1 EMR 8 
Group 1 Disease 1 Pubmed 10 
Group 1 Disease 2 Genetics 1 
Group 1 Disease 2 EMR 21 
Group 1 Disease 2 Pubmed 4 
Group 1 Disease 3 Genetics 0 
Group 1 Disease 3 EMR 2 
Group 1 Disease 3 Pubmed 0 
Group 2 Disease 4 Genetics 4 
Group 2 Disease 4 EMR 72 
Group 2 Disease 4 Pubmed 16 
Group 3 Disease 5 Genetics 2 
Group 3 Disease 5 EMR 19 
Group 3 Disease 5 Pubmed 7 
Group 3 Disease 6 Genetics 2 
Group 3 Disease 6 EMR 12 
Group 3 Disease 6 Pubmed 6 
Group 4 Disease 7 Genetics 0 
Group 4 Disease 7 EMR 11 
Group 4 Disease 7 Pubmed 4 

Ein direkter Link zu dem Paketcode, den er offen bereitstellt, finden Sie unter here.

Vielen Dank, Ben

edit: Hier ist, was ich habe tried-

ich in den Code gingen und ersetzt:

# histograms 
p<-ggplot(df)+geom_rect(
     aes(
      xmin=xmin, 
      xmax=xmax, 
      ymin=ymin, 
      ymax=ymax, 
      fill=score) 
     ) 

mit:

# histograms 
p<-ggplot(df)+ 
     geom_bar(stat="identity", position="stack", aes(x=item, y=value,fill=score)) 

Ich tat dies, weil, soweit ich verstehen konnte, es nicht einfach ist ay des Erzeugens eines gestapelten Balkens mit geom_rect und wenn ich den obigen Code außerhalb des Kontexts des polarBarChart-Skripts ausprobiere, werden gestapelte Balkendiagramme geplottet, aber ausgehend von der Mitte, anstatt aus dem ausgehenden heraus zu kommen. Zusätzlich, wenn ich benutze dieses Stück Code innerhalb des polarBarChart Skript, das ich die folgende Fehlermeldung erhalten:

“Error: Discrete value supplied to continuous scale” 

und keine Ausgabe

Answer 1

um diese Arbeit, die Sie geom_rect() verwenden, müssen zu machen. Es ist einfach nicht möglich, geom_bar() zu modifizieren, um das zu tun, was Sie als Polar benötigen. Daher ist geom_rect() die einzige Option (die mir für ggplot2 bekannt ist), damit die Daten nach innen und nicht nach außen geplottet werden.

Ich werde die Änderungen hervorheben, die ich zuerst gemacht habe, zeige die Handlung an, und dann schließe ich am Ende die gesamte Funktion als geändert ein.

modifiziert I den Block von Code, xmin, xmax, ymin berechnet und ymax, wie folgt:

xmin war:

xmin <- (indexScore - 1) * (binSize + spaceBar) + (indexItem - 1) * (spaceItem + M * (binSize + spaceBar)) + (indexFamily - 1) * (spaceFamily - spaceItem)

xmin ist jetzt:

xmin <- (binSize + spaceBar) + (indexItem - 1) * (spaceItem + (binSize + spaceBar)) + (indexFamily - 1) * (spaceFamily - spaceItem)

Ich entfernte (indexScore-1) * und M * als diese sind, was die Bars fo positionieren r jede Punktzahl nebeneinander. In jedem Artikel wollen wir sie am selben x Ort haben.

ymin war:

ymin <- affine(1)

ymin ist jetzt:

df<-df[with(df, order(family,item,value)), ] df<-ddply(df,.(item),mutate,ymin=c(1,ymax[1:(length(ymax)-1)]))

Wir haben die ymin in jedem Element für jede Bar wollen am ymax der Bar zu starten, die vor ist es. Um dies zu erreichen, ordnete ich zunächst den Datenrahmen so an, dass in jedem Element die Reihenfolge der Werte vom niedrigsten zum höchsten Wert ist. Dann setze ich für jedes Element ymin für den niedrigsten Wert auf 1 und für alle anderen Werte auf ymax des vorherigen Balkens.

Ich machte auch einige asketische Veränderungen. In der Familie Etiketten Abschnitt habe ich y=1.2 zu y=1.7 geändert, weil Ihre Artikel Etiketten lang sind, so dass die Familienetiketten konsequent auf ihnen waren. Ich fügte auch hjust=0.5 hinzu, um sie und vjust=0 zu zentrieren, also sind sie nicht so nah an den Einzelteilaufklebern. Als Ergebnis dieser Linie:

p<-p+ylim(0,outerRadius+0.2)

ist jetzt:

p<-p+ylim(0,outerRadius+0.7)

So werden die Etiketten passen innerhalb der Plotregion.

Schließlich diese Zeile:

familyLabelsDF<-aggregate(xmin~family,data=df,FUN=function(s) mean(s+binSize))

ist jetzt:

familyLabelsDF<-aggregate(xmin~family,data=df,FUN=function(s) mean(s+binSize/2))

Das macht es so die Familie Etiketten in jeder Gruppe zentriert sind. Hier

ist, wie es aussieht:

Und hier ist die ganze Funktion (neueste Version sehen GitHub):

## ============================================================================= 
## Polar BarChart 
## Original Polar Histogram by Christophe Ladroue 
## Source: http://chrisladroue.com/2012/02/polar-histogram-pretty-and-useful/ 
## Modified from original by Christos Hatzis 3.22.2012 (CH) 
## Modified from modified by Christie Haskell 7.25.2014 (CHR) 
## ============================================================================= 
polarBarChart <- 
    function(
    df, 
    binSize=1, 
    spaceBar=0.05, 
    spaceItem=0.2, 
    spaceFamily=1.2, 
    innerRadius=0.3, 
    outerRadius=1, 
    nguides=3, 
    guides=pretty(range(c(0, df$value)), n=nguides, min.n=2), 
    alphaStart=-0.3, 
    circleProportion=0.8, 
    direction="inwards", 
    familyLabels=TRUE, 
    itemSize=3, 
    legLabels=NULL, 
    legTitle="Source"){ 

    require(ggplot2) 
    require(plyr) 

    # ordering 
    df<-arrange(df,family,item,score) 

    # family and item indices 
    df$indexFamily <- as.integer(factor(df$family)) 
    df$indexItem <- with(df, as.integer(factor(item, levels=item[!duplicated(item)])))   
    df$indexScore <- as.integer(factor(df$score)) 

    df<-arrange(df,family,item,score) 

    # define the bins 

    vMax <- max(df$value) 

    guides <- guides[guides < vMax] 
    df$value <- df$value/vMax 

    # linear projection 
    affine<-switch(direction, 
        'inwards'= function(y) (outerRadius-innerRadius)*y+innerRadius, 
        'outwards'=function(y) (outerRadius-innerRadius)*(1-y)+innerRadius, 
        stop(paste("Unknown direction"))) 

    df<-within(df, { 
     xmin <- (binSize + spaceBar) + 
     (indexItem - 1) * (spaceItem + (binSize + spaceBar)) + 
     (indexFamily - 1) * (spaceFamily - spaceItem) 
     xmax <- xmin + binSize 
     ymax <- affine(1 - value) 
    } 
    ) 

    df<-df[with(df, order(family,item,value)), ] 
    df<-ddply(df,.(item),mutate,ymin=c(1,ymax[1:(length(ymax)-1)])) 

    # build the guides 
    guidesDF<-data.frame(
     xmin=rep(df$xmin,length(guides)), 
     y=rep(guides/vMax,1,each=nrow(df))) 

    guidesDF<-within(guidesDF,{ 
     xend<-xmin+binSize+spaceBar 
     y<-affine(1-y) 
    }) 


    # Building the ggplot object 

    totalLength<-tail(df$xmin+binSize+spaceBar+spaceFamily,1)/circleProportion-0 

    # histograms 
    p<-ggplot(df)+geom_rect(
     aes(
     xmin=xmin, 
     xmax=xmax, 
     ymin=ymin, 
     ymax=ymax, 
     fill=score) 
    ) 

    # guides 
    p<-p+geom_segment(
     aes(
     x=xmin, 
     xend=xend, 
     y=y, 
     yend=y), 
     colour="white", 
     data=guidesDF) 

    # label for guides 
    guideLabels<-data.frame(
     x=0, 
     y=affine(1-guides/vMax), 
     label=guides 
    ) 

    p<-p+geom_text(
     aes(x=x,y=y,label=label), 
     data=guideLabels, 
     angle=-alphaStart*180/pi, 
     hjust=1, 
     size=4) 

    # item labels 
    readableAngle<-function(x){ 
     angle<-x*(-360/totalLength)-alphaStart*180/pi+90 
     angle+ifelse(sign(cos(angle*pi/180))+sign(sin(angle*pi/180))==-2,180,0) 
    } 
    readableJustification<-function(x){ 
     angle<-x*(-360/totalLength)-alphaStart*180/pi+90 
     ifelse(sign(cos(angle*pi/180))+sign(sin(angle*pi/180))==-2,1,0) 
    } 

    dfItemLabels<-ddply(df,.(item),summarize,xmin=xmin[1]) 
    dfItemLabels<-within(dfItemLabels,{ 
     x <- xmin + (binSize + spaceBar)/2 
     angle <- readableAngle(xmin + (binSize + spaceBar)/2) 
     hjust <- readableJustification(xmin + (binSize + spaceBar)/2) 
    }) 

    p<-p+geom_text(
     aes(
     x=x, 
     label=item, 
     angle=angle, 
     hjust=hjust), 
     y=1.02, 
     size=itemSize, 
     vjust=0.5, 
     data=dfItemLabels) 

    # family labels 
    if(familyLabels){ 
     #  familyLabelsDF<-ddply(df,.(family),summarise,x=mean(xmin+binSize),angle=mean(xmin+binSize)*(-360/totalLength)-alphaStart*180/pi) 
     familyLabelsDF<-aggregate(xmin~family,data=df,FUN=function(s) mean(s+binSize/2)) 
     familyLabelsDF<-within(familyLabelsDF,{ 
     x<-xmin 
     angle<-xmin*(-360/totalLength)-alphaStart*180/pi 
     }) 

     p<-p+geom_text(
     aes(
      x=x, 
      label=family, 
      angle=angle), 
     data=familyLabelsDF, 
     hjust=0.5, 
     vjust=0, 
     y=1.7) 
    } 

    # empty background and remove guide lines, ticks and labels 
    p<-p+opts(
     panel.background=theme_blank(), 
     axis.title.x=theme_blank(), 
     axis.title.y=theme_blank(), 
     panel.grid.major=theme_blank(), 
     panel.grid.minor=theme_blank(), 
     axis.text.x=theme_blank(), 
     axis.text.y=theme_blank(), 
     axis.ticks=theme_blank() 
    ) 

    # x and y limits 
    p<-p+xlim(0,tail(df$xmin+binSize+spaceFamily,1)/circleProportion) 
    p<-p+ylim(0,outerRadius+0.7) 

    # project to polar coordinates 
    p<-p+coord_polar(start=alphaStart) 

    # nice colour scale 
    if(is.null(legLabels)) legLabels <- levels(df$score) 
    names(legLabels) <- levels(df$score) 
    p<-p+scale_fill_brewer(name=legTitle, palette='Set1',type='qual', labels=legLabels) 

    p 
    }