Skip to content

Instantly share code, notes, and snippets.

@gufodotto
Created May 28, 2012 13:49
Show Gist options
  • Save gufodotto/2819307 to your computer and use it in GitHub Desktop.
Save gufodotto/2819307 to your computer and use it in GitHub Desktop.
Vlaaivis.R (V2)
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()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment