R中的圆形堆积条形图

Question

我碰到这个真棒和相对简单的包在这里看到 ，它可以创建极坐标形式美丽的标准化叠置条曲线像这样 。 我希望创建一个类似的情节，但这不是规范化的，而是可以将原始值作为输入。

在他的博客上，他表示有人制作了他的代码的非规范化版本，可以生成如下图：

这几乎就是我所需要的，但是我无法弄清楚如何堆叠条形以产生这样的图形（对不起质量）：

这是一些玩具数据，它是我将使用的真实数据的一个子集，并遵循他的输入格式：

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

可以在此处找到他公开提供的包裹代码的直接链接。

非常感谢，本

编辑：这是我试过的 -

我进入代码并替换：

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

有：

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

我这样做是因为据我所知，没有简单的方法可以使用geom_rect生成堆积条，当我尝试使用polarBarChart脚本的上下文时，它将绘制堆积条形图，但是从中心产生而不是从外面进入。此外，当我在polarBarChart脚本中使用这段代码时，我收到以下错误：

“Error: Discrete value supplied to continuous scale” 

没有输出

Answer 1

为了完成这项工作，你必须使用geom_rect（）。 只是不可能修改geom_bar（）来做你需要的极性geom_bar（）创建一个玫瑰图。 因此，为了使数据向内而不是向外绘制，geom_rect（）是唯一的选择（我知道ggplot2）。

我将重点介绍我首先做出的更改，显示情节，然后最后我将整个功能包括在内。

我修改了计算xmin，xmax，ymin和ymax的代码块，如下所示：

xmin是：

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

xmin现在是：

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

我删除了(indexScore-1) *和M *因为这些是每个分数的条形位置彼此相邻的位置。 在每个项目中，我们希望它们位于相同的x位置。

ymin是：

ymin <- affine(1)

ymin现在：

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

我们希望每个项目中每个条形的ymin从它之前的条形的ymax开始。 为了实现这一点，我首先对数据框进行了排序，以便在每个项目中，值的顺序从最低到最高。 然后，对于每个项目，我将ymin设置为1表示最低值，然后设置为前一个条目的ymax表示所有其他值。

我也做了一些苦修。 在家庭标签部分，我将y=1.2更改为y=1.7因为您的商品标签很长，因此家庭标签因此位于其上。 我还添加了hjust=0.5来使它们居中并且vjust=0因此它们不是那么接近项目标签。 结果，这一行：

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

就是现在：

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

因此标签适合绘图区域。

最后，这一行：

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

就是现在：

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

这使得家庭标签在每个组中居中。

这是它的样子：

这是整个功能（最新版本见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
  }