Multiple ITS control introduction for slope change (two-stage)

In multipleITScontrol: Interrupted Time Series with a Control and Multiple Interventions

knitr::opts_chunk$set(
  collapse = TRUE, 
  echo = FALSE,
  warning = FALSE,
  message = FALSE,
  comment = "#>"
)

library(multipleITScontrol)
library(dplyr)
library(ggplot2)
library(lubridate)
library(stringi)
library(rlang)
library(purrr)

phei_calendar <- function(df,
                          date_column = NULL,
                          factor_column = NULL,
                          colours = NULL,
                          title = "Placeholder: Please supply title or 'element_blank()' to `title` argument",
                          subtitle = "Placeholder: Please supply subtitle or 'element_blank()' to `subtitle` argument",
                          caption = "[e-mail]",
                          ncol,
                          ...) {


  date_column <- rlang::sym(date_column)
  factor_column <- rlang::sym(factor_column)

  df <- df |> dplyr::mutate(
    mon = lubridate::month(!!date_column, label = T, abbr = F),
    wkdy = weekdays(!!date_column,
                    abbreviate =
                      T
    ) |> forcats::fct_relevel("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"),
    day = lubridate::mday(!!date_column),
    week = stringi::stri_datetime_fields(!!date_column)$WeekOfMonth,
    year = lubridate::year(!!date_column),
    year_mon = zoo::as.yearmon(!!date_column, "%Y %m")
  ) |>
    dplyr::mutate(across(week, ~ dplyr::case_when(wkdy == "Sun" ~ week - 1,
                                           .default = as.numeric(week)
    )))

  df %>%
    ggplot2::ggplot(., ggplot2::aes(wkdy, week)) +
    # custom theme stuff below
    # geom_tile and facet_wrap will do all the heavy lifting
    ggplot2::geom_tile(
      alpha = 0.8,
      ggplot2::aes(fill = !!factor_column),
      color = "black", ...
    ) +
    ggplot2::facet_wrap(~year_mon, scales = "free_x", ncol = ncol) +
    ggplot2::geom_text(ggplot2::aes(label = day)) +
    # put your y-axis down, flip it, and reverse it
    ggplot2::scale_y_reverse(breaks = NULL) +
    # manually fill scale colors to something you like...
    ggplot2::scale_fill_manual(
      values = colours,
      na.value = "white",
      na.translate = FALSE
    ) +
    ggpubr::theme_pubclean() +
    ggplot2::theme(legend.position = "bottom") +
    ggplot2::labs(
      fill = "",
      x = "",
      y = "",
      title = element_blank(),
      caption = "[e-mail]"
    )
}

Usage

This is a basic example which shows you how to solve a common problem with two stage interrupted time series with a control for a slope hypothesis:

Background: Alpine Meadow School (AMS) and Forest Tiger School (FTS) have similar student demographics, including socioeconomic status, ethnicity, and academic performance. Both schools are part of Clarkson County's public school district.

Alpine Meadow School wants to trial out two new interventions to improve their school's reading comprehension score, and to compare post intervention results with the pre-intervention score.

Intervention 1: Implementing a New Reading Programme

• Objective: Improve reading comprehension and literacy rates among students.
• Start Date: September 1, 2025
• Duration: 6 months
• Description: The school introduces a new, evidence-based reading program that includes daily reading sessions, interactive reading activities, and regular assessments.
• Measurement: Reading comprehension scores from standardized tests administered weekly.

Intervention 2: Introducing Peer Tutoring Sessions

• Objective: Further enhance reading comprehension and literacy rates.
• Start Date: March 2, 2026 (immediately after the reading program ends)
• Duration: 6 months
• Description: The school implements peer tutoring sessions where older students tutor younger students in reading. These sessions are held twice a week and focus on reading comprehension strategies and practice.
• Measurement: Reading comprehension scores from standardized tests administered and marked weekly on Friday.

Controlled Interrupted Time Series Design (2 stage)

Step 1: Baseline Period

• Duration: 6 months (March 3, 2025 - August 31, 2025)
• Data Collection: Collect baseline data on reading comprehension scores administered weekly.

Step 2: Intervention 1 Period

• Duration: 6 months (September 1, 2025 - March 1, 2026)
• Data Collection: Continue collecting data on reading comprehension scores during the reading program administered weekly.

Step 3: Intervention 2 Period

• Duration: 6 months (March 2, 2026 - August 31, 2026)
• Data Collection: Collect data on reading comprehension scores during the peer tutoring sessions administered weekly.

The school hypothesizes there will be a slope effect for the interventions.

The calendar plot below summarises the timeline of the interventions:

tibble_data <- tibble::tibble(Date = seq(as.Date("2025-03-03"), as.Date("2026-08-30"), by = "day"),
  Period = dplyr::case_when(
    Date >= as.Date("2025-03-03") & Date <= as.Date("2025-08-31") ~ "Pre-intervention period",
    Date >= as.Date("2025-09-01") & Date <= as.Date("2026-03-01") ~ "Intervention 1) Reading Program",
    Date >= as.Date("2026-03-02") & Date <= as.Date("2026-08-30") ~ "Intervention 2) Peer Tutoring Sessions"
  ))

plot <- phei_calendar(
  tibble_data,
  date_column = "Date",
  "Period",
  colours = c("#3b5163", "#80bb77", "#afd0f0"),
  ncol = 3
) +
  theme(strip.text = element_text(size = rel(0.5)),
        axis.text = element_text(size = rel(0.5)),
        plot.caption = element_text(size = rel(0.5)),
        legend.text = element_text(size = rel(0.5)))


plot$layers[[2]]$aes_params$size <- 3

plot

Step 1) Loading data

Sample data can be loaded from the package for this scenario through the bundled dataset its_data_school.

DT::datatable(its_data_school, options = list(dom = 'tip'), rownames = FALSE)

This sample dataset demonstrates the format your own data should be in.

You can observe that in the Date column, that the dates are of equal distance between each element, and that there are two rows for each date, corresponding to either control or treatment in the group_var variable. control and treatment each have three periods, a Pre-intervention period detailing measurements of the outcome prior to any intervention, the first intervention detailed by Intervention 1) Reading Programme, and the second intervention, detailed by Intervention 2) Peer Tutoring Sessions.

Step 2) Transforming the data

The data frame should be passed to multipleITScontrol::tranform_data() with suitable arguments selected, specifying the names of the columns to the required variables and starting intervention time points.

transformed_data <- 
  multipleITScontrol::transform_data(df = its_data_school,
                                     time_var = "Date",
                                     group_var = "group_var",
                                     outcome_var = "score",
                                     intervention_dates = as.Date(c("2025-09-05", "2026-03-06")))

Returns the initial data frame with a few transformed variables needed for interrupted time series.

transformed_data

Step 3) Fitting ITS model

The transformed data is then fit using multipleITScontrol::fit_its_model(). Required arguments are transformed_data, which is simply an unmodified object created from multipleITScontrol::transform_data() in the step above; a defined impact model, with current options being either 'slope', `level, or 'levelslope', and the number of interventions.

fitted_ITS_model <- 
  multipleITScontrol::fit_its_model(transformed_data = transformed_data,
                                    impact_model = "slope",
                                    num_interventions = 2)

fitted_ITS_model

Gives a conventional model output from nlme::gls().

fitted_ITS_model

Step 4) Analysing ITS model

However, the coefficients given do not make intuitive sense to a lay person. We can call the package's multipleITScontrol::summary_its() function which modifies the summary output by renaming the coefficients to make them easier to interpret in the context of interrupted time series (ITS) analysis.

my_summary_its_model <- multipleITScontrol::summary_its(fitted_ITS_model)

my_summary_its_model

my_summary_its_model

sjPlot::tab_model(
  my_summary_its_model,
  dv.labels = "Average School Result",
  show.se = TRUE,
  collapse.se = TRUE,
  linebreak = FALSE,
  string.est = "Estimate (std. error)",
  string.ci = "95% CI",
  p.style = "numeric_stars"
)

sjPlot::tab_model(
  my_summary_its_model,
  dv.labels = "Average School Result",
  show.se = TRUE,
  collapse.se = TRUE,
  linebreak = FALSE,
  string.est = "Estimate (std. error)",
  string.ci = "95% CI",
  p.style = "numeric_stars"
)

a <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "A) Control y-axis intercept")]] |> round(2)
c <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "C) Control pre-intervention slope")]] |> round(2)
d <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "D) Pilot pre-intervention slope difference to control")]] |> round(2)
e <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "E) Control intervention 1 slope")]] |> round(2)
f <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "F) Pilot intervention 1 slope")]] |> round(2)
i <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "I) Control intervention 2 slope")]] |> round(2)
j <- coef(my_summary_its_model)[[which(names(coef(my_summary_its_model)) == "J) Pilot intervention 2 slope")]] |> round(2)

The predictor coefficients elucidate a few things:

Pre-intervention period:

At the start of the pre-intervention period, A) Control y-axis intercept represents the modelled starting mark of Forest Tiger School, r a.

C) Control pre-intervention slope describes the pre-intervention slope in the control group (r c).

D) Pilot pre-intervention slope difference to control describes the difference in the pre-intervention slope in the pilot group with the control group. This coefficient is additive to C) Control pre-intervention slope. I.e. r c (C) + r d (D) = r c+d is the pre-intervention slope per x-axis unit in the pilot data.

First intervention:

E) Control intervention 1 slope describes the slope change that occurs at the intervention break point in the control group at the start of the first intervention, compared to it's pre-intervention period (r e).

F) Pilot intervention 1 slope describes the difference in the slope change that occurs at the intervention timepoint in the pilot group for the first intervention compared to the control (r f).

These slope changes are pertinent to the slope gradients given in the pre-intervention period. Thus, we add the coefficients E) Control intervention 1 slope* to C) Control pre-intervention slope***: r e + r c = r e+c is the average increase for each x-axis unit during the first intervention for the control data.

To ascertain the slope for the pilot data, we add to the pre-intervention slope of the pilot data, the coefficients E) Control intervention 1 slope and F) Pilot intervention 1 slope. E (r e) + F (r f) + (C) r c + D r d (D) = r e+f+c+d is the average increase for each x-axis unit during the first intervention for the pilot data.

To ascertain statistical significance with the first intervention slope, we call the function's multipleITScontrol::slope_difference().

slope_difference(model = my_summary_its_model, intervention = 1)

slope_difference(model = my_summary_its_model, intervention = 1)

This brings up the key coefficients and values needed to compare the slopes of the pilot and control during the first intervention.

We identify that the slope difference between the treatment (Alpine Meadow School) and the control (Forest Tiger School) for the first intervention (Reading Programme) has a slope difference of 0.31 (95% CI: 0.29 - 0.32) per x-axis unit, with a p-value below 0.05, indicating statistical significance.

Second intervention:

I) Control intervention 2 slope describes the slope change that occurs at the intervention break point in the control group at the start of the second intervention (r i).

Thus, the modelled slope change in the second intervention is C) Control pre-intervention slope (r c) + E) Control intervention 1 slope (r e) + I) Control intervention 2 slope (r i) = r c+e+i is the average cumulative uptake increase for each x-axis unit during the second intervention for the control data.

J) Pilot intervention 2 slope describes the difference in the slope change that occurs at the intervention timepoint in the pilot group for the second intervention compared to the control. (r j).

These slope changes are pertinent to the slope gradients given in the pre-intervention and first intervention period. Thus, we add the coefficients C (r c) + D (r d) + E (r e) + F (r f) + I (r i) + J (r j) = r c+d+e+f+i+j is the average cumulative increase for each x-axis unit during the second intervention for the pilot data.

To ascertain statistical significance with the second intervention slope, we call the function's multipleITScontrol::slope_difference() again, but change the intervention parameter.

slope_difference(model = my_summary_its_model, intervention = 2)

slope_difference(model = my_summary_its_model, intervention = 2)

We identify that the slope difference between the treatment (Alpine Meadow School) and the control (Forest Tiger School) for the second intervention (Reading Programme) has a slope difference of 0.23 (95% CI: 0.22 - 0.25) per x-axis unit, with a p-value below 0.05, indicating statistical significance. The effect has been attenuated compared to the first intervention, and this is evident from the plot in step 6.

Step 5) Fitting Predictions

We can fit predictions with the created model which project the pre-intervention period into the post-intervention period by using the model coefficients using multipleITScontrol::generate_predictions().

transformed_data_with_predictions <- generate_predictions(transformed_data, fitted_ITS_model)

transformed_data_with_predictions

DT::datatable(transformed_data_with_predictions, options = list(dom = 'tip', scrollX = TRUE), rownames = FALSE)

Step 6) Plotting the results

We can use the predicted values and map the segmented regression lines which compare whether an intervention had a statistically significant difference.

its_plot(model = my_summary_its_model,
         data_with_predictions = transformed_data_with_predictions,
         time_var = "time",
         intervention_dates = as.Date(c("2025-09-05", "2026-03-06")), 
         y_axis = "Reading Comprehension Score")

multipleITScontrol documentation built on April 4, 2026, 1:08 a.m.