I am a bit of a nerd and also a recent progenitor. So of course I had to find ways of analyzing the growth of my F1.
What follows is a very brief look into the growth pattern of Em, using the little data I have so far - F1 is only 7 months old.
Initially the data was input manually, in wide format, and then convert to tidier long format, but in the end I decided to write it in a file, already in long format, because it is easier to read and update. It also makes more sense that ways because there aren’t values for every time point for every variable. For instance, the circumference of the head is only measured when Em visits the Doctor. Nevertheless I am leaving the original code here for reference.
Another thing to keep in mind is that both the days and the measurements are estimates - some were taken at home using a bathroom scale or in changing station with a ruler. I expect that over time the will be ironed out. Also, this is just a bit of fun.
em <- data.frame(
# code = factor(c("U1", "U2", "U3", "U4", "U5")),
Week = c(0, 1, 4, 16, 28),
Weight = c(3.450, 3.280, 3.750, 5.050, 7.250),
Height =c(53, 52, 55, 61, 66.5),
Head_circumference = c(35.5, 35, 36, 40.5, 43.5)
)
em
em_tidy <- em %>%
mutate(Day = Week * 7) %>%
select(-c(Week)) %>%
gather(Measurement, Value, c( Weight, Height, Head_circumference)) %>%
mutate(Person = "Em")The units are not in the table but are cm for height and head circumference, and kg for weight.
em_tidy <- read.delim(
here::here("posts/2017-03-16-how-big-is-the-offspring/data/em_data.txt.csv")
)
glimpse(em_tidy)Rows: 22
Columns: 4
$ Person <chr> "Em", "Em", "Em", "Em", "Em", "Em", "Em", "Em", "Em", "Em"…
$ Day <int> 0, 0, 0, 3, 3, 3, 29, 29, 29, 87, 87, 87, 170, 170, 170, 1…
$ Measurement <chr> "Weight", "Height", "Head_circumference", "Weight", "Heigh…
$ Value <dbl> 3.45, 53.00, 35.50, 3.28, 52.00, 35.00, 3.75, 55.00, 36.00…The first thing to do is to plot all the things!
ggplot(em_tidy, aes(x=Day, y=Value)) +
geom_point() +
facet_grid(Measurement ~ ., scales = "free_y") +
theme_Publication() +
scale_colour_Publication()
Well, Em is growing so that is nice. The plot is a bit clunky though: there are no units and it’s not easy to read. One of those situations when facets are not ideal. Let’s change that.
p1 <- ggplot(subset(em_tidy, Measurement == "Weight"), aes(x=Day, y=Value)) +
geom_point() +
theme_Publication() +
scale_colour_Publication() +
xlab("") +
ylab("Weight (kg)")
p2 <- ggplot(subset(em_tidy, Measurement == "Height"), aes(x=Day, y=Value)) +
geom_point() +
theme_Publication() +
scale_colour_Publication() +
xlab("") +
ylab("Height (cm)")
p3 <- ggplot(subset(em_tidy, Measurement == "Head_circumference"), aes(x=Day, y=Value)) +
geom_point() +
theme_Publication() +
scale_colour_Publication() +
xlab("Age (Days)") +
ylab("Head circumference (cm)")
multiplot(plotlist=list(p1, p2, p3))
So yes, there is some growing happening but also a dip around the first week when Em lost nearly 200 g. Turns out this is completely normal and as expected at the next visit the weight was beck up again.
Looking at her numbers alone feels a little bland, and as I keep hearing in more or less to understand how big a number really is, one needs to compare it to something.
Enter the data for the general population. This data as been compiled by the World Health organization for quite some time now, and serves as basis for pediatricians around the world, to compare baby growth to what is expected. Luckily for me all of this data has been assembled in a neat package: The healthy growth package. Check also the tutorial.
options(repos = c(
CRAN = "http://cran.rstudio.com/",
deltarho = "http://packages.deltarho.org"))
install.packages("hbgd")It not only contains data, but also some practical functions (and visualizations) to extract said data. For instance one can get the median height of Female babies (the default) for any range of ages, let’s say for the first year:
library("hbgd")
x <- seq(0, 365, by = 7)
x [1] 0 7 14 21 28 35 42 49 56 63 70 77 84 91 98 105 112 119 126
[20] 133 140 147 154 161 168 175 182 189 196 203 210 217 224 231 238 245 252 259
[39] 266 273 280 287 294 301 308 315 322 329 336 343 350 357 364med <- who_centile2htcm(x)
med [1] 48.4477 49.6298 50.8120 51.7695 52.6809 53.5454 54.3642 55.1406 55.8767
[10] 56.5761 57.2436 57.8816 58.4922 59.0773 59.6393 60.1795 60.6991 61.1988
[19] 61.6795 62.1423 62.5884 63.0196 63.4370 63.8422 64.2366 64.6214 64.9978
[28] 65.3668 65.7290 66.0850 66.4355 66.7810 67.1219 67.4585 67.7911 68.1200
[37] 68.4452 68.7672 69.0858 69.4015 69.7142 70.0241 70.3314 70.6359 70.9378
[46] 71.2372 71.5340 71.8284 72.1203 72.4099 72.6971 72.9820 73.2647With this I can now compare my offspring with what is expected in the population:
age <- unique(em_tidy$Day)
per_who <- data.frame(
Day = age,
Weight = who_centile2wtkg(age),
Height = who_centile2htcm(age),
Head_circumference = who_centile2hcircm(age)
) %>%
gather(
Measurement,
Value,
c( Weight, Height, Head_circumference)) %>%
mutate(Person = "WHO") %>%
rbind(em_tidy)
glimpse(per_who)Rows: 49
Columns: 4
$ Day <int> 0, 3, 29, 87, 170, 182, 110, 208, 370, 0, 3, 29, 87, 170, …
$ Measurement <chr> "Weight", "Weight", "Weight", "Weight", "Weight", "Weight"…
$ Value <dbl> 3.2322, 3.2315, 4.1353, 5.7539, 7.1393, 7.2894, 6.2143, 7.…
$ Person <chr> "WHO", "WHO", "WHO", "WHO", "WHO", "WHO", "WHO", "WHO", "W…p1 <- ggplot(subset(per_who, Measurement == "Weight"), aes(x=Day, y=Value, color=Person)) +
geom_point(group="Person") +
geom_line() +
theme_Publication() +
scale_colour_Publication() +
xlab("") +
ylab("Weight (kg)")
p2 <- ggplot(subset(per_who, Measurement == "Height"), aes(x=Day, y=Value, color=Person)) +
geom_point(group="Person") +
geom_line() +
theme_Publication() +
scale_colour_Publication() +
xlab("") +
ylab("Height (cm)")
p3 <- ggplot(subset(per_who, Measurement == "Head_circumference"), aes(x=Day, y=Value, color=Person)) +
geom_point(group="Person") +
geom_line() +
theme_Publication() +
scale_colour_Publication() +
xlab("Age since birth (Days)") +
ylab("Head circumference (cm)")
multiplot(plotlist=list(p1, p2, p3))
Yeah, we really screwed up with that one measurement. On the other hand, Em appears to be has average as an F1 can get. But we can test that as well. Suppose we want to know the WHO centile of a female child at Em age (370) who is 77 cm tall:
current_age <- max(em_tidy$Day)
current_weight <- max(subset(em_tidy, Measurement == "Weight")$Value)
weight_age <- max(subset(em_tidy, Measurement == "Weight")$Day)
current_height <- max(subset(em_tidy, Measurement == "Height")$Value)
height_age <- max(subset(em_tidy, Measurement == "Height")$Day)
per_h <- who_htcm2centile(agedays = height_age, htcm = current_height)
per_w <- who_wtkg2centile(agedays = weight_age, wtkg = current_weight)It seems like she is in the 91.1896738 percentile for height and in the 90.7631171 percentile for weight, which makes sense - Slender was the word used by the doctor to describe Em.
Update 2023: while converting the blog to quarto the code below wouldn’t compile due to a ggplot error in the convenience function geom_who. ggplot2 has been going trough some changes in the past five years, which combined with hbgd not longer being maintained led me some code refactoring. New version is below using growthstandards
We can also see that in when plotting the percentile bands, first using some nifty function of hbgd to get the WHO percentiles:
WHO bands at centiles 1, 5, 25, 50, 75, 95, 99
centiles <- c(1, 5, 25, 75, 95, 99)
who_centiles <- list(
Weight = lapply(centiles, function(x) who_centile2wtkg(age, p = x)) %>%
purrr::set_names(paste0('Q', centiles)) %>%
data.table::setDT() %>%
.[, Day := age] %>%
.[, Measurement := "Weight"] %>%
.[],
Height = lapply(centiles, function(x) who_centile2htcm(age, p = x)) %>%
purrr::set_names(paste0('Q', centiles)) %>%
data.table::setDT() %>%
.[, Day := age] %>%
.[, Measurement := "Height"] %>%
.[],
Head_circumference = lapply(centiles, function(x) who_centile2hcircm(age, p = x)) %>%
purrr::set_names(paste0('Q', centiles)) %>%
data.table::setDT() %>%
.[, Day := age] %>%
.[, Measurement := "Head_circumference"] %>%
.[]
) and then ggplot2::geom_ribbon for the visualization:
p1 <- ggplot(subset(em_tidy, Measurement == "Weight"), aes(x=Day, y=Value)) +
xlim(0, current_age) +
geom_ribbon(data = who_centiles[["Weight"]], aes(x = Day, y = NULL, ymin = Q25, ymax = Q75), inherit.aes = TRUE, alpha=0.7, fill = "#fdb462") +
geom_ribbon(data = who_centiles[["Weight"]], aes(x = Day, y = NULL, ymin = Q5, ymax = Q95), inherit.aes = TRUE, alpha=0.5, fill = "#fdb462") +
geom_ribbon(data = who_centiles[["Weight"]], aes(x = Day, y = NULL, ymin = Q1, ymax = Q99), inherit.aes = TRUE, alpha=0.5, fill = "#fdb462") +
theme_Publication() +
geom_point(color = "#386cb0", size = 2) +
xlab("") +
ylab("Weight (kg)")
p2 <- ggplot(subset(em_tidy, Measurement == "Height"), aes(x=Day, y=Value)) +
xlim(0, current_age) +
geom_ribbon(data = who_centiles[["Height"]], aes(x = Day, y = NULL, ymin = Q25, ymax = Q75), inherit.aes = TRUE, alpha=0.7, fill = "#fdb462") +
geom_ribbon(data = who_centiles[["Height"]], aes(x = Day, y = NULL, ymin = Q5, ymax = Q95), inherit.aes = TRUE, alpha=0.5, fill = "#fdb462") +
geom_ribbon(data = who_centiles[["Height"]], aes(x = Day, y = NULL, ymin = Q1, ymax = Q99), inherit.aes = TRUE, alpha=0.5, fill = "#fdb462") +
theme_Publication() +
geom_point(color = "#386cb0", size = 2) +
xlab("Days") +
ylab("Height (kg)")
multiplot(plotlist=list(p1, p2))
ggsave("height_weight_quantiles.png", p1, height = 4)Saving 7 x 4 in imageTake home messages: - F1 started as a very average baby but is now growing into a big toddler. - F0 is pretty poor at taking measurements
@online{domingues2017,
author = {Domingues, António},
title = {How Big Is My Baby?},
date = {2017-03-16},
url = {https://amjdomingues.com/posts/2017-03-16-how-big-is-the-offspring/},
langid = {en}
}