#' Function to create donut plot which is used to create double pie plot
#' @author Copied from internet and modified
#' @description Function to create donut plot
#' @description Run twice to create double layer pie plot
#' @param panle counts data
#' @param pctr # percentage in count [Default = c(.5,.2,.9)]
#' @param legend.label legend label
#' @param cols colors
#' @param outradius outer radius [Default = 1]
#' @param innerradius innerradius, if innerradius==innerradius then no suggest line [Default= .5]
#' @param radius 1-width of the donus [Default =.7]
#' @param add Add dounut to the current plot [Default = F]
#' @param legend display legend [Default = F]
#' @param pilabels display lables for each section of piece [Default = F]
#' @param legend_offset non-negative number, legend right position control [Default = .25]
#' @param borderlit vector of colors for pie border
#' @param labelcex size for lables
#' @param maintitle title for the plot
#' @import RColorBrewer
#' @examples
#' ### Then get the plot is fairly easy:
#' # INPUT data
#' browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
#' 2L, 1L, 5L, 5L, 4L),
#' .Label = c("Chrome", "Firefox", "MSIE","Opera", "Safari"),class = "factor"),
#' version = structure(c(5L,6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L),
#' .Label = c("Chrome 10.0", "Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0",
#' "MSIE 7.0","MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"),
#' class = "factor"),
#' share = c(10.85, 7.35, 33.06, 2.81, 1.58,13.12, 5.43, 9.91, 1.42, 4.55, 1.65),
#' ymax = c(10.85, 18.2, 51.26,54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73),
#' ymin = c(0,10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53,90.08)),
#' .Names = c("browser", "version", "share", "ymax", "ymin"),
#' row.names = c(NA, -11L), class = "data.frame")
#'## data clean
#' browsers=browsers[order(browsers$browser,browsers$share),]
#' arr=aggregate(share~browser,browsers,sum)
#' ### choose your cols
#' mainCol=c("Blue","Green","Purple","Red","Grey")
#' donuts_plot(browsers$share,rep(1,11),browsers$version,
#' cols=subcolors(browsers,"browser",mainCol),
#' legend=F,pilabels = T,borderlit = rep(F,4) )
#' donuts_plot(arr$share,rep(1,5),arr$browser,
#' cols=mainCol,pilabels=F,legend=T,legend_offset=-.02,
#' outradius = .71,radius = .0,innerradius=.0,add=T,
#' borderlit = rep(F,4) )
#' ###end of line
#'
#' @export
donuts_plot <- function(
panel = runif(3), # counts
pctr = c(.5,.2,.9), # percentage in count
legend.label='',
cols = c('chartreuse', 'chocolate','deepskyblue'), # colors
outradius = 1, # outter radius
radius = .7,
add = F,
innerradius = .5,
legend = F,
pilabels=F,
legend_offset=.25,
borderlit=c(T,F,T,T),
labelcex=1,
maintitle=""
){
par(new=add)
if(sum(legend.label=='')>=1) legend.label=paste("Series",1:length(pctr))
if(pilabels){
pie(panel, col=cols,border = borderlit[1],labels = legend.label,radius = outradius,cex=labelcex,main = maintitle)
}else{
panel = panel/sum(panel)
pctr2= panel*(1-pctr)
pctr3 = c(pctr,pctr)
pctr_indx=2*(1:length(pctr))
pctr3[pctr_indx]=pctr2
pctr3[-pctr_indx]=panel*pctr
cols_fill = c(cols,cols)
cols_fill[pctr_indx]='white'
cols_fill[-pctr_indx]=cols
par(new=TRUE)
pie(pctr3, col=cols_fill,border = borderlit[2],labels = '',radius = outradius)
par(new=TRUE)
pie(panel, col='white',border = borderlit[3],labels = '',radius = radius)
par(new=TRUE)
pie(1, col='white',border = borderlit[4],labels = '',radius = innerradius)
if(legend){
# par(mar=c(5.2, 4.1, 4.1, 8.2), xpd=TRUE)
legend("topright",inset=c(-legend_offset,0),legend=legend.label, pch=rep(15,'.',length(pctr)),
col=cols,bty='n',cex=labelcex)
}
par(new=FALSE)
}
}
#' function to create subclours for each donut
#' create
#' @export
subcolors <- function(.dta,main,mainCol){
tmp_dta = cbind(.dta,1,'col')
tmp1 = unique(.dta[[main]])
for (i in 1:length(tmp1)){
tmp_dta$"col"[.dta[[main]] == tmp1[i]] = mainCol[i]
}
u <- unlist(by(tmp_dta$"1",tmp_dta[[main]],cumsum))
colnames(tmp_dta)[grep(pattern = main,colnames(tmp_dta) )]<- "Category"
us<-ddply(.data = tmp_dta,.(Category),summarise,n=nrow(piece) +1)
n <- dim(.dta)[1]
subcol=rep(rgb(0,0,0),n);
uniq_cat<-unique(tmp_dta$Category)
us<-us[order(us$Category),]
uniq_cat<-uniq_cat[order(uniq_cat)]
for(i in 1: length(uniq_cat)){
pattern<- unique(as.vector(tmp_dta[tmp_dta$Category %in% uniq_cat[i],"col"]))
tmp_dta[tmp_dta$Category %in% uniq_cat[i],"col"] <-rev(colorRampPalette(brewer.pal(paste(mainCol[i],"s",sep = ""),n = 9))(us$n[i])[-1])
}
return(tmp_dta$col);
}
##### ggpie
#dat = data.frame(count=c(10,20, 30,20,10,10), category=c("A", "B", "C","D","E","F"),Onto=c(rep("CC",2),rep("MF",2),rep("BP",2)))
# Add addition columns, needed for drawing with geom_rect.
#dat$fraction = dat$count / sum(dat$count)
#dat = dat[order(dat$fraction), ]
#dat$ymax = cumsum(dat$fraction)
#dat$ymin = c(0, head(dat$ymax, n=-1))
#dat$Onto<- factor(dat$Onto,levels = unique(dat$Onto))
#dat_onto$fraction = dat_onto$count / sum(dat_onto$count)
#dat = dat[order(dat$fraction), ]
#dat$ymax = cumsum(dat$fraction)
#dat$ymin = c(0, head(dat$ymax, n=-1))
# Make the plot
#p1 = ggplot(dat, aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
# geom_rect() +
# coord_polar(theta="y") +
# xlim(c(0, 4)) +
#theme(panel.grid=element_blank()) +
#theme(axis.text=element_blank()) +
#theme(axis.ticks=element_blank()) +
#annotate("text", x = 0, y = 0, label = "My Ring plot !") +
#labs(title="")
#p1
#dat
#count category fraction ymax ymin
#1 10 A 0.1 0.1 0.0
#3 30 C 0.3 0.4 0.1
#2 60 B 0.6 1.0 0.4
#ggplot(dat, aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_rect()
#ggplot(dat, aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_rect() + coord_polar(theta="y")
#ggplot(dat, aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_rect() + coord_polar(theta="y") +xlim(c(0, 4))
#ggplot(dat, aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_rect() + coord_polar(theta="y") +xlim(c(0, 4)) + theme_Publication()
#ggplot(dat, ) + geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3))
#ggplot(dat, ) + geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + coord_polar(theta="y")
#ggplot(dat, ) + geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + xlim(c(0, 4))
#ggplot(dat, ) + geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=1, xmin=2)) +xlim(c(0, 4))
#
#dat$gat<- "GeneOntology"
#dat$gatshare<-1
##dat
#
# ggplot(dat, ) +
# geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
# ggrepel::geom_text_repel(aes(label=category,x=4.5,y=ymin+0.1))+
# geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=2.98, xmin=2)) +
# geom_rect(aes(fill=gat,ymax=1,ymin=0,xmax=1.98,xmin=0),show.legend = FALSE)+
# xlim(c(0, 4.5)) +coord_polar(theta="y") + theme(panel.grid=element_blank()) +
# theme(axis.text=element_blank()) +
# theme(axis.ticks=element_blank())
#
#dat$gat<- "GeneOntology"
#dat$gatshare<-1
#dat
#ggplot(dat) +
#geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
# geom_rect(data = dat_onto,aes(fill=Onto,ymax=ymax, ymin=ymin, xmax=2.99, xmin=1.5))+
# xlim(0,4) + coord_polar(theta = "y")
#dat_onto<- data.frame(count=c(10,20, 30,20,10,10),Onto=c(rep("CC",2),rep("MF",2),rep("BP",2)))
#dat_onto<-ddply(dat_onto,.(Onto),function(x){
# temp<- data.frame(fraction=NA)
# temp$fraction<-sum(x$count)/sum(dat_onto$count)
# temp<-temp[order(temp$fraction)]
# return(temp)
#})
#dat_onto$ymax<-cumsum(dat_onto$fraction)
#dat_onto$ymin<- c(0,head(dat_onto$ymax,n=-1)) #
#ggplot(dat) +
#geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
# geom_rect(data = dat_onto,aes(fill=Onto,ymax=ymax, ymin=ymin, xmax=2.99, xmin=1.5))+
# xlim(0,4) + coord_polar(theta = "y")
#dat = data.frame(count=c(10,20, 30,20,10,10), category=c("A", "B", "C","D","E","F"),Onto=c(rep("CC",2),rep("MF",2),rep("BP",2)))
## sorting under each ontoloy class
## to display large fraction first
#dat<- ddply(dat,.(Onto),function(x)
# x<-x[order(x$count,decreasing = T),])
#dat$fraction <- dat$count/sum(dat$count)
#dat$ymax<- cumsum(dat$fraction)
#dat$ymin<- c(0,head(dat$ymax,n=-1))
#ggplot(dat) +
# geom_rect(data = dat_onto,aes(fill=Onto,ymax=ymax, ymin=ymin, xmax=2.99, xmin=1.5),show.legend = F)+
#geom_text(data = dat_onto,aes(label=Onto,x=2.25,y=(ymin +ymax)/2))+
#geom_rect(aes(fill=category, ymax=ymax, ymin=ymin, xmax=4, xmin=3),show.legend = F) +
#geom_point(data = dat,aes(x =4.1,y = (ymin +ymax)/2),color="white") +
#ggrepel::geom_text_repel(data = dat,aes(label=category,x =4.5,y = (ymin +ymax)/2),
# arrow = arrow(length = unit(0.01, 'npc')))+
#scale_fill_manual(values = scale_color)+
###geom_rect(ymin=0,ymax=1,xmin=0,xmax=1.49,fill="white")+
#xlim(0,5) +
#coord_polar(theta = "y") +
# theme_Publication() +
#annotate("text", x = 0, y = 0, label = "Gene Ontology") +
#theme(axis.title = element_blank(),axis.text = element_blank(),panel.grid = element_blank(),axis.ticks = element_blank())
#currDT <- read.table("~/Downloads/SO_data", sep = "|", header = TRUE, strip.white = TRUE)
##### color schemes
#dat_onto$color<- c("Red","Blue","Purple")
#dat_color<-merge(dat,dat_onto[,c(1,5)],by="Onto")#
#dat_color1<-ddply(dat_color,.(Onto),function(x){
# temp<-x
# col_temp<-colorRampPalette(brewer.pal(n=8,name = paste(unique(x$color),"s",sep="")))(nrow(x)+1)
# temp$color<-col_temp[-1]
# return(temp)
#})
#scale_color<-dat_color1$color
#names(scale_color)<-dat_color1$category
#scale_color
#dat_onto$color_N<-NA
#for(i in 1:nrow(dat_onto)){
#temp_c<- colorRampPalette(brewer.pal(n = 8,name = paste(dat_onto$color[i],"s",sep="")))(8)
#dat_onto$color_N[i]<-temp_c[6]#
#}
#scale_color2<- dat_onto$color_N
#names(scale_color2)<-dat_onto$Onto
#scale_color<-c(scale_color,scale_color2)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.