Documentation for fxl
Drawing Multiple Baseline Designs in R: Communication Training across Settings
Written by Shawn P. Gilroy (Last Updated: 2024-06-01)Multiple Baseline DesignPhase Change Lines
This post focuses on drawing a Multiple Baseline Design, one of the most commonly-used tools for evaluating interventions in schools. The figure and data for this example is derived from Gilroy et al. (2021), a study using features of Behavioral Economics in intervention contexts.
This study used a multiple baseline design, with many elements of within-panel reversal, to assess the degree to which work performance gleaned from an evaluation of reinforcer efficacy corresponded with work output in a more extended evaluation.
The final figure for this work is illustrated below:
Data Structure
Data for this study focused on two separate, but related change measures–Responding, which was a count of work responses, and Reinforcers, which represented the number of reinforcers produced in the session. These are two measures observed across all phase (mostly), so it makes the most sense to have a separate column for each.
A snapshot of the relevant data is shown below:
head(csv_data)
## Participant Session Condition Responding Reinforcers
## 1 John 1 Baseline 0 NA
## 2 John 2 Baseline 0 NA
## 3 John 3 Baseline 0 NA
## 4 John 4 PR-Lowest 8 8
## 5 John 5 PR-Lowest 5 5
## 6 John 6 PR-Lowest 7 7
Plot Elements
There is a considerable amount of detail in this plot, especially with the addition of a legend rather than a text/arrow annotation (either would be fine, IMHO). Specifically, there is significant variability across ranges on the Y axis for individuals, which will require some adjustment for clarity.
The unmodified raw output of the data is presented below:
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers))
Axis and Tick Styling
Specific Y-axis ranges can be adjusted by supplying an keyed list (key must match facet entry; i.e., Participant Name) instead of a single min-max/upper-lower vector. The resulting figure does a better job of revealed relative changes across panels.
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers)) |>
scr_xoverride(c(0.5, 25),
xticks = 1:25
) |>
scr_yoverride(list(
"John" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
),
"Anthony" = list(
y0 = -0.5,
y1 = 10,
yticks = c(0, 5, 10)
),
"Charles" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
)
),
ydelta = 5
)
Annotations
The multiple baseline design requires some sophisticated methods to ensure that details across one panel are connected correctly across different panels.
Phase Change Lines
Annotations for this type of figure require a specialized type of phase change line, one that accounts for intersections across other panels. The scr_plines_mbd function is similar to the scr_plines function, but each keyed entry is itself a keyed entry (using facet names as the relevant keys).
The result of this is a figure that closely mirrors the same conventions scr_plines. The result of this is illustrated below:
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers)) |>
scr_xoverride(c(0.5, 25),
xticks = 1:25
) |>
scr_yoverride(list(
"John" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
),
"Anthony" = list(
y0 = -0.5,
y1 = 10,
yticks = c(0, 5, 10)
),
"Charles" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
)
),
ydelta = 5
) |>
scr_plines_mbd(lines = list(
"A" = list(
"John" = list(
x1 = 3.5,
y1 = 20
),
"Anthony" = list(
x1 = 3.5,
y1 = 10
),
"Charles" = list(
x1 = 3.5,
y1 = 20,
y2 = -1
)
),
"B" = list(
"John" = list(
x1 = 6.5,
y1 = 20
),
"Anthony" = list(
x1 = 6.5,
y1 = 10
),
"Charles" = list(
x1 = 8.5,
y1 = 20,
y2 = -1
)
),
"C" = list(
"John" = list(
x1 = 9.5,
y1 = 20
),
"Anthony" = list(
x1 = 9.5,
y1 = 10
),
"Charles" = list(
x1 = 11.5,
y1 = 20,
y2 = -1
)
),
"D" = list(
"John" = list(
x1 = 12.5,
y1 = 20
),
"Anthony" = list(
x1 = 16.5,
y1 = 10
),
"Charles" = list(
x1 = 16.5,
y1 = 20,
y2 = -1
)
),
"E" = list(
"John" = list(
x1 = 15.5,
y1 = 20,
y2 = 2
),
"Anthony" = list(
x1 = 22.5,
y1 = 10
),
"Charles" = list(
x1 = 19.5,
y1 = 20,
y2 = -1
)
)
))
Phase Labels (Text)
Like previous figures, we can add labels to the top-most panel using scr_label_phase to distinguish phases and scr_label_facet to add participant-specific labels.
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers)) |>
scr_xoverride(c(0.5, 25),
xticks = 1:25
) |>
scr_yoverride(list(
"John" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
),
"Anthony" = list(
y0 = -0.5,
y1 = 10,
yticks = c(0, 5, 10)
),
"Charles" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
)
),
ydelta = 5
) |>
scr_plines_mbd(lines = list(
"A" = list(
"John" = list(
x1 = 3.5,
y1 = 20
),
"Anthony" = list(
x1 = 3.5,
y1 = 10
),
"Charles" = list(
x1 = 3.5,
y1 = 20,
y2 = -1
)
),
"B" = list(
"John" = list(
x1 = 6.5,
y1 = 20
),
"Anthony" = list(
x1 = 6.5,
y1 = 10
),
"Charles" = list(
x1 = 8.5,
y1 = 20,
y2 = -1
)
),
"C" = list(
"John" = list(
x1 = 9.5,
y1 = 20
),
"Anthony" = list(
x1 = 9.5,
y1 = 10
),
"Charles" = list(
x1 = 11.5,
y1 = 20,
y2 = -1
)
),
"D" = list(
"John" = list(
x1 = 12.5,
y1 = 20
),
"Anthony" = list(
x1 = 16.5,
y1 = 10
),
"Charles" = list(
x1 = 16.5,
y1 = 20,
y2 = -1
)
),
"E" = list(
"John" = list(
x1 = 15.5,
y1 = 20,
y2 = 2
),
"Anthony" = list(
x1 = 22.5,
y1 = 10
),
"Charles" = list(
x1 = 19.5,
y1 = 20,
y2 = -1
)
)
)) |>
scr_label_phase(facet = "John",
cex = 1.25,
adj = 0.5,
y = 20,
labels = list(
"Baseline" = list(
x = 2
),
"FR-Lowest" = list(
x = 5
),
"Baseline" = list(
x = 8
),
"FR-Inelastic" = list(
x = 11
),
"FR-Elastic" = list(
x = 14
),
"FR-Inelastic" = list(
x = 18
))) |>
scr_label_facet(cex = 1.5,
adj = 1,
x = 25,
labels = list(
"John" = list(
y = 2.5
),
"Anthony" = list(
y = 12
),
"Charles" = list(
y = 25
)))
Axis Titles
Titles for the axes are inferred from the column names, but there’s more than one type of data included on the Y axis. We can edit and style the titles to make the figure more informative using the scr_xlabel, scr_ylabel, and scr_title functions.
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers)) |>
scr_xoverride(c(0.5, 25),
xticks = 1:25
) |>
scr_yoverride(list(
"John" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
),
"Anthony" = list(
y0 = -0.5,
y1 = 10,
yticks = c(0, 5, 10)
),
"Charles" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
)
),
ydelta = 5
) |>
scr_plines_mbd(lines = list(
"A" = list(
"John" = list(
x1 = 3.5,
y1 = 20
),
"Anthony" = list(
x1 = 3.5,
y1 = 10
),
"Charles" = list(
x1 = 3.5,
y1 = 20,
y2 = -1
)
),
"B" = list(
"John" = list(
x1 = 6.5,
y1 = 20
),
"Anthony" = list(
x1 = 6.5,
y1 = 10
),
"Charles" = list(
x1 = 8.5,
y1 = 20,
y2 = -1
)
),
"C" = list(
"John" = list(
x1 = 9.5,
y1 = 20
),
"Anthony" = list(
x1 = 9.5,
y1 = 10
),
"Charles" = list(
x1 = 11.5,
y1 = 20,
y2 = -1
)
),
"D" = list(
"John" = list(
x1 = 12.5,
y1 = 20
),
"Anthony" = list(
x1 = 16.5,
y1 = 10
),
"Charles" = list(
x1 = 16.5,
y1 = 20,
y2 = -1
)
),
"E" = list(
"John" = list(
x1 = 15.5,
y1 = 20,
y2 = 2
),
"Anthony" = list(
x1 = 22.5,
y1 = 10
),
"Charles" = list(
x1 = 19.5,
y1 = 20,
y2 = -1
)
)
)) |>
scr_label_phase(facet = "John",
cex = 1.25,
adj = 0.5,
y = 20,
labels = list(
"Baseline" = list(
x = 2
),
"FR-Lowest" = list(
x = 5
),
"Baseline" = list(
x = 8
),
"FR-Inelastic" = list(
x = 11
),
"FR-Elastic" = list(
x = 14
),
"FR-Inelastic" = list(
x = 18
))) |>
scr_label_facet(cex = 1.5,
adj = 1,
x = 25,
labels = list(
"John" = list(
y = 2.5
),
"Anthony" = list(
y = 12
),
"Charles" = list(
y = 25
))) |>
scr_xlabel("Session") |>
scr_ylabel("Frequency (Responses, Reinforcers Delivered)",
adj = 0.55) |>
scr_title("Individual Evaluations of Reinforcer Efficacy and Elasticity across Reinforcers")
Legend
The legend is the final details necessary. The specification of the legend is possible using the scr_legend function, which must be specified on a specific facet. The legend does not reference the markers/lines featured, and instead, these are all created manually in the interest of complete control.
With this added, the figure from Gilroy et al. (2021) is fully re-created!
scr_plot(csv_data,
aesthetics = var_map(x = Session,
y = Responding,
p = Condition,
facet = Participant),
family = "Times New Roman"
) |>
scr_lines() |>
scr_lines(lty = 2,
mapping = list(x = Session,
y = Reinforcers)
) |>
scr_points(cex = 2.4) |>
scr_points(cex = 2,
pch = 24,
color = c("black"),
fill = c("white"),
mapping = list(x = Session,
y = Reinforcers)) |>
scr_xoverride(c(0.5, 25),
xticks = 1:25
) |>
scr_yoverride(list(
"John" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
),
"Anthony" = list(
y0 = -0.5,
y1 = 10,
yticks = c(0, 5, 10)
),
"Charles" = list(
y0 = -1,
y1 = 20,
yticks = c(0, 5, 10, 15, 20)
)
),
ydelta = 5
) |>
scr_plines_mbd(lines = list(
"A" = list(
"John" = list(
x1 = 3.5,
y1 = 20
),
"Anthony" = list(
x1 = 3.5,
y1 = 10
),
"Charles" = list(
x1 = 3.5,
y1 = 20,
y2 = -1
)
),
"B" = list(
"John" = list(
x1 = 6.5,
y1 = 20
),
"Anthony" = list(
x1 = 6.5,
y1 = 10
),
"Charles" = list(
x1 = 8.5,
y1 = 20,
y2 = -1
)
),
"C" = list(
"John" = list(
x1 = 9.5,
y1 = 20
),
"Anthony" = list(
x1 = 9.5,
y1 = 10
),
"Charles" = list(
x1 = 11.5,
y1 = 20,
y2 = -1
)
),
"D" = list(
"John" = list(
x1 = 12.5,
y1 = 20
),
"Anthony" = list(
x1 = 16.5,
y1 = 10
),
"Charles" = list(
x1 = 16.5,
y1 = 20,
y2 = -1
)
),
"E" = list(
"John" = list(
x1 = 15.5,
y1 = 20,
y2 = 2
),
"Anthony" = list(
x1 = 22.5,
y1 = 10
),
"Charles" = list(
x1 = 19.5,
y1 = 20,
y2 = -1
)
)
)) |>
scr_label_phase(facet = "John",
cex = 1.25,
adj = 0.5,
y = 20,
labels = list(
"Baseline" = list(
x = 2
),
"FR-Lowest" = list(
x = 5
),
"Baseline" = list(
x = 8
),
"FR-Inelastic" = list(
x = 11
),
"FR-Elastic" = list(
x = 14
),
"FR-Inelastic" = list(
x = 18
))) |>
scr_label_facet(cex = 1.5,
adj = 1,
x = 25,
labels = list(
"John" = list(
y = 2.5
),
"Anthony" = list(
y = 12
),
"Charles" = list(
y = 25
))) |>
scr_xlabel("Session") |>
scr_ylabel("Frequency (Responses, Reinforcers Delivered)",
adj = 0.55) |>
scr_title("Individual Evaluations of Reinforcer Efficacy and Elasticity across Reinforcers") |>
scr_legend(panel = "John",
position = "right",
legend = c("Responses Observed",
"Reinforcers Produced"),
col = c("black",
"black"),
lty = c(1,
2),
pch = c(19,
24),
bg = c("black",
"black"),
pt_bg = c("black",
"white"),
bty = "n",
pt_cex = 2.25,
cex = 1.25,
text_col = "black",
horiz = FALSE,
box_lty = 0)
