I was recently listening to the #WhoIsFat Joe Rogan podcast where comedians Bert Kreischer and Tom Segura had their weight loss challenge weigh-ins. The challenge was for both guys to get out of the “obese” category and into the merely “overweight” category. If one made it and the other didn’t, the loser would pay for a trip to Paris for the winner. If both made it, fellow comedian Ari Shaffir would pay. At the weigh-in, Ari questioned Tom’s height and whether he made it to the overweight BMI. I googled BMI charts to see whether Ari was right. However, the interactivity of the ones I found left something to be desired.

Coincidentally, the same my wife texted me the same day about an impressive BMI (around 50) in a case she was handling. She practices Social Security disability law, and weight, BMI, diabetes, etc. often arise in a disability determination. Between the bad interactive examples I found on Google and my wife’s comments about her case, I decided to make an interactive BMI chart she can use at work.

Since we’re in the US, we’re using imperial units. We’ll go from 100 to 300 pounds in weight and 5’ to 6’6″ in height. We’ll use factors instead of continuous variables so we can label height in feet and inches, rather than just inches.

weights <- seq(from = 100, to = 300, by = 5)
heights <- seq(from = 78, to = 60)

df <- data.frame(height = factor(paste(floor(heights / 12), "'", heights %% 12, "\"", sep=""), labels = rev(paste(floor(heights / 12), "'", heights %% 12, "\"", sep="")), ordered = TRUE))
df$height <- sort(df$height, decreasing = TRUE)

Next, we’ll perform the BMI calculations. That requires conversion from inches to meters and pounds to kilograms. We’ll create a grid of the BMIs that is a text representation of the chart.

for(x in weights){
  bmi.column <- c() 
  for (y in heights){
    # inches to meters
    meters <- y * 0.0254
    # pounds to kgs
    kgs <- x * 0.453592
    
    bmi <- round(kgs / (meters * meters), 1)
    bmi.column <- c(bmi.column, bmi)
  }
    df <- cbind(df, bmi.column)
}
names(df) <- c("height", weights)

In order to plot the chart, we need to translate the data into key->value pairs that ggplot can use. We’ll calculate the max and min BMIs so we can set our color scales as well.

library(reshape2)
df <- melt(df, id.vars = c("height"))
names(df) <- c("height", "weight", "bmi")
min.bmi <- min(df$bmi)
max.bmi <- max(df$bmi)

I wanted to create a nice gradient between each BMI level. Here are the BMI levels I used:

• < 18: underweight
• 18-25: normal BMI
• 25-30: overweight
• 30-35: obese
• 35+: morbidly obese

colors <- c(
  "darkgoldenrod", 
  "goldenrod", 
  "green", 
  "yellow", 
  "red", 
  "purple",
  "purple4"
)
values <- c(
  min.bmi, 
  (min.bmi + 18) / 2,
  (18 + 25) / 2, 
  (25 + 30) / 2, 
  (30 + 35) / 2,
  (35 + 40) / 2,
  max.bmi
)
breaks <- c(
  min.bmi,
  (min.bmi + 18) / 2,
  (18 + 25) / 2, 
  (25 + 30) / 2, 
  (30 + 35) / 2,
  40,
  max.bmi
)
labels <- c( 
  "",
  "Underweight", 
  "Ideal", 
  "Overweight", 
  "Obese", 
  "Morbidly Obese",
  ""
)

All the prep work is done now. Let’s plot! Note that the text is commented out. I found that the mouseover brushing didn’t work as well with the labels printed, so I took them out.

library(ggplot2)
library(scales)
gg <- ggplot(df, aes(x = weight, y = height)) +
  geom_raster(aes(fill = bmi), interpolate = TRUE) +
  scale_fill_gradientn("BMI",
                       colors = colors, 
                       guide = "colorbar", 
                       values = rescale(values, to = c(0,1), 
                                        from = range(df$bmi)
                                        ),
                       labels = labels,
                       breaks = breaks
                      ) +
  #geom_text(aes(label = bmi), size = 3) + 
  xlab("weight") +
  scale_x_discrete(breaks = seq(from = 100, to = 300, by = 25))

  library(plotly)
  (ggplotly(gg))

I’m not thrilled by how much purple is in the legend, but I couldn’t figure out how to shrink the top end of the legend.

What do you think of this plot? What would you do differently?

Thanks for reading!