Outline

Top of document bookkeeping

#Prevent warning and messages from displaying in the pdf of this document
knitr::opts_chunk$set(message = FALSE, warning=FALSE)
#eval=FALSE means this won't be run when I knit my final report of this markdown

install.packages("readr")
install.packages("dplyr")
install.packages("ggplot2")
install.packages("tidyr")
install.packages("cowplot")
install.packages("ggrepel")
install.packages("png")
install.packages("tibble")
install.packages("forcats")

Load packages

library(readr) #For loading data
#library(tidyr) 
library(dplyr) #For transforming data
library(ggplot2) #For plotting data
library(cowplot) #More plotting tools/figure assembly
library(ggrepel) #Useful for labeling points without labels overlapping
library(png) #For putting images in plots
library(tibble) #Make a matrix into a tibble 
library(forcats) #For ordering axes in plots
library(png) #For loading images
library(grid) #For rasterGrob function to put images in plots

#Tell R when to find the external files for this document
setwd("~/advanced_ggplot")

Load color palette to override non-colorblind accessible pastel defaults

#custom palette
palette <- c("#0072B2","#E69F00","#009E24","#FF0000", "#979797","#5530AA")

“Sorry that the figures are hard to read”

Switch text/line size for presentation or paper versions of figures

We’ve all seen it – the presenter apologizing for figures with illegibly small type.

One of the fastest way to ensure a bad presentation is to have figures with text too small for people to read.

By running one or the other of these options before generating figures, you can quickly switch between paper sized text and figures with larger font/line width sizes for presentation

Change desired box to TRUE or FALSE, and run whole script to render figures w/ appropriate scaling

#The paper
theme_set(theme_cowplot(font_size=14))
#The presentation
theme_set(theme_cowplot(font_size=20, line_size=1))

Dataset orientation

This is the description that comes with the ChickWeight dataset, a dataset of growth of chickens over time on different diets - It’s also good practices to make on of these for any dataset you release

The ChickWeight dataset

“Weight versus age of chicks on different diets Description The ChickWeight data frame has 578 rows and 4 columns from an experiment on the effect of diet on early growth of chicks.

weight a numeric vector giving the body weight of the chick (gm).

Time a numeric vector giving the number of days since birth when the measurement was made.

Chick an ordered factor with levels 18 < … < 48 giving a unique identifier for the chick. The ordering of the levels groups chicks on the same diet together and orders them according to their final weight (lightest to heaviest) within diet.

Diet a factor with levels 1, …, 4 indicating which experimental diet the chick received."

data("ChickWeight")
ChickWeight <- as_tibble(ChickWeight) #dataset loads as matrix, but I'd like it be a tidyverse tibble
print(head(ChickWeight))
## # A tibble: 6 × 4
##   weight  Time Chick   Diet
##    <dbl> <dbl> <ord> <fctr>
## 1     42     0     1      1
## 2     51     2     1      1
## 3     59     4     1      1
## 4     64     6     1      1
## 5     76     8     1      1
## 6     93    10     1      1

Add an image to a plot

There are a lot of cases where it’s useful to include an image in a plots. Maybe include a cell morphology picture on a growth curve plot, or add a custom diagram.

Grob stands for Graphical Object

#Load in matrix of image
img <- readPNG("chick_pic.png")

#Images are essentially just large grids of numbers
head(img, 300)
##   [1] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##   [6] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [11] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [16] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [21] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [26] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [31] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [36] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [41] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [46] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [51] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [56] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [61] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [66] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [71] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [76] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [81] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [86] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [91] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
##  [96] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [101] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [106] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [111] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [116] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [121] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [126] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [131] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [136] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [141] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [146] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [151] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [156] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [161] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [166] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [171] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [176] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [181] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [186] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [191] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [196] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [201] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [206] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [211] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [216] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [221] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [226] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [231] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [236] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [241] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [246] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [251] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [256] 0.000000000 0.000000000 0.000000000 0.047058824 0.003921569
## [261] 0.000000000 0.003921569 0.011764706 0.000000000 0.000000000
## [266] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [271] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [276] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [281] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [286] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [291] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [296] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
#Save the matrix as a raster graphical object
#Raster =  A matrix of x and y coordinates
g <- rasterGrob(img, interpolate=TRUE) 
#Now the image is stored in an abject
g
## rastergrob[GRID.rastergrob.1]

As a review of plotting and facetting, I’m going to plot the growth curves of each chicken, divided by the diet they ate, with a picture of a chick.

#Add on an image
ggplot(data=ChickWeight, aes(x=Time, y=weight, group=Chick, color=Diet)) +
     geom_line() + 
     facet_wrap(~Diet, nrow=4) +
     scale_color_manual(values=palette) +
     annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf)

Plots are added in order, so I if put the image first, it goes behind the line plot.

You can also set the position of the object.

ggplot(data=ChickWeight, aes(x=Time, y=weight, group=Chick, color=Diet)) +
     annotation_custom(g, xmin=15, ymin=-Inf, ymax=Inf) +#Choose position of image
     geom_line() + 
     facet_wrap(~Diet, nrow=4) +
     scale_color_manual(values=palette) 

You can switch where the facet label goes as well.

ggplot(data=ChickWeight, aes(x=Time, y=weight, group=Chick, color=Diet)) +
     geom_line() + 
     facet_wrap(~Diet, ncol=1, switch="y") +
     scale_color_manual(values=palette) +
     annotation_custom(g, xmin=15, ymin=-Inf, ymax=Inf)

Demo of composing a more complicated plot

I want to make a plot to show progress of each individual chick over the time course.

I’ve decided that I want one subplot per diet, with both growth strips and line plots of growth over time. These are technically redundant plot, but I want the line plots to show the shape of the data.

It’s very useful to sketch out complex figures before spending time to code them.

sketch

sketch

This is the plan. How to do it with ggplot? Figure composition is not a linear process, so I’ve left in some dead ends and mid-way design choices.

When facetting fails

When you need multiple plots that are essential repeats of each other with different data conditions, the instinct is alway to go to facetting the plot. But faceting has limitations and are only useful up to a point.

#I use as.factor(Time) to make sure missing timepoints like 3,5,7 aren't plotted as blanks

#The growth of each individual chick is one row
ggplot(data=ChickWeight, aes(x=as.factor(Time), y=Chick, fill=weight)) +
     geom_tile() 

#Ok, facet into groups by Diet to get four plots...
ggplot(data=ChickWeight, aes(x=as.factor(Time), y=Chick, fill=weight)) +
     geom_tile()+
     facet_wrap(~Diet, ncol=2)

This fails because facets need to have the same x and y axes and ours have different chick number labels. This also doesn’t even begin to help with the problem of how to get the line plot in.

Facetting is useful in many cases, but it’s doesn’t fit all situations

Instead, I’m going to split the chicks tibble into group by diet, then feed each group into a function to generate the pair of plots.

As a rule, when you find yourself repeating a block of code multiple time with slight variations, it’s best to save it as a function.

Before starting a function, I work out the initial plot design using one diet group.

  • This makes troubleshooting during initial plot design much easier.
diet1 <- ChickWeight %>% filter(Diet == 1)

dietname <- unique(diet1$Diet) 

#The basic setup for the lineplot
lp <- ggplot(data=diet1, aes(x=as.factor(Time), y=weight, group=Chick)) +
     geom_line()  +
     annotate ("text", x = 3, y=200, label=paste("Diet ",dietname, sep=""), color="red", size=5)

#The basic setup for the heatmap
hm <- ggplot(data=diet1, aes(x=as.factor(Time), y=Chick, fill=weight)) +
     geom_tile() 


plot_grid(lp, hm, rel_heights = c(0.5,1), ncol = 1)

A few things to correct -

  1. The heatmap y axis is not in numerical order, so I’ll use fct_inorder from the forcats package to make it be so

    -Axis order is the bane of plotting

  2. There are too much text for my idea of the final plot

  3. The heatmap scalebar makes the plots not aligned

Order of categorical variables

This is is probably one of the more frustrating parts of plotting. Your data is plotted accurated, but the columns or rows are in the wrong order.

Each column in a dataframe that contains categorical (not numeric) has a secondary vector that includes each category in the order that they will be plotted.

I’ll use a new package called forcats, which is tools for getting data plotted in the order you want.

#Check out the Levels part of this vectors -> one ID for each of the 50 chicks
ChickWeight$Chick
##   [1] 1  1  1  1  1  1  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  2  2 
##  [24] 2  3  3  3  3  3  3  3  3  3  3  3  3  4  4  4  4  4  4  4  4  4  4 
##  [47] 4  4  5  5  5  5  5  5  5  5  5  5  5  5  6  6  6  6  6  6  6  6  6 
##  [70] 6  6  6  7  7  7  7  7  7  7  7  7  7  7  7  8  8  8  8  8  8  8  8 
##  [93] 8  8  8  9  9  9  9  9  9  9  9  9  9  9  9  10 10 10 10 10 10 10 10
## [116] 10 10 10 10 11 11 11 11 11 11 11 11 11 11 11 11 12 12 12 12 12 12 12
## [139] 12 12 12 12 12 13 13 13 13 13 13 13 13 13 13 13 13 14 14 14 14 14 14
## [162] 14 14 14 14 14 14 15 15 15 15 15 15 15 15 16 16 16 16 16 16 16 17 17
## [185] 17 17 17 17 17 17 17 17 17 17 18 18 19 19 19 19 19 19 19 19 19 19 19
## [208] 19 20 20 20 20 20 20 20 20 20 20 20 20 21 21 21 21 21 21 21 21 21 21
## [231] 21 21 22 22 22 22 22 22 22 22 22 22 22 22 23 23 23 23 23 23 23 23 23
## [254] 23 23 23 24 24 24 24 24 24 24 24 24 24 24 24 25 25 25 25 25 25 25 25
## [277] 25 25 25 25 26 26 26 26 26 26 26 26 26 26 26 26 27 27 27 27 27 27 27
## [300] 27 27 27 27 27 28 28 28 28 28 28 28 28 28 28 28 28 29 29 29 29 29 29
## [323] 29 29 29 29 29 29 30 30 30 30 30 30 30 30 30 30 30 30 31 31 31 31 31
## [346] 31 31 31 31 31 31 31 32 32 32 32 32 32 32 32 32 32 32 32 33 33 33 33
## [369] 33 33 33 33 33 33 33 33 34 34 34 34 34 34 34 34 34 34 34 34 35 35 35
## [392] 35 35 35 35 35 35 35 35 35 36 36 36 36 36 36 36 36 36 36 36 36 37 37
## [415] 37 37 37 37 37 37 37 37 37 37 38 38 38 38 38 38 38 38 38 38 38 38 39
## [438] 39 39 39 39 39 39 39 39 39 39 39 40 40 40 40 40 40 40 40 40 40 40 40
## [461] 41 41 41 41 41 41 41 41 41 41 41 41 42 42 42 42 42 42 42 42 42 42 42
## [484] 42 43 43 43 43 43 43 43 43 43 43 43 43 44 44 44 44 44 44 44 44 44 44
## [507] 45 45 45 45 45 45 45 45 45 45 45 45 46 46 46 46 46 46 46 46 46 46 46
## [530] 46 47 47 47 47 47 47 47 47 47 47 47 47 48 48 48 48 48 48 48 48 48 48
## [553] 48 48 49 49 49 49 49 49 49 49 49 49 49 49 50 50 50 50 50 50 50 50 50
## [576] 50 50 50
## 50 Levels: 18 < 16 < 15 < 13 < 9 < 20 < 10 < 8 < 17 < 19 < 4 < ... < 48
#Since the chicks are in order in the starting dataframe, I use fct_inorder to reorder the Levels by the order they appear in the dataframe. 
ChickWeight$Chick <- fct_inorder(ChickWeight$Chick)
#Levels all ordered!
ChickWeight$Chick
##   [1] 1  1  1  1  1  1  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  2  2 
##  [24] 2  3  3  3  3  3  3  3  3  3  3  3  3  4  4  4  4  4  4  4  4  4  4 
##  [47] 4  4  5  5  5  5  5  5  5  5  5  5  5  5  6  6  6  6  6  6  6  6  6 
##  [70] 6  6  6  7  7  7  7  7  7  7  7  7  7  7  7  8  8  8  8  8  8  8  8 
##  [93] 8  8  8  9  9  9  9  9  9  9  9  9  9  9  9  10 10 10 10 10 10 10 10
## [116] 10 10 10 10 11 11 11 11 11 11 11 11 11 11 11 11 12 12 12 12 12 12 12
## [139] 12 12 12 12 12 13 13 13 13 13 13 13 13 13 13 13 13 14 14 14 14 14 14
## [162] 14 14 14 14 14 14 15 15 15 15 15 15 15 15 16 16 16 16 16 16 16 17 17
## [185] 17 17 17 17 17 17 17 17 17 17 18 18 19 19 19 19 19 19 19 19 19 19 19
## [208] 19 20 20 20 20 20 20 20 20 20 20 20 20 21 21 21 21 21 21 21 21 21 21
## [231] 21 21 22 22 22 22 22 22 22 22 22 22 22 22 23 23 23 23 23 23 23 23 23
## [254] 23 23 23 24 24 24 24 24 24 24 24 24 24 24 24 25 25 25 25 25 25 25 25
## [277] 25 25 25 25 26 26 26 26 26 26 26 26 26 26 26 26 27 27 27 27 27 27 27
## [300] 27 27 27 27 27 28 28 28 28 28 28 28 28 28 28 28 28 29 29 29 29 29 29
## [323] 29 29 29 29 29 29 30 30 30 30 30 30 30 30 30 30 30 30 31 31 31 31 31
## [346] 31 31 31 31 31 31 31 32 32 32 32 32 32 32 32 32 32 32 32 33 33 33 33
## [369] 33 33 33 33 33 33 33 33 34 34 34 34 34 34 34 34 34 34 34 34 35 35 35
## [392] 35 35 35 35 35 35 35 35 35 36 36 36 36 36 36 36 36 36 36 36 36 37 37
## [415] 37 37 37 37 37 37 37 37 37 37 38 38 38 38 38 38 38 38 38 38 38 38 39
## [438] 39 39 39 39 39 39 39 39 39 39 39 40 40 40 40 40 40 40 40 40 40 40 40
## [461] 41 41 41 41 41 41 41 41 41 41 41 41 42 42 42 42 42 42 42 42 42 42 42
## [484] 42 43 43 43 43 43 43 43 43 43 43 43 43 44 44 44 44 44 44 44 44 44 44
## [507] 45 45 45 45 45 45 45 45 45 45 45 45 46 46 46 46 46 46 46 46 46 46 46
## [530] 46 47 47 47 47 47 47 47 47 47 47 47 47 48 48 48 48 48 48 48 48 48 48
## [553] 48 48 49 49 49 49 49 49 49 49 49 49 49 49 50 50 50 50 50 50 50 50 50
## [576] 50 50 50
## 50 Levels: 1 < 2 < 3 < 4 < 5 < 6 < 7 < 8 < 9 < 10 < 11 < 12 < ... < 50
diet1 <- ChickWeight %>% filter(Diet == 1)
#Now the plot is in the correct order
hm <- ggplot(data=diet1, aes(x=as.factor(Time), y=as.numeric(Chick), fill=weight)) +
     geom_tile()

hm <- ggplot(data=diet1, aes(x=as.factor(Time), y=Chick, fill=weight)) +
     geom_tile()

hm

You can also use forcats function to reorder by frequency, or reverse the order.

The line plot part

I want to use the line plot just to show shape of trends. I really just need the panel area, so I can use theme_nothing() from cowplot as a shortcut to get rid of extra plot elements.

lp <- ggplot(data=diet1, aes(x=Time, y=weight, group=Chick)) +
     geom_line() +
     theme_nothing() +
     scale_x_continuous(expand=c(0,0)) +
     scale_y_continuous(expand=c(0,0)) +
     labs(x = NULL, y = NULL)
lp

This is a very much a shortcut. You can also manually remove specific plot elements. I’ll demo the process by removing plot elements I don’t want from the heatmap.

Getting fancy with grobs

This is where the real power to customize plots comes in.

For the heatmaps, I want the panel and the x axis title.

I’m going to tear these plot apart by breaking them down into their component parts and removing the ones I don’t want

grob diagram

grob diagram

#I'll start by making the starting plot 


#I want all plots to be on the same scale, so I calc the max and min values and use them as the limits for all future plots
maxvalue = max(ChickWeight$weight)
minvalue = min(ChickWeight$weight)

hm <- ggplot(data=diet1, aes(x=as.factor(Time), y=as.numeric(Chick), fill=weight)) +
     geom_tile() +
     xlab("21 day growth tracks") + 
     ylab("Individual Chickens") +
     geom_hline(aes(yintercept=as.numeric(Chick)-0.5), color="white") + #Add while lines between rows
     scale_fill_gradient(low = "seashell1", high = "black", limits = c(minvalue,maxvalue), name = "Weight (g)")
hm

#Now I get a table of the graphical objects that make up the plot
hmgrob <- ggplotGrob(hm)
    print(hmgrob)
## TableGrob (6 x 6) "layout": 9 grobs
##   z     cells       name                                    grob
## 1 0 (1-6,1-6) background zeroGrob[plot.background..zeroGrob.843]
## 2 3 (3-3,3-3)     axis-l     absoluteGrob[GRID.absoluteGrob.827]
## 3 1 (4-4,3-3)     spacer                          zeroGrob[NULL]
## 4 2 (3-3,4-4)      panel                   gTree[GRID.gTree.811]
## 5 4 (4-4,4-4)     axis-b     absoluteGrob[GRID.absoluteGrob.819]
## 6 5 (5-5,4-4)       xlab  titleGrob[axis.title.x..titleGrob.830]
## 7 6 (3-3,2-2)       ylab  titleGrob[axis.title.y..titleGrob.833]
## 8 7 (3-3,5-5)  guide-box                       gtable[guide-box]
## 9 8 (2-2,4-4)      title      zeroGrob[plot.title..zeroGrob.842]
    #Get rid of plot objects I don't want
    hmgrob_removed <- gtable_remove_grobs(hmgrob, c('title', 'ylab', 'spacer','axis-l', 'axis-b', 'guide-box'))
    print(hmgrob_removed)
## TableGrob (6 x 6) "layout": 3 grobs
##   z     cells       name                                    grob
## 1 0 (1-6,1-6) background zeroGrob[plot.background..zeroGrob.843]
## 2 2 (3-3,4-4)      panel                   gTree[GRID.gTree.811]
## 3 5 (5-5,4-4)       xlab  titleGrob[axis.title.x..titleGrob.830]
    #Compact empty rows and columns
    hmgrob_squashed <- gtable_squash_rows(hmgrob_removed, c(1, 2, 4, 6))
    hmgrob_squashed <- gtable_squash_cols(hmgrob_squashed, c(1, 2, 3, 5))
    
    #Plot the table of grobs
    plot_grid(hmgrob_squashed)

I can also use this strategy to get individual plot elements. I’ll need the scale bar later, so I’ll extract that individually.

hm_scale_tmp <- gtable_remove_grobs(hmgrob, c('title', 'xlab', 'ylab', 'spacer','axis-b', 'axis-l', 'panel'))
hm_scale <- gtable_squash_rows(hm_scale_tmp, c(1, 2, 4, 5, 6))
hm_scale <- gtable_squash_cols(hm_scale, c(1, 2, 3,4, 6))
plot_grid(hm_scale)

hm_xtitle_tmp <- gtable_remove_grobs(hmgrob, c('title', 'ylab', 'spacer','axis-b', 'axis-l', 'panel', 'guide-box'))
hm_xtitle <- gtable_squash_rows(hm_xtitle_tmp, c(1, 2, 3, 4, 6))
hm_xtitle <- gtable_squash_cols(hm_xtitle, c(1, 2, 3,5, 6))
plot_grid(hm_xtitle)

Alright, all ready to go

plot_grid(lp, hmgrob_squashed, rel_heights = c(0.5,1), ncol=1) 

Making a function for plotting

I take the code that I worked out above, and put in in a function.

#Set up the function name with arguments
growth_function <- function(dat, minvalue, maxvalue){

 dietname <- unique(dat$Diet) 
 hm <- ggplot(data=dat, aes(x=as.factor(Time), y=as.numeric(Chick), fill=weight)) +
     geom_tile() +
     xlab("21 day growth tracks") + 
     ylab("Chick ID") +
     theme(legend.position="none") +
      scale_fill_gradient(low = "seashell1", high = "black", limits = c(minvalue, maxvalue))+
     geom_hline(aes(yintercept=as.numeric(Chick)-0.5),  color="white") # add white lines between rows
 
hmgrob <- ggplotGrob(hm)
    
    #Get rid of plot objects I don't want
    hmgrob_removed <- gtable_remove_grobs(hmgrob, c('title', 'ylab', 'spacer','axis-l', 'axis-b', 'guide-box'))
    
    #Compact empty rows and columns
    hmgrob_squashed <- gtable_squash_rows(hmgrob_removed, c(1, 2, 4, 6))
    hm <- gtable_squash_cols(hmgrob_squashed, c(1, 2, 3, 5))
  
 
lp <- ggplot(data=dat, aes(x=Time, y=weight, group=Chick)) +
     geom_line() +
     theme_nothing() +
     scale_x_continuous(expand=c(0,0)) +
     scale_y_continuous(expand=c(0,0)) +
     labs(x = NULL, y = NULL) +
     ylim(minvalue, maxvalue)
     annotate ("text", x = 3, y=200, label=paste("Diet ",dietname, sep=""), color="red", size=5)
    return(plot_grid(lp, hm, ncol=1, rel_heights = c(0.5,1)))  

}  

I take the ChickWeight data, split by diet, and feed each diet group into the graphing function

#Reminder that the . stands for the output of the previous step
list_of_plots <- ChickWeight %>% split(.$Diet) %>% purrr::map(growth_function, minvalue, maxvalue)

#Now I have a list that contains all four plots
list_of_plots
## $`1`

## 
## $`2`

## 
## $`3`

## 
## $`4`

#I use the plotlist argument in plotgrid to stick them together. 
plot_grid(plotlist = list_of_plots, nrow=2, ncol=2)

Final changes

Almost there. There are a few changes I need to make.

  1. I’d prefer 1 x 4 instaed of 2 x 2 so the lineplots are more comparable

  2. I’m not a fan of the floating diet labels

  3. I’d like white lines between each growth strip to make the individuals more distinct

growth_function2 <- function(dat, minvalue,maxvalue){
    
     dietname <- unique(dat$Diet)
     hm <- ggplot(data=dat, aes(x=as.factor(Time), y=as.numeric(Chick), fill=weight)) +
     geom_tile() +
     xlab(paste("21 day growth tracks\nDiet", dietname, sep=" ")) +
      scale_fill_gradient(low = "seashell1", high = "black", limits = c(minvalue,maxvalue))+
     geom_hline(aes(yintercept=as.numeric(Chick)-0.5), color="white") 
 
  lp <- ggplot(data=dat, aes(x=Time, y=weight, group=Chick)) +
     geom_line() +
     theme_nothing() +
     scale_x_continuous(expand=c(0,0)) +
     scale_y_continuous(expand=c(0,0)) +
     labs(x = NULL, y = NULL) +
     ylim(minvalue,maxvalue) +
     annotation_custom(g, xmin=2, xmax=8, ymin=10, ymax=Inf) #Add the chick picture

     #Reduce plot down to a list of its component objects
     lpgrob <- ggplotGrob(lp)
     lpgrob_removed <- gtable_remove_grobs(lpgrob, c('title', 'xlab', 'ylab', 'spacer','axis-b', 'axis-l', 'guide-box'))
    
     hmgrob <- ggplotGrob(hm)
     hmgrob_removed <- gtable_remove_grobs(hmgrob, c('title', 'ylab', 'spacer','axis-l', 'axis-b', 'guide-box'))
    #Get rid of rows with no objects in them
     hmgrob_squashed <- gtable_squash_rows(hmgrob_removed, c(1, 2, 4, 6))
     hm <- gtable_squash_cols(hmgrob_squashed, c(1, 2, 3, 5))
    
     return(plot_grid(lp, hm, ncol=1, rel_heights = c(0.7,1)))


}  

Split Chickweight into groups by diet, and plot each diet group.

#Reminder that the . stands for the output of the previous step
list_of_plots2 <- ChickWeight %>% split(.$Diet) %>% purrr::map(growth_function2, minvalue, maxvalue)

#Plot the grob tables that were stored in list_of_plot2
hm_lp_plt <- plot_grid(plotlist = list_of_plots2, nrow=1, ncol=4)
hm_lp_plt

#Add some space above the scale bar so it will line up with the heatmap
scalebar <- plot_grid(NULL, hm_scale, ncol=1, rel_heights = c(0.5,1))
#Put it all together
final_plt <- plot_grid(hm_lp_plt, scalebar, nrow=1, rel_widths = c(2,0.25), labels=c("A", NULL))
final_plt

#Save a pdf
ggsave(file="Chick_Growth.pdf", width=10, height=4)