The super imposition by translation and rotation (SITAR) model is a shape-invariant nonlinear mixed effect growth curve model that fits a population average curve to the data, and aligns each individual’s growth trajectory to this underlying population average curve via a set of random effects (T. J. Cole et al., 2010). The ‘bsitar’ package (Sandhu, 2023) implements Bayesian estimation of the SITAR model and can fit a univariate model (analysis of a single outcome), univariate_by model (analysis of a single outcome separately for sub groups defined by a factor variable such as gender), and multivariate model (joint modelling of two or more outcomes). A detailed introduction to the Bayesian SITAR model including biological and mathematical description of the model, Markov chain Monte Carlo (MCMC) estimation, and the priors specifications are provided in the the Bayesian SITAR - An Introduction vignette.
In this vignette, we fit univariate Bayesian SITAR model using ‘bsitar’ package (Sandhu, 2023) and compare findings with the results of non Bayesian SITAR model (fit via the ‘sitar’ package (T. Cole, 2022)). Hereafter, the Bayesian and non Bayesian model estimated by the ‘sitar’ and ‘bsitar’ package are referred to as sitar and bsitar models, respectively. The purpose is to demonstrate that both ‘sitar’ and ‘bsitar’ packages perform similarly in estimating population average and individual specific trajectories and growth spurt parameters (timing and the intensity). The aim of this exercise is to ensure that our ‘bsitar’ package performs as expected (i.e., no systematic difference in results when compared with the sitar model) before we fit more complex model (such as multivariate model) for which no direct comparison is possible between bsitar and sitar models (‘sitar’ package is restricted to univariate model fitting).
We study Berkeley data that comprise repeated growth measurements made on males and females from birth to adulthood. The Berkeley data set is included in both ‘sitar’ and ‘bsitar’ packages. To compare our findings directly with the results shown in the vignette for the sitar model Fitting models with SITAR, we analyze the exact same data. The data is a subset of the Berkeley data with height measurements for females (between 8 and 18 years of age, every six months).
If needed, install ‘bsitar’ and ‘sitar’ packages (also other required packages)
if (!require(bsitar)) install.packages('bsitar')
if (!require(sitar)) install.packages('sitar')
if (!require(ggplot2)) install.packages('ggplot2')
if (!require(knitr)) install.packages('knitr')
if (!require(kableExtra)) install.packages('kableExtra')Fit sitar and bsitar models using the ‘sitar’ and ‘bsitar’ packages.
if(existsdata) {
if(exists('berkeley_mdata')) data <- berkeley_mdata else stop("data does not exist")
} else {
data <- na.omit(berkeley[berkeley$sex == "Female" &
berkeley$age >= 8 & berkeley$age <= 18,
c('id', 'age', 'height')])
}
# Fit SITAR model (fit via 'sitar' package)
if(existsfit) {
model_frequ <- sitar::sitar(x = age, y = height, id = id, data = data, df = 4)
} else {
model_frequ <- sitar::sitar(x = age, y = height, id = id, data = data, df = 5)
}
# Fit Bayesian SITAR model (via 'bsitar' package) - note prefix 'b' to 'model_bayes'.
# To save time, the model is fit by running two (default four) parallel chain
# with 1000 iterations (default 2000) per chain. Note also we have requested to
# expose Stan functions by setting expose_function as TRUE (default FALSE) and
# save them for later use.
# model_bayes <- bsitar(x = age, y = height, id = id, data = data, df = 5)
if(existsfit) {
if(exists('berkeley_mfit')) model_bayes <- berkeley_mfit else stop("model does not exist")
} else {
model_bayes <- bsitar(x = age, y = height, id = id, data = data, df = 5,
chains = 2, cores = 2, iter = 2000, refresh = 100,
sample_prior = "no",
expose_function = TRUE)
}Summary for the sitar model
Summary for the bsitar model
idvar <- 'id'
xvar <- 'age'
yvar <- 'height'
# For observed and adjusted plot
data_sitar_a <- plot(model_frequ, opt = 'a', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_bsitar_a <- plot_curves(model_bayes, opt = 'a', returndata = T)
data_all_a <- data %>% dplyr::mutate(Curve = 'observed') %>%
dplyr::bind_rows(., data_sitar_a %>% dplyr::relocate(all_of(colnames(data))) %>%
dplyr::mutate(Curve = 'adjusted_sitar')) %>%
dplyr::bind_rows(., data_bsitar_a %>% dplyr::relocate(all_of(colnames(data))) %>%
dplyr::mutate(Curve = 'adjusted_bsitar')) %>%
dplyr::mutate(Curve = as.factor(Curve))
# For distance and velocity (dv) plots
data_sitar_d <- plot(model_frequ, opt = 'd', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_sitar_v <- plot(model_frequ, opt = 'v', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_sitar_df <- data_sitar_d %>% data.frame()
data_bsitar_d <- plot_curves(model_bayes, opt = 'd', returndata = T, newdata = data_sitar_df, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_bsitar_v <- plot_curves(model_bayes, opt = 'v', returndata = T, newdata = data_sitar_df, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_sitar_d <- data_sitar_d %>% dplyr::rename(distance = height)
data_sitar_v <- data_sitar_v %>% dplyr::rename(velocity = height)
data_bsitar_d <- data_bsitar_d %>% dplyr::rename(distance = Estimate) %>% dplyr::select(all_of(colnames(data_sitar_d)))
data_bsitar_v <- data_bsitar_v %>% dplyr::rename(velocity = Estimate) %>% dplyr::select(all_of(colnames(data_sitar_v)))
idx <- c('id', 'age')
data_sitar_d <- data_sitar_d %>% dplyr::relocate(all_of(idx))
data_sitar_v <- data_sitar_v %>% dplyr::relocate(all_of(idx))
data_bsitar_d <- data_bsitar_d %>% dplyr::relocate(all_of(idx))
data_bsitar_v <- data_bsitar_v %>% dplyr::relocate(all_of(idx))
data_sitar_dv <- data_sitar_d %>% dplyr::left_join(., data_sitar_v, by = idx)
data_bsitar_dv <- data_bsitar_d %>% dplyr::left_join(., data_bsitar_v, by = idx)
data_all_dv <- data_sitar_dv %>% dplyr::mutate(Model = 'sitar') %>%
dplyr::bind_rows(., data_bsitar_dv %>%
dplyr::mutate(Model = 'bsitar'))
# For Distance and Velocity (DV) plots
data_sitar_D <- plot(model_frequ, opt = 'D', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_sitar_V <- plot(model_frequ, opt = 'V', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_sitar_DF <- data_sitar_D %>% data.frame()
data_bsitar_D <- plot_curves(model_bayes, opt = 'D', returndata = T, newdata = data_sitar_DF, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_bsitar_V <- plot_curves(model_bayes, opt = 'V', returndata = T, newdata = data_sitar_DF, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_sitar_D <- data_sitar_D %>% dplyr::rename(distance = height)
data_sitar_V <- data_sitar_V %>% dplyr::rename(velocity = height)
data_bsitar_D <- data_bsitar_D %>% dplyr::rename(distance = Estimate) %>% dplyr::select(all_of(colnames(data_sitar_D)))
data_bsitar_V <- data_bsitar_V %>% dplyr::rename(velocity = Estimate) %>% dplyr::select(all_of(colnames(data_sitar_V)))
idx <- c('id', 'age')
data_sitar_D <- data_sitar_D %>% dplyr::relocate(all_of(idx))
data_sitar_V <- data_sitar_V %>% dplyr::relocate(all_of(idx))
data_bsitar_D <- data_bsitar_D %>% dplyr::relocate(all_of(idx))
data_bsitar_V <- data_bsitar_V %>% dplyr::relocate(all_of(idx))
data_sitar_DV <- data_sitar_D %>% dplyr::left_join(., data_sitar_V, by = idx)
data_bsitar_DV <- data_bsitar_D %>% dplyr::left_join(., data_bsitar_V, by = idx)
data_all_DV <- data_sitar_DV %>% dplyr::mutate(Model = 'sitar') %>%
dplyr::bind_rows(., data_bsitar_DV %>%
dplyr::mutate(Model = 'bsitar'))
# Set x range for x axis
xrange <- c(min(data$age), max(data$age))
# Get random effects for sitar model
fh1_ranef <- nlme::ranef(model_frequ)
# Get random effects for bsitar model
setid <- model_bayes$model_info$ids
bfh1_ranef_frame <- brms::ranef(model_bayes)
bfh1_ranef_frame_id <- bfh1_ranef_frame[[setid]]
dimxi_l <- list()
for (dimxi in 1:dim(bfh1_ranef_frame_id)[3]) {
dimxi_l[[dimxi]] <- bfh1_ranef_frame_id[,,dimxi][,1]
}
bfh1_ranef <- dimxi_l %>% do.call(cbind, .) %>%
data.frame() %>%
setNames(letters[1:3])
# Get correlation of random effects for sitar model
fh1_ranef_corr <- cor(fh1_ranef)
# Get correlation of random effects for bsitar model
bfh1_ranef_corr <- cor(bfh1_ranef)
colnames(bfh1_ranef_corr) <- letters[1:3]
rownames(bfh1_ranef_corr) <- letters[1:3]
# Get random effects along with id cilumn for sitar model
fh1_ranef_id <- fh1_ranef %>% data.frame() %>% tibble::rownames_to_column(., "id")
# Get random effects along with id cilumn for sitar model
bfh1_ranef_id <- bfh1_ranef %>% data.frame() %>% tibble::rownames_to_column(., "id")
# Get ids with random effects size (a) for the shortest and tallest individual - sitar model
# ranef_id_max_min <- fh1_ranef_id %>%
# dplyr::slice(c(which.min(a), which.max(a))) %>%
# dplyr::select(id) %>% unlist() %>% as.vector()
# Get ids for shortest and tallest individual - predicted by the sitar model
fh1_ranef_id_pred <- predict(model_frequ, level = 1)
fh1_ranef_id_pred_max <- fh1_ranef_id_pred[ which.max(fh1_ranef_id_pred)]
fh1_ranef_id_pred_min <- fh1_ranef_id_pred[ which.min(fh1_ranef_id_pred)]
ranef_id_max_min <- c(attr(fh1_ranef_id_pred_max, "names"),
attr(fh1_ranef_id_pred_min, "names"))
# Get individuals with max min random effects for size - sitar
fh1_ranef_id_max_min <- fh1_ranef_id %>%
dplyr::slice(c(which.min(a), which.max(a))) %>%
dplyr::select(id) %>% unlist() %>% as.vector()
# Get individuals with max min random effects for size - bsitar
bfh1_ranef_id_max_min <- bfh1_ranef_id %>%
dplyr::slice(c(which.min(a), which.max(a))) %>%
dplyr::select(id) %>% unlist() %>% as.vector()
sitar_ranef_id_min <- fh1_ranef_id %>% dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[1])
sitar_ranef_id_max <- fh1_ranef_id %>% dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[2])
bsitar_ranef_id_min <- bfh1_ranef_id %>% dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[2])
bsitar_ranef_id_max <- bfh1_ranef_id %>% dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[2])
# Set legend theme for ggplot
theme_legends1 <- theme(legend.position = "bottom",
legend.title = element_text(size=12),
legend.key.height = unit(1.5, 'cm'),
legend.key.width = unit(1.5, 'cm'),
legend.key.size = unit(1.5, 'cm'),
legend.text = element_text(size=12))
theme_legends2 <- theme(legend.position = "right",
legend.title = element_text(size=12),
legend.key.height = unit(1.5, 'cm'),
legend.key.width = unit(1.5, 'cm'),
legend.key.size = unit(1.5, 'cm'),
legend.text = element_text(size=12))
# Set grid theme for ggplot
theme_grids1 <- theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank()) +
theme_bw()
linewidths <- c(0.5, 0.75, 1.0, 1.5, 2.0)
alphas <- c(0.25, 0.5, 0.75, 1.0, 1.0)
colours <- c('black', 'red', 'green', 'orange', 'magenta')
linetypes <- c('solid', 'dashed', 'dotted', 'dotdash', 'longdash', 'twodash')Figure ?? (below) shows a comparison of observed growth curves with those adjusted via the random effects. As described earlier (see Introduction), the random effects align individual-specific growth trajectories towards a common population average (mean) trajectory. The three growth patterns that SITAR adjust via random effects are size, timing and intensity:
Adjusted curves aligned with the mean curve (Figure ??) indicate
that most of the inter-individual variability has been captured. This is
achieved by: 1) shifting the high curves down and the low curves up to adjust
for the size, 2) shifting the early curves later and the late curves earlier
(translation) to adjust for the timing, and 3) steep curves are made shallower
by stretching them along the age scale whereas shallow curves are made steeper
by shrinking them along the age scale (rotation) to adjust for the intensity.
This explains the name SITAR - Super Imposition by Translation And Rotation. The
curve adjustment involves translation (shifting the curves up/down and
left/right) and rotation (making them steeper or shallower), and the effect is
to superimpose the curves. The complexity of the spline curve’s shape is
determined by the degrees of freedom (df) argument in the sitar and
bsitar call. In our example, the models are fit using five degrees of
freedom.
data_all_a <- data_all_a %>%
dplyr::mutate(across(Curve, ~factor(.,
levels=c("observed",
"adjusted_sitar",
"adjusted_bsitar"))))
data_all_alevs <- levels(data_all_a$Curve)
p <-
data_all_a %>%
dplyr::mutate(groupby = interaction(id, Curve) ) %>%
ggplot(., aes(x = age))
p +
geom_line(data = data_all_a %>%
dplyr::filter(Curve==data_all_alevs[1]) %>%
dplyr::mutate(groupby = interaction(id, Curve)),
aes(x = age, y = height, group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[1], alpha = alphas[1],
show.legend = T) +
geom_line(data = data_all_a %>%
dplyr::filter(Curve==data_all_alevs[2]) %>%
dplyr::mutate(groupby = interaction(id, Curve)),
aes(x = age, y = height, group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[1], alpha = alphas[3],
show.legend = T) +
geom_line(data = data_all_a %>%
dplyr::filter(Curve==data_all_alevs[3]) %>%
dplyr::mutate(groupby = interaction(id, Curve)),
aes(x = age, y = height, group = groupby),
linetype = linetypes[2],
color = colours[1], linewidth = linewidths[1], alpha = alphas[4],
show.legend = T) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1 +
theme(legend.title=element_blank())
# data_all_a %>%
# dplyr::mutate(groupby = interaction(id, Curve) ) %>%
# ggplot(., aes(x = age)) +
# geom_line(aes(x = age, y = height, group = groupby,
# linetype = Curve),
# color = colours[1], alpha = alphas[2], linewidth = linewidths[2],
# show.legend = T) +
# scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
# theme_grids1 + theme_legends1The effect of SITAR adjustment in individual curves via random effects is shown more clearly in Figure ?? which displays observed and adjusted curves for tallest and shortest individuals along with the population average (mean) curve. The corresponding estimates of random effects (size, timing and intensity) are provided in Tables ?? and ??. Note that intensity c, multiplied by 100, is a percentage. Results for both the models are very similar to each other. Results for the sitar model are presented below.
For the shortest individual, size is NA cm smaller than the average size, timing of the spurt is NA year earlier than average timing, and the growth rate (intensity) is NA % faster than average growth rate. In contrast, the size for tallest individual is NA cm larger than the average size and the spurt occurs NA year later than average timing with growth rate NA % slower than average intensity.
For a broader comparison among the sitar and bsitar models, random effects for the first ten individuals estimated are shown below in (Table ?? and (Table ??). The association (correlation) between random effects (across all individuals) is shown as a scatterplot in Figures ?? and ??, and the corresponding estimates are provided in Table ?? and Table ??. Results show that timing is negatively correlated with intensity indicating the early puberty is associated with faster growth.
data_sitar_u_f <- plot(model_frequ, opt = 'u', returndata = T) %>%
dplyr::relocate( all_of(idvar), all_of(xvar), all_of(yvar)) %>%
dplyr::mutate(Curve = 'u') %>% dplyr::mutate(Model = 'sitar')
data_sitar_a_f <- plot(model_frequ, opt = 'a', returndata = T) %>%
dplyr::relocate( all_of(idvar), all_of(xvar), all_of(yvar)) %>%
dplyr::mutate(Curve = 'a') %>% dplyr::mutate(Model = 'sitar')
data_sitar_d_f <- plot(model_frequ, opt = 'd', returndata = T) %>%
dplyr::relocate( all_of(idvar), all_of(xvar), all_of(yvar)) %>%
dplyr::mutate(Curve = 'd') %>% dplyr::mutate(Model = 'sitar')
data_sitar_uad_df12 <- data_sitar_u_f[, 1:2]
data_sitar_uad_df123 <- data_sitar_u_f[, 1:3]
data_bsitar_u_f <- plot_curves(model_bayes, opt = 'u', returndata = T, newdata = data_sitar_uad_df123, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_bsitar_a_f <- plot_curves(model_bayes, opt = 'a', returndata = T, newdata = data_sitar_uad_df123, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_bsitar_d_f <- plot_curves(model_bayes, opt = 'd', returndata = T, newdata = data_sitar_uad_df12, ipts = NULL, usesavedfuns = T, envir = globalenv())
data_bsitar_u_f <- data_bsitar_u_f %>% dplyr::rename(!!yvar := yvar) %>% dplyr::select(all_of(colnames(data_sitar_uad_df123)))
data_bsitar_a_f <- data_bsitar_a_f %>% dplyr::rename(!!yvar := yvar) %>% dplyr::select(all_of(colnames(data_sitar_uad_df123)))
data_bsitar_d_f <- data_bsitar_d_f %>% dplyr::rename(!!yvar := 'Estimate') %>% dplyr::select(all_of(colnames(data_sitar_uad_df123)))
data_bsitar_u_f <- data_bsitar_u_f %>% dplyr::mutate(Curve = 'u') %>% dplyr::mutate(Model = 'bsitar')
data_bsitar_a_f <- data_bsitar_a_f %>% dplyr::mutate(Curve = 'a') %>% dplyr::mutate(Model = 'bsitar')
data_bsitar_d_f <- data_bsitar_d_f %>% dplyr::mutate(Curve = 'd') %>% dplyr::mutate(Model = 'bsitar')
data_sitar_uad_f <- data_sitar_u_f %>%
dplyr::bind_rows(., data_sitar_a_f) %>%
dplyr::bind_rows(., data_sitar_d_f)
data_bsitar_uad_f <- data_bsitar_u_f %>%
dplyr::bind_rows(., data_bsitar_a_f) %>%
dplyr::bind_rows(., data_bsitar_d_f)
data_sitar_uad_f <- data_sitar_uad_f %>%
dplyr::mutate(across(Curve, ~factor(.,
levels=c("u",
"a",
"d"))))
data_sitar_uad_f <- data_sitar_uad_f %>%
dplyr::mutate(Curve = dplyr::recode(Curve, u = "unadj",
a = "adj",
d = "pop.avg"))
data_bsitar_uad_f <- data_bsitar_uad_f %>%
dplyr::mutate(across(Curve, ~factor(.,
levels=c("u",
"a",
"d"))))
data_bsitar_uad_f <- data_bsitar_uad_f %>%
dplyr::mutate(Curve = dplyr::recode(Curve, u = "unadj",
a = "adj",
d = "pop.avg"))
data_sitar_bsitar_uad_f <- data_sitar_uad_f %>%
dplyr::bind_rows(., data_bsitar_uad_f)
data_all_alevs <- levels(data_sitar_uad_f$Curve)
which_uad_f <- data_sitar_bsitar_uad_f # data_sitar_uad_f
p <-
which_uad_f %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve) ) %>%
ggplot(., aes(x = .data[[xvar]]))
p +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[1]) %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[1], alpha = alphas[1],
show.legend = T) +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[1]) %>%
dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[1]) %>%
dplyr::mutate(Curve =
paste0(Curve, ".", idvar, ".", ranef_id_max_min[1])) %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[2], alpha = alphas[4],
show.legend = T) +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[2]) %>%
dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[1]) %>%
dplyr::mutate(Curve =
paste0(Curve, ".", idvar, ".", ranef_id_max_min[1])) %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[2],
color = colours[1], linewidth = linewidths[2], alpha = alphas[4],
show.legend = T) +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[1]) %>%
dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[2]) %>%
dplyr::mutate(Curve =
paste0(Curve, ".", idvar, ".", ranef_id_max_min[2]) ) %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[2], alpha = alphas[4],
show.legend = T) +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[2]) %>%
dplyr::filter(.data[[idvar]] %in% ranef_id_max_min[2]) %>%
dplyr::mutate(Curve =
paste0(Curve, ".", idvar, ".", ranef_id_max_min[2]) ) %>%
dplyr::mutate(groupby = interaction(.data[[idvar]], Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[2],
color = colours[1], linewidth = linewidths[2], alpha = alphas[4],
show.legend = T) +
geom_line(data = which_uad_f %>%
dplyr::filter(Curve==data_all_alevs[3]) %>%
dplyr::mutate(groupby = interaction(Curve)),
aes(x = .data[[xvar]], y = .data[[yvar]], group = groupby),
linetype = linetypes[1],
color = colours[1], linewidth = linewidths[2], alpha = alphas[4],
show.legend = T) +
facet_wrap(~Model) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1 +
theme(strip.text.x = element_text(size = 12, colour = "black", angle = 0)) +
theme(legend.title=element_blank())data_sitar_dx2 <- plot(model_frequ, opt = 'd', xlim = sitar::xaxsd(), ylim = sitar::yaxsd(), returndata = T)
data_sitar_dfx2 <- data_sitar_dx2 %>% data.frame()
data_bsitar_dx2 <- plot_curves(model_bayes, opt = 'd', returndata = T, newdata = data_sitar_dfx2, ipts = NULL, usesavedfuns = T, envir = globalenv()) %>%
dplyr::rename(distance = Estimate) %>%
dplyr::select(-dplyr::all_of(c('distance', 'Est.Error', 'Q2.5', 'Q97.5')))
data_all_ad <- data_all_a %>%
dplyr::bind_rows(., data_sitar_dx2 %>% dplyr::relocate(all_of(colnames(data))) %>%
dplyr::mutate(Curve = 'pop.avg_sitar')) %>%
dplyr::bind_rows(., data_bsitar_dx2 %>% dplyr::relocate(all_of(colnames(data))) %>%
dplyr::mutate(Curve = 'pop.avg_bsitar')) %>%
dplyr::mutate(Curve = as.factor(Curve))
data_all_ad <- data_all_ad %>%
dplyr::mutate(across(Curve, ~factor(.,
levels=c("observed",
"adjusted_sitar",
"adjusted_bsitar",
"pop.avg_sitar",
"pop.avg_bsitar" ))))
data_all_alevs <- levels(data_all_ad$Curve)
p <-
data_all_ad %>%
dplyr::mutate(groupby = interaction(id, Curve)) %>%
ggplot(., aes(x = age))
# p +
# geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[1]) %>%
# dplyr::mutate(groupby = interaction(id, Curve)),
# aes(x = age, y = height, group = groupby),
# linetype = 1, color = colours[1], , linewidth = linewidths[2],
# alpha = alphas[2], show.legend = F) +
# geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[2]) %>%
# dplyr::mutate(groupby = interaction(id, Curve)),
# aes(x = age, y = height, group = groupby),
# linetype = 1, color = colours[1], , linewidth = linewidths[2],
# alpha = alphas[2], show.legend = F) +
# geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[3]) %>%
# dplyr::mutate(groupby = interaction(id, Curve)),
# aes(x = age, y = height, group = groupby),
# linetype = 1, color = colours[1], , linewidth = linewidths[2],
# alpha = alphas[2], show.legend = F) +
# geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[4]) %>%
# dplyr::mutate(groupby = interaction(id, Curve)),
# aes(x = age, y = height, group = groupby),
# linetype = 1, color = colours[1], , linewidth = linewidths[2],
# alpha = alphas[2], show.legend = F) +
# geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[5]) %>%
# dplyr::mutate(groupby = interaction(id, Curve)),
# aes(x = age, y = height, group = groupby),
# linetype = 1, color = colours[1], , linewidth = linewidths[2],
# alpha = alphas[2], show.legend = F) +
# facet_wrap(~Curve) +
# scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
# theme_grids1 + theme_legends1
p +
geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[4]) %>%
dplyr::mutate(groupby = interaction(id, Curve)),
aes(x = age, y = height, group = groupby, linetype = Curve),
color = colours[1], linewidth = linewidths[2],
alpha = alphas[2], show.legend = T) +
geom_line(data = data_all_ad %>% dplyr::filter(Curve==data_all_alevs[5]) %>%
dplyr::mutate(groupby = interaction(id, Curve)),
aes(x = age, y = height, group = groupby, linetype = Curve),
color = colours[1], linewidth = linewidths[2],
alpha = alphas[2], show.legend = T) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1Estimated distance curve (Figure ??) shows that increase in height follows a sigmoid pattern with maximum gain in height occurring around 12 years of age. This is confirmed by the velocity curve (Figure ??) which shows a clear spurt in growth rate which peaks at around 11.7 years of age (see Population average (mean) estimates, Table ??).
data_all_dv %>%
dplyr::mutate(groupby = interaction(id, Model) ) %>%
ggplot(., aes(x = age)) +
geom_line(aes(x = age, y = velocity, group = groupby),
color = colours[1], alpha = alphas[2], linewidth = linewidths[2],
show.legend = TRUE) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1data_all_DV %>%
dplyr::mutate(groupby = interaction(id, Model) ) %>%
ggplot(., aes(x = age)) +
geom_line(aes(x = age, y = distance, group = groupby,
linetype = Model),
color = colours[1], alpha = alphas[2], linewidth = linewidths[2],
show.legend = T) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1data_all_DV %>%
dplyr::mutate(groupby = interaction(id, Model) ) %>%
ggplot(., aes(x = age)) +
geom_line(aes(x = age, y = velocity, group = groupby,
linetype = Model),
color = colours[1], alpha = alphas[2], linewidth = linewidths[2],
show.legend = T) +
scale_x_continuous(breaks = seq(xrange[1], xrange[2], 1), limits = xrange) +
theme_grids1 + theme_legends1Individual specific distance (Figure ??) and velocity(Figure ??) curves follow a pattern similar to the population average distance and velocity curves described earlier. Individual velocity curves (Figure ??) show that all individuals experience a pubertal growth spurt but the timing of the spurt varies between 10 and 14 years with varying growth pattern among individuals. Some individuals are consistently taller than average and others consistently shorter. While some start relatively short and become taller, others have opposite growth pattern i.e., they are taller at an early age and achieve less height in later years as compared to those who were short at an early age.
As velocity curves estimated by the sitar and bsitar models are very similar to each other (Figure ??), it is not surprising that both models provide almost identical estimates for the timing (i.e., age at peak growth velocity, APGV) and the intensity (i.e.,peak growth velocity, PGV) of the growth spurt (see Table ??).