geom_christmas_tree(): a new geom for ggplot2 v2.0

December 17, 2015
By

(This article was first published on SmarterPoland.pl » PISA in English, and kindly contributed to R-bloggers)

iris2
Version 2.0 of the ggplot2 package (on GitHub) has a very nice mechanism for adding new geoms and stats (more about it here).
Christmas are coming, so maybe one would like to make his plots more tree’ish?
Below you will find a definition of geom_christmas_tree() geom. It supports following aesthetics: size (number of segments), fill, color, x and y.

With mpg data you can plot a colourful forest.

ggplot(mpg, aes(displ, hwy, fill=manufacturer)) + 
  geom_christmas_tree(size=2)

cars

With iris dataset you can plot three hills and few trees.

ggplot(iris, aes(x=Sepal.Length, y=Petal.Length)) + 
  stat_density_2d(aes(color=Species)) +
  geom_christmas_tree(aes(size=Petal.Length, fill=Species)) + 
  theme_void() + theme(legend.position="none")

iris2

Here is the full definition of the geom_christmas_tree() geom (tested with ggplot2 v2.0).

GeomChristmasTree <- ggproto("GeomChristmasTree", Geom,
     required_aes = c("x", "y"),
     default_aes = aes(shape = 19, colour = "black", 
         fill = "green4", size = 3,
         linetype = 1, alpha = 1,
         fontsize = 1),
     draw_key = draw_key_polygon,
     
     draw_panel = function(data, panel_scales, coord) {
       coords <- coord$transform(data, panel_scales)
       
       # each tree has 4*branches + 3 points
       if (length(coords$size) == 1) {
         tsize <- rep(pmax(1, round(coords$size)), length(coords$x))
         theight <- rep(pmax(0, round(coords$size)), length(coords$x))
       } else {
         tsize <- pmax(1, round(coords$size))
         theight <- pmax(0, coords$size)
       }

       # scale factors
       r01x <- diff(range(coords$x))/100
       r01y <- diff(range(coords$y))/100
       
       # coords
       longx <- unlist(lapply(seq_along(coords$x), function(i) {
         if (tsize[i] == 1) {
           dx <- -c(0.3, 0.3, 1.2, 0, -1.2, -0.3, -0.3)
         } else {
           dx <- -c(0.3, 0.3, rep(c(1.2,0.3), tsize[i]-1), 1.2, 0, -1.2, rep(c(-0.3,-1.2), tsize[i]-1), -0.3, -0.3)
         }
         r01x*dx + coords$x[i]
       }))
       longy <- unlist(lapply(seq_along(coords$y), function(i) {
         if (tsize[i] == 1) {
           dy <- c(-0.5, 0, 0, theight[i], 0, 0, -0.5)
         } else {
           dy <- c(-0.5, 0, 0, rep(1:(tsize[i]-1), each=2), theight[i], rep((tsize[i]-1):1, each=2), 0, 0, -0.5)
         }
         r01y*dy + coords$y[i]
       }))
       longid <- unlist(sapply(seq_along(coords$y), function(i) {
         rep(i, each=4*tsize[i]+3)
       }))
       
       grid::polygonGrob(
         longx, 
         longy,
         id = longid,
         gp = grid::gpar(col = coords[,"colour"],
                         fill = coords[,"fill"],
                         fontsize = 10)
       )
     }
)

geom_christmas_tree <- function(mapping = NULL, data = NULL, stat = "identity",
                              position = "identity", na.rm = FALSE, show.legend = NA, 
                              inherit.aes = TRUE, ...) {
  layer(
    geom = GeomChristmasTree, mapping = mapping,  data = data, stat = stat, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

Btw: you still have four days to submit your chRistmas tRee.

To leave a comment for the author, please follow the link and comment on their blog: SmarterPoland.pl » PISA in English.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)