【ggplot2】绘图radical stacked bar chart

今天花一天时间画了一张图:先上成品

Screen Shot 2017-02-24 at 8.09.25 PM.png

代码参考:http://stackoverflow.com/questions/24872193/circular-stacked-bar-plot-in-r
主要思路不变,分7个步骤,

Step0: perapare data

family item score time value
X1 Morris 1 0 x1.before 7.608795e-01
X2 Morris 2 0 x2.before 9.588929e-01
X11 Morris 1 1 x1.before 1.000000e+00
X21 Morris 2 1 x2.before 9.376825e-01
X12 Morris 3 0 x1.after 2.149399e-17
X22 Morris 4 0 x2.after 9.684344e-01
X13 Morris 3 1 x1.after 1.701453e-01
X23 Morris 4 1 x2.after 9.376825e-01
9 Sobol 5 2 x1.before 2.354235e-01
10 Sobol 6 2 x2.before -1.742957e-03
11 Sobol 5 3 x1.before 3.170810e-01
12 Sobol 6 3 x2.before 4.438829e-01
13 Sobol 7 2 x1.after 7.974484e-03
14 Sobol 8 2 x2.after 7.974484e-03
15 Sobol 7 3 x1.after 8.259899e-02
16 Sobol 8 3 x2.after 9.094265e-01
17 HSIC 9 4 x1.before 1.000000e+00
18 HSIC 10 4 x2.before 1.748387e-01
19 HSIC 11 4 x1.after 2.018042e-01
20 HSIC 12 4 x2.after 3.706424e-01

step1: 定义stacked bar chart,y从1开始到0, 重叠bar的顺序是先小bar再大bar
Step2.1: 定义白色刻度线位置,最大间隔由nguides决定
Step2.2: 定义刻度数值
Step3: 定义每个item的标签label,旋转角度由函数确定
Step4: 定义类标签(family),角度同样由旋转函数确定
Step5: 由二维坐标变为极坐标
Step6:通过scale_fill_brewer()定义legend和色带
Step7: 修改背景、坐标、legend等theme

全部代码如下:

binSize=1
spaceBar=0.05
spaceItem=0.2
spaceFamily=1.2
innerRadius=0.3
outerRadius=1
nguides=5##刻度的最大间隔数
alphaStart=-0.3
circleProportion=0.8
direction="inwards"
familyLabels=TRUE
itemSize=3
legLabels=NULL
legTitle="Source"
require(ggplot2)
require(plyr)
guides=pretty(range(c(0, df$value)), n=nguides, min.n=2)
# 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
M <- nlevels(factor(df$score))
vMax <- max(df$value)

guides <- guides[guides < vMax]
guides <- guides[guides >= 0]
#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")))

###step1: 定义stacked bar chart,y从1开始到0, 重叠bar的顺序是先小bar再大bar
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=(length(ymax)==1 ? 1 : c(1,ymax[1:(length(ymax)-1)])))
df<-ddply(df,.(item),mutate,ymin=c(1,ymax[-length(ymax)]))

###Step2.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=factor(score))
 # position = "identity"
)

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

###Step2.2: 定义刻度数值
# 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)
}

###Step3: 定义每个item的标签label
dfItemLabels<-ddply(df,.(item),summarize,xmin=xmin[1])
dfItemLabels<-within(dfItemLabels,{
  #x <- xmin +  M * (binSize + spaceBar)/2
  x <- xmin+(binSize + spaceBar)/2
  #angle <- readableAngle(xmin +  M * (binSize + spaceBar)/2)
  #hjust <- readableJustification(xmin +  M * (binSize + spaceBar)/2)
  angle <- readableAngle(xmin +   (binSize + spaceBar)/2)
  hjust <- readableJustification(xmin +   (binSize + spaceBar)/2)
  item<-df$time[c(seq(1,(length(df$time)-4),2),c(17:20))]
})

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

###Step4: 定义类标签(family)
# 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,
    y=2,
    size=5)
}  

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

###Step5: 由二维坐标变为极坐标
# project to polar coordinates
p<-p+coord_polar(start=alphaStart)

###Step6:通过scale_fill_brewer()定义legend和色带
# nice colour scale
#if(is.null(legLabels)) legLabels <- levels(df$score)
#names(legLabels) <- levels(df$score)
if(is.null(legLabels)) legLabels <- c('sigma','mu.star','interaction','main','HSIC')
names(legLabels) <- levels(factor(df$score))
p<-p+scale_fill_brewer(name=legTitle, palette='Set1',type='qual', labels=legLabels)

###Step7: 修改背景、坐标、legend等theme
# empty background and remove guide lines, ticks and labels
p<-p+theme(
  #panel.background=theme_bw(),
  axis.title.x=element_blank(),
  axis.title.y=element_blank(),
  #panel.grid.major=element_blank(),
  #panel.grid.minor=element_blank(),
  axis.text.x=element_blank(),
  axis.text.y=element_blank(),
  axis.ticks=element_blank(),
  legend.text=element_text(size=10)
)
p
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,189评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 85,577评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 150,857评论 0 337
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,703评论 1 276
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,705评论 5 366
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,620评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,995评论 3 396
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,656评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,898评论 1 298
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,639评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,720评论 1 330
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,395评论 4 319
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,982评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,953评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,195评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 44,907评论 2 349
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,472评论 2 342

推荐阅读更多精彩内容

  • (转自http://www.douban.com/group/topic/14820131/,转自人大论坛) 调整...
    f382b3d9bdb3阅读 10,215评论 0 8
  • 来源: http://www.douban.com/group/topic/14820131/ 调整变量格式: f...
    MC1229阅读 6,907评论 0 5
  • 丑陋的躯壳 充盈的心灵 贫乏的物质 轻盈的心情 残缺的精神 丰盈的信仰​​ 一个上扬的嘴角,让我富足​一整日 柠檬...
    仙仙的鱼腥草阅读 300评论 4 2
  • 08年初夏,与广告没有半毛钱关系、新闻学专业的我,机缘巧合误打误撞地进入了全国性广告业行业组织。原因只有一...
    女神二号阅读 437评论 0 3