In the coming year a group of us from the School of Biological Sciences at Monash Uni will roll out a new course: SCI1200 – Humans, Evolution, and Modern Society. Part of my lecture series in SCI1200 will cover the human obesity epidemic; in those lectures I talk about changes in my own body mass, to make the point that large changes in body mass can arise as a consequences of quite small rates of change (just a few hundred grams a month), and that these small rates of change can lead to obesity if they are sustained over a long period of time.

Inspired by the climate spiral produced by Ed Hawkins (which was itself inspired by a suggestion from Jan Fuglestvedt), I thought it would be fun to convert my fluctuating body mass into a spiral. I created the above body mass spiral in R, using the saveGIF function of the animation package to produce an animated gif (to use saveGIF you will also need to install ImageMagick or GraphicsMagick). After I posted the image on twitter, a few people asked for the code – so here it is, complete with a record of my own body mass starting on the 269th day of 2013!

The code below is inelegant – I have a perverse addiction to for loops, even though they are slow in R – but the code usually works on my machine (a MacBook Air running OS X El Capitan v10.11.4, R v3.2.3, Rstudio v0.99.893, animation v2.4). The saveGIF function can be a little temperamental, however, for reasons that I can’t explain. It seems to be sensitive to varying the number of frames or the size of the image so playing around with those values may help if it doesn’t work, but it will sometimes fail once and then work with no changes on the second or third try.

library(animation)

##### Palette URL: http://paletton.com/#uid=72Y0u0khy-e7yT7cSJTlxtFqRqX
#Primary color:
pal.green <- c("#B6EDCC", "#82D9A5", "#57C182", "#38AA66", "#199A4D")

#Secondary color (1):
pal.blue <- c("#B4D8E8", "#7EB5CD", "#5392AD", "#357895", "#1B6787")

#Secondary color (2):
pal.orange <- c("#FFE3C3", "#FFCF98", "#FFBD73", "#ECA14D", "#D78223")

#Complement color:
pal.red <- c("#FFCEC3", "#FFAC98", "#FF8E73", "#EC6C4D", "#D74523")

data <- data.frame(Day = c(269, 270, 271, 272, 275, 278, 280, 281, 284, 358,
363, 366, 370, 371, 372, 373, 377, 379, 382, 383,
384, 385, 390, 391, 392, 393, 394, 396, 397, 399,
400, 401, 402, 403, 404, 405, 406, 407, 409, 410,
414, 423, 426, 427, 429, 431, 433, 441, 445, 449,
450, 453, 473, 474, 475, 576, 588, 591, 594, 601,
603, 604, 605, 606, 608, 610, 612, 614, 618, 622,
629, 647, 664, 737, 740, 773, 800, 805, 826, 828,
832, 839, 849, 857, 863, 865, 876, 879, 881, 883,
888, 891, 912, 916, 919, 922, 941, 945, 953, 954,
960, 977, 980, 993, 997, 1006, 1105, 1106, 1108,
1109, 1112, 1113, 1114, 1119, 1122, 1126, 1133,
1135, 1136, 1155, 1167, 1181, 1191, 1192, 1193,
1206, 1209, 1210, 1211, 1213, 1214, 1215, 1225,
1230, 1252, 1253, 1260, 1290, 1293, 1311, 1312,
1313, 1319, 1322, 1323, 1324, 1335, 1340, 1347,
1352, 1360, 1366, 1368, 1370, 1380, 1384, 1384,
1388, 1394, 1416, 1427, 1460, 1461),
Weight.kg = c(66.4, 66.2, 65.7, 66.4, 66, 66.5, 65.7, 66.3,
66.3, 68.2, 67.5, 68.4, 67.5, 67.8, 67, 67.6,
67.1, 67.6, 66.3, 66.5, 65.4, 66, 66.4, 66.2,
66.2, 66.5, 67, 66.1, 65.4, 65.8, 65.4, 65.4,
64.9, 65.8, 64.8, 65.2, 65, 64.8, 65, 64.6,
64.6, 65.4, 65.2, 64.9, 64.3, 64.9, 64.5,
64.1, 64.5, 64.1, 64.1, 63.9, 64.7, 64.4, 64,
65.7, 64.3, 65, 65, 64.8, 64.3, 63.9, 63.9,
63.9, 64.7, 64.2, 64.7, 64.3, 63.9, 64.1, 63.7,
63.4, 64, 64.3, 64.1, 65, 65.15, 65, 64.9, 65.2,
65.3, 65.1, 64.1, 63.8, 63.5, 64.2, 63.6, 63.1,
63.3, 62.8, 63, 63.4, 62.4, 62.7, 62.1, 62.7,
62.8, 63.7, 63.5, 63.8, 63.8, 64.5, 64.8, 63.7,
63.7, 64, 67.4, 66.9, 66.3, 66.3, 66.3, 66.7,
66.6, 65.8, 66.6, 66.4, 67, 66, 66.4, 66.3, 65.8,
67.1, 66.6, 66.1, 65.5, 66.8, 66.6, 66.4, 67.4,
67, 67.3, 66.9, 67.9, 67, 66.8, 66.9, 67.6, 67.7,
67.7, 66.7, 66.4, 66.1, 66.8, 66.3, 66.5, 66.5,
66.9, 66.2, 66, 65.9, 66.7, 66.7, 66.5, 66.1, 67,
66.1, 66.2, 66.2, 66, 66.5, 67.7, 69, 68))

#Set the scale (data.range) and margin spacing for the plot
data.range <- c(60,70)
bottom.space <- 2
top.space <- 1
n.points <- 75 #number of points used for grey circles on plot
n.frames <- 150 #Number of frames in the animated gif
frame.interval <- 0.01 #time between frames in animated gif
gif.size <- 400 #image height/width (in pixels)

data.delta <- data.range[2]-data.range[1]

#Calculate x,y coordinates for the month indicators
months <- c(0,31,28,31,30,31,30,31,31,30,31,30,31)
months.year <- cumsum(months)/365
months.radians <- -(360*months.year-90)*pi/180
months.x <- (bottom.space+data.delta+top.space)*cos(months.radians)
months.y <- (bottom.space+data.delta+top.space)*sin(months.radians)

months.labels.radians <- rep(NA, 12)
for(i in 1:length(months.labels.radians)){
months.labels.radians[i] <- mean(months.radians[i:(i+1)])
}
months.labels.x <- (bottom.space+data.delta+top.space)*cos(months.labels.radians)
months.labels.y <- (bottom.space+data.delta+top.space)*sin(months.labels.radians)

#Colours for the background of the plot
col.circle.1 <- "grey80" #Dark colour for background
col.circle.2 <- "grey95" #Light colour for background
col.circle.3 <- "grey40" #Colour for text
par(mfrow = c(3,1), mar = c(4,4,0,0)+0.5)

#Plot original data
plot(Weight.kg ~ Day, data = data, type = "l")

#Scale days to years
data$year <- data$Day/365

#Rescale original data for plotting
data$weight <- bottom.space+data$Weight.kg-data.range[1]

#Plot rescaled data
plot(weight ~ year, data = data, type = "l")

#Interpolate missing data, and downscale data to a smaller number of samples
# The number of samples here ('n') dictates the number of frames in the
# animated gif produced later
data2 <- data.frame(approx(x = data$Day, y = data$weight, n = n.frames))

#Rename x and y
colnames(data2) <- c("Day", "weight")

#Scale days to years
data2$year <- data2$Day/365

#Calculate x,y coordinates for each data value
data2$radians <- -(360*data2$year-90)*pi/180
data2$x <- data2$weight*cos(data2$radians)
data2$y <- data2$weight*sin(data2$radians)

#Use 'colorRampPalette' to vary colours by weight
data2$col <- colorRampPalette(c(pal.blue[5], pal.orange[5]))(100)[as.numeric(cut(data2$weight,breaks = 100))]

#Plot interpolated and downsampled data
plot(weight ~ Day, data = data2, type = "l")

# Create the animated gif using a loop to plot the figure multiple times
# each new plot forms a frame of the animated gif

saveGIF({

for(z in 2:(nrow(data2))){

#Create an empty plot
par(mfrow = c(1,1), mar = rep(0,4))
plot(x = c(-1*(data.delta+bottom.space+top.space),(data.delta+bottom.space+top.space)),
y = c(-1*(data.delta+bottom.space+top.space),(data.delta+bottom.space+top.space)),
type = "n", asp = 1, xlab = "", ylab = "", axes = F)

#Plot the background - filled concentric circles

coords <- t(rbind(sin(seq(0,2*pi,length=n.points))*bottom.space,
cos(seq(0,2*pi,length=n.points))*bottom.space))
polygon(coords, col = col.circle.2, border = F)

coords <- rbind(t(rbind(sin(seq(0,2*pi,length=n.points))*bottom.space,
cos(seq(0,2*pi,length=n.points))*bottom.space)),
t(rbind(rev(sin(seq(0,2*pi,length=n.points))*(bottom.space+2)),
rev(cos(seq(0,2*pi,length=n.points))*(bottom.space+2)))))
polygon(coords, col = col.circle.1, border = F)

coords <- rbind(t(rbind(sin(seq(0,2*pi,length=n.points))*(bottom.space+2),
cos(seq(0,2*pi,length=n.points))*(bottom.space+2))),
t(rbind(rev(sin(seq(0,2*pi,length=n.points))*(bottom.space+4)),
rev(cos(seq(0,2*pi,length=n.points))*(bottom.space+4)))))
polygon(coords, col = col.circle.2, border = F)

coords <- rbind(t(rbind(sin(seq(0,2*pi,length=n.points))*(bottom.space+4),
cos(seq(0,2*pi,length=n.points))*(bottom.space+4))),
t(rbind(rev(sin(seq(0,2*pi,length=n.points))*(bottom.space+6)),
rev(cos(seq(0,2*pi,length=n.points))*(bottom.space+6)))))
polygon(coords, col = col.circle.1, border = F)

coords <- rbind(t(rbind(sin(seq(0,2*pi,length=n.points))*(bottom.space+6),
cos(seq(0,2*pi,length=n.points))*(bottom.space+6))),
t(rbind(rev(sin(seq(0,2*pi,length=n.points))*(bottom.space+8)),
rev(cos(seq(0,2*pi,length=n.points))*(bottom.space+8)))))
polygon(coords, col = col.circle.2, border = F)

coords <- rbind(t(rbind(sin(seq(0,2*pi,length=n.points))*(bottom.space+8),
cos(seq(0,2*pi,length=n.points))*(bottom.space+8))),
t(rbind(rev(sin(seq(0,2*pi,length=n.points))*(bottom.space+10)),
rev(cos(seq(0,2*pi,length=n.points))*(bottom.space+10)))))
polygon(coords, col = col.circle.1, border = F)

#Markers for the months
for(i in 2:length(months)){
lines(x = c(0, months.x[i]),
y = c(0, months.y[i]),
col = col.circle.1, lwd = 2)
}

#Use a loop to plot the line in segments, so that each segment can be coloured by mass
for(i in 1:z){
lines(data2$x[i:(i+1)], data2$y[i:(i+1)],
col = data2$col[i],
lwd = 3)
}

#Add scale markers
text(x = 0, y = bottom.space, labels = expression(bold("60 kg")), #pos = 4,
col = col.circle.3,
cex = 1)
text(x = 0, y = bottom.space+data.delta, labels = expression(bold("70 kg")), #pos = 4,
col = col.circle.3,
cex = 1)

#Add months
for(i in 1:length(months.labels.radians)){
text(labels = month.name[i], x = months.labels.x[i], y = months.labels.y[i],
srt = 270+months.labels.radians[i]*180/pi,
col = col.circle.3, cex = 1.25)
}

}

}, movie.name = "bodymass.gif", interval = frame.interval, loop = TRUE, delay = NULL,
ani.width = gif.size, ani.height = gif.size)