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

[This article was first published on SmarterPoland.pl » PISA in English, 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.

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 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.

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)