今天花一天时间画了一张图:先上成品
代码参考: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