Again on polar/star/pie charts
[This article was first published on gRaphics!, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Haven’t had much time to devote to new visualisations, mostly because work and baby have taken the precedence.Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
But I just wanted to take a few minutes to share the latest version of the script I showed last time.
It now saves to a pdf file, but that’s not the largest change. I actually included one more slice which is obtained from the others with a formula (e.g. average, or geometrical mean, in this case the sum) and is used to rank the pies accordingly. The new value is represented as a white wedge on top of everything else, with its value pasted over it. The script wraps compounds and fit only a limited number per page, then moves on to the next one
There are a lot of things which may be changed, such as having the value as a bubble at the centre rather than a new wedge, to conserve the pies’ proportionality… Or just showing the ‘score’ in a corner of the plot, with other info at the bottom… None of this is implemented as of yet, sorry. The code commented-out shows some graphics alternatives which I did try and set aside for the moment.
Code follows:
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| require(ggplot2) | |
| require(reshape) | |
| # windows() | |
| getRandString<-function(len=12) return(paste(sample(c(LETTERS,letters),len,replace=TRUE),collapse='')) | |
| cpd_name_len<-8 | |
| descr_name_len<-3 | |
| # let's create a dummy set | |
| nvars<-4; varnames <- as.character(lapply(X=rep(descr_name_len,times=nvars), FUN=getRandString)) # the number and names of the variables | |
| ncpd<-25; cpd_x_row<-5; rows_x_page<-6; cpd_x_page<-cpd_x_row*rows_x_page | |
| cpdnames <- as.character(lapply(X=rep(cpd_name_len,times=ncpd), FUN=getRandString)) # the number and name of item (in my case compounds) | |
| facet_font_size<-if(max(length(cpdnames)) < 12) 8 else 4 | |
| # a matrix filled with pseudorandom gibberish | |
| MyMatrx<-matrix(ncol=nvars,nrow=ncpd,data=sample(5, repl=T, size=ncpd*nvars)) | |
| rownames(MyMatrx)<-cpdnames; colnames(MyMatrx)<-varnames | |
| # Reorder the matrix by sum of columns - in an attempt of plotting first 'full' pies, then emptier ones | |
| # MyMatrx<-MyMatrx[rev(order(rowSums(MyMatrx))),] # this works, but plotting order is unaltered... | |
| MyMatrx<-cbind(A00=exp(apply(apply(MyMatrx,c(1,2),log),1,mean)), MyMatrx) # dding the sum in... | |
| MyMatrx<-MyMatrx[rev(order(MyMatrx[,'A00'])),] # this works, but plotting order is unaltered... | |
| # now melt your dataframe so as to be amenable to plotting as bargraph (of which piechart are but a subset) | |
| DF <- melt(MyMatrx, varnames=c('cpd','variable')) | |
| DF$variable<-relevel(DF$variable, 'A00') # reorders the levels so that A00 is first | |
| DF$main<-'component'; DF$main[DF$variable=="A00"]<-'main'; | |
| DF$cpd <- factor(DF$cpd, levels=row.names(MyMatrx)) | |
| DF<-DF[order(DF$cpd),] # reordering in the hope that it will keep all of a compound records together | |
| # # let's now print out a series of Vlaaivis, faceted according to each compound - that is, one Vlaaivis x compound. | |
| # p1<-ggplot(DF, aes(factor(variable), value, fill = factor(variable))) + geom_bar(width = 1, alpha=0.5) + scale_y_continuous(breaks = 0:10) + coord_polar() + labs(x = "", y = "") + opts(legend.position = "none", axis.text.y = theme_blank(), axis.ticks = theme_blank()) + facet_wrap( ~ cpd, ncol = 5) | |
| # # It works!!! (Albeit not perfectly) | |
| # pdf(sprintf("%s.%s","C:/Users/LucaF/Documents/My Dropbox/Vlaaivis",'pdf'), onefile=T, width=8,height=12, useDingbats=F); | |
| # print(p1); | |
| # # savePlot("C:/Users/LucaF/Documents/My Dropbox/Vlaaivis.png",type='png') | |
| # dev.off() | |
| pdf(sprintf("%s.%s",file.path(Sys.getenv("USERPROFILE"),"Documents/My Dropbox/Vlaaivis"),'pdf'), onefile=T, width=8,height=12, useDingbats=F); | |
| cpd_starts<-seq(1,ncpd,by=cpd_x_page) | |
| for (pagina in 1:(ceiling(ncpd/cpd_x_page))) { | |
| inizio<-min(nrow(DF),cpd_starts[pagina]*(nvars+1)-((nvars+1)-1)); | |
| fine<-min(nrow(DF),cpd_starts[pagina]*(nvars+1)+(nvars+1)*cpd_x_page-(nvars+1)) | |
| sliceseq<-(inizio):(fine); sliceseq<-sliceseq[which(sliceseq<=nrow(DF))] | |
| print(Slice<-DF[sliceseq,]) | |
| # let's now print out a series of Vlaaivis, faceted according to each compound - that is, one Vlaaivis x compound. | |
| # version 1: one wedge, almost touching, black outline, opaque filling... | |
| # p1<-ggplot(Slice, aes(factor(variable), sqrt(value), fill = factor(variable))) + geom_bar(width = .95, alpha=1, col='black') + scale_y_continuous(breaks = 0:10) + coord_polar() + labs(x = "", y = "") + opts(legend.position = "top", axis.text.x = theme_blank(), axis.text.y = theme_blank(), axis.ticks = theme_blank()) + facet_wrap( ~ cpd, ncol = cpd_x_row) | |
| # version 2: a bit fuzzied up by different bin widths... | |
| # p1<-ggplot(Slice, aes(factor(variable), sqrt(value), fill = factor(variable))) + geom_bar(width = jitter(rep(.9, 5), factor=10), alpha=.3) + scale_y_continuous(breaks = 0:10) + coord_polar() + labs(x = "", y = "") + opts(legend.position = "none", axis.text.y = theme_blank(), axis.ticks = theme_blank()) + facet_wrap( ~ cpd, ncol = cpd_x_row) | |
| # version 3: fuzzied up both on the x and the y axes | |
| # p1<-ggplot(Slice) | |
| # for (n in 1:10) { | |
| # p1<-p1 + geom_bar(aes(factor(variable), sqrt(jitter(value, factor=10)), fill = factor(variable)), width = jitter(rep(.9, 10), factor=10), alpha=.01) | |
| # } | |
| # p1<-p1 + scale_y_continuous(breaks = 0:10) + coord_polar() + labs(x = "", y = "") + opts(legend.position = "top", axis.text.x = theme_blank(), axis.text.y = theme_blank(), axis.ticks = theme_blank()) + facet_wrap( ~ cpd, ncol = cpd_x_row) | |
| # version 4: not sure yet | |
| Slice_main<-Slice[Slice$main=='main',] | |
| Slice_othr<-Slice[Slice$main!='main',] | |
| p1<-ggplot() | |
| for (n in 1:2) { | |
| if (n==1) p1<-p1 + geom_bar(data=Slice_main, aes(factor(variable), value), width = 1, alpha=1, fill = 'white', col='black') + geom_text(data=Slice_main, aes(x=factor(variable), y=2*sqrt(value)/3, label=round((value))), size=3) | |
| if (n!=1) p1<-p1 + geom_bar(data=Slice_othr, aes(factor(variable), (value), fill = factor(variable)), col='black', lwd=0.1, width = 1, alpha=.5) | |
| } | |
| p1<-p1 + scale_y_sqrt(limits=c(0,max(DF$value))) + labs(x = "", y = "") + opts(legend.position = "top", axis.text.y = theme_blank(), axis.text.x = theme_blank(), axis.ticks = theme_blank()) + coord_polar(start=-pi/(nvars+1)) | |
| #p1<-p1 + facet_grid(cpd ~ main) | |
| p1<-p1 + facet_wrap(~ cpd, ncol=cpd_x_row) + opts(strip.text.x = theme_text(size = facet_font_size)) | |
| # It works!!! (Albeit not perfectly) | |
| print(p1); | |
| } | |
| dev.off() |
To leave a comment for the author, please follow the link and comment on their blog: gRaphics!.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.