{"id":688,"date":"2010-02-08T12:21:52","date_gmt":"2010-02-08T11:21:52","guid":{"rendered":"http:\/\/sickel.net\/blogg\/?p=688"},"modified":"2013-02-20T15:00:30","modified_gmt":"2013-02-20T13:00:30","slug":"how-to-make-a-bar-graph-with-a-split-y-axis-in-r","status":"publish","type":"post","link":"https:\/\/sickel.net\/blogg\/?p=688","title":{"rendered":"How to make a bar graph with a split Y axis in R"},"content":{"rendered":"

There is a function, gap.barplot<\/a> for doing that in the plotrix package, but I was not happy with the way the result looked, so I started out making my own way using subplot in the TeachingDemos<\/a> library. I have gutted the two functions I actually used from TeachingDemos to just get the functionality I need for this plot:<\/p>\n

\r\n\r\n# dataset:\r\ndata=data.frame(R=c(120,11),U=c(32,1),C=c(12,3),G=c(4,0),J=c(6,0),I=c(3,2),N=c(4,0))\r\n# I want to plot the lower values up to 55, then a split to 95 for the\r\n# last top. This should make it clear which is the highest, without\r\n# drowning out the other data.\r\n\r\n# I want the split to be approx 5% of the scale,\r\n\r\n# as I am to plot the ranges 0 - 55 and 95 - 140, in total 10 decades, \r\nlower=c(0,55)\r\nupper=c(95,140)\r\n# This is 10 decades. I multiply that with 2 and add 5% and get 21 units on the outer\r\n# Y axis:\r\ny_outer=21\r\n\r\nlowspan=c(0,11)\r\ntopspan=c(lowspan[2]+1,21)\r\n\r\nylabel=\"Number of something\"\r\nlegendtext=c('Group 1','Group 2')\r\n\r\n\r\ncnvrt.coords <-function(x,y=NULL){\r\n# Stolen from the teachingDemos library, simplified for this use case\r\n\txy <- xy.coords(x,y, recycle=TRUE)\r\n\tcusr <- par('usr')\r\n\tcplt <- par('plt')\t\r\n\tplt <- list()\r\n\tplt$x <- (xy$x-cusr[1])\/(cusr[2]-cusr[1])\r\n\tplt$y <- (xy$y-cusr[3])\/(cusr[4]-cusr[3])\r\n\tfig <- list()\r\n\tfig$x <- plt$x*(cplt[2]-cplt[1])+cplt[1]\r\n\tfig$y <- plt$y*(cplt[4]-cplt[3])+cplt[3]\r\n\treturn( list(fig=fig) )\r\n}\r\n\r\nsubplot <- function(fun, x, y=NULL){\r\n# Stolen from the teachingDemos library, simplified for this use case\r\n\told.par <- par(no.readonly=TRUE)\r\n\ton.exit(par(old.par))\r\n\txy <- xy.coords(x,y)\r\n\txy <- cnvrt.coords(xy)$fig\r\n\tpar(plt=c(xy$x,xy$y), new=TRUE)\r\n\tfun\r\n\ttmp.par <- par(no.readonly=TRUE)\r\n\treturn(invisible(tmp.par))\r\n}\r\n\r\n##############################################\r\n#\r\n#\r\n# The main program starts here:\r\n#\r\n#\r\n\r\n# Setting up an outer wireframe for the plots. \r\nplot(c(0,1),c(0,y_outer),type='n',axes=FALSE,ylab=ylabel,xlab='')\r\n# Plotting the lower range in the lower 11\/21 of the plot.\r\n# xpd=FALSE to clip the bars\r\nsubplot(barplot(as.matrix(data),col=heat.colors(2),ylim=lower,xpd=FALSE,las=3),x=c(0,1),y=lowspan)\r\n\r\n\r\n\r\n# Plotting the upper range in the upper 9\/21 of the plot, 1\/21 left to\r\n# the split. Again xpd=FALSE, names.arg is set up to avoid having\r\n# the names plotted here, must be some easier way to do this but\r\n# this works\r\nsubplot(barplot(as.matrix(data),col=heat.colors(2),ylim=upper,xpd=FALSE,names.arg=vector(mode=\"character\",length=length(data))), x=c(0,1),y=topspan)\r\n\r\n# Legend. An annoiance is that the colors comes in the opposite\r\n# order than in the plot.\r\nlegend(\"topright\",legendtext,fill=heat.colors(2))\r\n\r\n# so far so good. (Just run the upper part to see the result so far)\r\n# Just want to make the ends of the axes a bit nicer.\r\n# All the following plots are in units of the outer coordinate system\r\n\r\nlowertop=lowspan[2]+0.1     # Where to end the lower axis\r\nbreakheight=0.5   # Height of the break\r\nupperbot=lowertop+breakheight # Where to start the upper axes\r\nmarkerheight=0.4 # Heightdifference for the break markers\r\nmarkerwidth=.04  # With of the break markers\r\n\r\n# Draw the break markers:\r\nlines(c(0,0),c(1,lowertop))\r\nlines(c(markerwidth\/-2,markerwidth\/2),c(lowertop-markerheight\/2,lowertop+markerheight\/2))\r\nlines(c(0,0),c(upperbot,14))\r\nlines(c(markerwidth\/-2,markerwidth\/2),c(upperbot-markerheight\/2,upperbot+markerheight\/2))\r\n\r\n\r\n\r\n<\/pre>\n
Or download the barplot with split – R code<\/a><\/p>\n
\"Bar<\/p>\n
R is a free software environment for statistical computing and graphics. For more information and download, see http:\/\/www.r-project.org\/<\/a><\/p>\n","protected":false},"excerpt":{"rendered":"
There is a function, gap.barplot for doing that in the plotrix package, but I was not happy with the way the result looked, so I started out making my own way using subplot in the TeachingDemos library. I have gutted … Continue reading →<\/span><\/a><\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_post_was_ever_published":false},"categories":[4,30],"tags":[],"class_list":["post-688","post","type-post","status-publish","format-standard","hentry","category-data","category-r"],"jetpack_featured_media_url":"","jetpack_shortlink":"https:\/\/wp.me\/pnVtD-b6","jetpack_sharing_enabled":true,"jetpack_likes_enabled":true,"jetpack-related-posts":[],"_links":{"self":[{"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/posts\/688","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=688"}],"version-history":[{"count":29,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/posts\/688\/revisions"}],"predecessor-version":[{"id":691,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=\/wp\/v2\/posts\/688\/revisions\/691"}],"wp:attachment":[{"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=688"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=688"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/sickel.net\/blogg\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=688"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}