"scale" or "ruler" type plot in r
Quite long solution using ggplot2
library.
First modified your data frame - repeated each element of names
and height
according to times of 0.2 occurs in height of bar.
myd <- data.frame (names = c(rep("A",floor(2.1/0.2)), rep("B",floor(3.5/0.2)), rep("C",floor(3.5/0.2)), rep("D",floor(1.5/0.2))), height = c(rep(2.1,floor(2.1/0.2)), rep(3.5,floor(3.5/0.2)), rep(3.5,floor(3.5/0.2)), rep(1.5,floor(1.5/0.2))))
ystart
and yend
are y coordinates of small ticks, calculated as sequence by 0.2 for each bar. xstart
is x coordinates of small ticks. Here I assume that bars will be 0.5 wide. If width is smaller or larger then coordinates should be changed. xend
is calculated assuming that ticks are 0.1 wide.
ystart<-c(seq(0.2,2.1,0.2),seq(0.2,3.5,0.2),seq(0.2,3.5,0.2),seq(0.2,1.5,0.2))yend=ystartxstart<-c(rep(0.75,floor(2.1/0.2)),rep(1.75,floor(3.5/0.2)),rep(2.75,floor(3.5/0.2)),rep(3.75,floor(1.5/0.2)))xend<-xstart+0.1
New values added to data frame.
myd <-data.frame(myd,ystart,yend,xstart,xend) p <- ggplot(myd, aes(factor(names), height,fill = names)) p <- p + geom_bar(width=0.5) #This line adds small ticks (segments) to bars p <- p + geom_segment(aes(x=xstart,y=ystart,xend=xend,yend=yend)) #This line adds white lines at 1, 2 and 3 p <- p + geom_hline(yintercept=c(1,2,3),color="white",lwd=1.1) #Next two lines removes legend and makes place for text p <- p + guides(fill=FALSE) p <- p + ylim(c(0,4)) #Add numbers over bars p <- p + annotate("text",x=c(1,2,3,4),y=c(2.4,3.8,3.8,1.8),label=c("2.1","3.5","3.5","1.5"),angle=90,fontface="bold",size=5) #Adjustment of appearance to remove guidlines and axis ticks p <- p + theme_bw() p <- p + theme(axis.title=element_blank(), axis.text.y=element_blank(), axis.text.x=element_text(angle=90,face="bold",size=rel(1.5)), axis.ticks=element_blank(), panel.border=element_blank(), panel.grid=element_blank()) print(p)
EDIT - Added solution as function.
Made function ruler.func()
- only argument needed is vector of bar heights. First part of function produces data frame and then the second part makes plot.
ruler.func<-function(gg){seq.list<-list()for(i in 1:length(gg)){ ystart<-seq(0.2,gg[i],0.2) yend<-ystart xstart<-rep(i-0.25,length(ystart)) xend<-xstart+0.1 nam.val<-c(LETTERS[i],rep(NA,length(ystart)-1)) numb.val<-c(gg[i],rep(NA,length(ystart)-1)) seq.list[[i]]<-data.frame(nam.val,numb.val,xstart,xend,ystart,yend)}df<-as.data.frame(do.call(rbind, seq.list))p <- ggplot(df, aes(nam.val))p <- p + geom_bar(aes(y=numb.val,fill=nam.val),stat="identity",width=0.5,color="black",lwd=1.1)+ scale_x_discrete(limits=LETTERS[1:length(gg)])+ geom_segment(aes(x=xstart,y=ystart,xend=xend,yend=yend))+ geom_hline(yintercept=seq(1,max(gg),1),color="white",lwd=1.1)+ guides(fill=FALSE)+ ylim(c(0,max(gg)+0.5))+ annotate("text",x=seq(1,length(gg),1),y=gg+0.5,label=gg,angle=90,fontface="bold",size=rel(6))+ theme_bw()+ theme(axis.title=element_blank(), axis.text.y=element_blank(), axis.text.x=element_text(angle=90,face="bold",size=rel(1.5)), axis.ticks=element_blank(), panel.border=element_blank(), panel.grid=element_blank())print(p)}
Example with numbers 1.2, 4.6 and 2.8.
ruler.func(c(1.2,4.6,2.8))
My approach to is to customize grid grobs using the grid package. It is post-ggplot2 processing of the plot.I use Grid Low-level functionsto customise by adding some new drawing to the ggplot2 plot. So great advantage here no need to to add data. You can use the code as it.
I think that the mixture of ggplot2 + the grid processing isa powerful tool to customize plots.
#get the viewport (here we do the stuff)library(grid)library(plyr)## grid.edit('geom_rect',gp=gpar(col='black'),grep=T)## get the panel viewportvp1 <- grid.get('panel',grep=T)$wrapvpdepth <- downViewport(name=vp1$name)rects <- grid.get('geom_rect',grep=T)for(i in 1:4){ ## for each axis i create a view port , within it I draw my yaxis vpaxis <- viewport(x = rects$x[i]+rects$width[i], y = rects$y[i], w = 0.005, h = rects$height[i], just=c('left','top'), yscale = c(0,myd$height[i]) ) ## I create the axis, you can customize it using the gp parameter gxa <- yaxisGrob(name='axiss',vp=vpaxis, at = seq(0,myd$height[i],by=0.5), gp=gpar(cex=.8)) grid.draw(gxa)}## I put a blank backgroundgrid.edit('background.rect',grep=T,gp=gpar(fill=NA))###upViewport(depth)
for coordinate floop we use xaxis we change the for loop above by :
for(i in 1:4){vpaxis <- viewport(x = rects$x[i], y = rects$y[i], w = rects$width[i], h = 0, just=c('left','top'), clip=FALSE, xscale = c(0,myd$height[i]),)gxa <- xaxisGrob(name='axiss',vp=vpaxis, at = seq(0,myd$height[i],by=0.5), gp=gpar(cex=.8))grid.draw(gxa)}