demo/changing_criterion.R

In miyamot0/fxl: 'fxl' Single Case Design Charting Package

library(fxl)

oldwd <- getwd()

if (require("here")) {
  setwd(paste(here::here("demo")))
}

set.seed(65535)

n_phases = 6

mults <- c(seq_len(n_phases - 2),
           n_phases - 3,
           n_phases - 2)

multiplier <- 12

n_sessions = rep(4, n_phases)
criteria = mults * multiplier
noise <- 2.5

seed_frame = data.frame(
  Phase = seq_len(n_phases),
  Sessions = n_sessions,
  Criterion = criteria
)

final_frame = data.frame(
  Phase = character(0),
  Session = numeric(0),
  Criterion = numeric(0)
)

for (index in seq_len(nrow(seed_frame))) {
  values <- seed_frame[index, ]

  novel_frame = data.frame(
    Phase = rep(as.character(values[1, "Phase"]), values[1, "Sessions"]),
    Session = rep(0, values[1, "Sessions"]),
    Criterion = rep(values[1, "Criterion"], values[1, "Sessions"])
  )

  final_frame <- rbind(final_frame,
                       novel_frame)
}

final_frame$Session <- seq_len(nrow(final_frame))
final_frame$Responding <- final_frame$Criterion + rnorm(nrow(final_frame),
                                                        0,
                                                        noise)

final_frame[1:4, "Responding"] <- rnorm(4,
                                        3,
                                        noise)

scr_plot(final_frame,
         aesthetics = var_map(
           x = Session,
           y = Responding,
           p = Phase
         ),
         mai = c(0.50, 0.50, 0.375, 0.25),
         omi = c(0.25, 0.25, 0.25, 0.25)
) |>
scr_yoverride(
  c(-2.5, 60),
  yticks = (0:6) * 10,
) |>
scr_xoverride(
  c(0, 25),
  xdelta = 10,
  xticks = c(
    1,
    seq(5, 25,
        by = 5
    )
  )
) |>
scr_label_phase(
  y = 62.5,
  cex = 1.25,
  labels = list(
    "Baseline" = list(
      x = 2.25
    ),
    "Intervention" = list(
      x = 7.5
    ),
    "Participant #1" = list(
      x = 25,
      y = 2.5,
      adj = 1,
      font = 2
    )
  )
) |>
scr_label_phase(
  color = "blue",
  cex = 1.25,
  labels = list(
    "A" = list(
      x = 6.5,
      y = 18,
      label = 24
    ),
    "B" = list(
      x = 10.5,
      y = 30,
      label = 36
    ),
    "C" = list(
      x = 14.5,
      y = 42,
      label = 48
    ),
    "D" = list(
      x = 18.5,
      y = 30,
      label = 36
    ),
    "E" = list(
      x = 22.5,
      y = 42,
      label = 48
    )
  )
) |>
scr_ylabel("Work Problems Completed",
           cex = 1.25) |>
scr_xlabel("Sessions",
           cex = 1.25) |>
scr_title("Changing Criterion Example Figure",
          cex = 1.5,
          face = 2) |>
scr_criterion_lines(
  lty = 1,
  size = 2,
  color = "blue",
  lines = list(
    "1" = list(
      level = 2 * multiplier,
      x1 = 5,
      x2 = 8
    ),
    "2" = list(
      level = 3 * multiplier,
      x1 = 9,
      x2 = 12
    ),
    "3" = list(
      level = 4 * multiplier,
      x1 = 13,
      x2 = 16
    ),
    "4" = list(
      level = 3 * multiplier,
      x1 = 17,
      x2 = 20
    ),
    "5" = list(
      level = 4 * multiplier,
      x1 = 21,
      x2 = 24
    )
  )
) |>
scr_points(cex = 1.25) |>
scr_lines() |>
scr_plines(
  lines = list(
    "A" = list(
      x1 = 4.5,
      y1 = 60,
      y2 = -2.5
    )
  )
)
# scr_save(
#   name = "../man/figures/changing_criterion.svg",
#   format = "svg",
#   height = 6,
#   width = 9
# ) |>
# scr_save(
#   name = "../man/figures/changing_criterion.png",
#   format = "png",
#   res = 600,
#   height = 6,
#   width = 9
# )

setwd(oldwd)