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
  }