A prototype of function for make a redcap downloaded db more "uniforme" and usable for data analyses

tidy_redcap.R

# functions -------------------------------------------------------
separated_event_fup <- function(db) {
  db |>
    dplyr::mutate(
      fup_id = .data[["ev_id"]] |>
        stringr::str_extract("(?<=fup_)\\d") |>
        as.integer(),
      ev_id = .data[["ev_id"]] |>
        stringr::str_extract("(?<=ev_)\\d") |>
        as.integer()
    ) |>
    dplyr::relocate(.data[["fup_id"]], .after = .data[["ev_id"]])

}

ordering_event_fup <- function(db) {
  db |>
    mutate(
      global_date = dplyr::coalesce(
        .data[["ev_date"]],
        .data[["fup_date"]]
      )
    ) |>
    dplyr::arrange(global_date) |>
    dplyr::select(-.data[["global_date"]])
}

tidy_event_fup <- function(db) {
  db |>
    ordering_event_fup() |>
    separated_event_fup() |>
    tidyr::fill(.data[["ev_id"]])
}

get_baseline_varnames <- function(db) {
  if (!"fup_id" %in% names(db)) {
    db <- tidy_event_fup(db)
  }

  db |>
    dplyr::filter(
      !is.na(.data[["fup_id"]]) & .data[["fup_id"]] != 0
    ) |>
    dplyr::select(where(~all(is.na(.x)))) |>
    names()
}


tidy_redcap <- function(db) {
  if (!"fup_id" %in% names(db)) {
    db <- db |> dplyr::with_groups(.data[["p_id"]], tidy_event_fup)
  }

  db |>
    dplyr::mutate(
      fup_id = dplyr::if_else(
        is.na(.data[["fup_id"]]),
        true =  0L,
        false = .data[["fup_id"]])
    ) |>
    dplyr::arrange(
      .data[["p_id"]], .data[["ev_id"]], .data[["fup_id"]]
    ) |>
    dplyr::with_groups(p_id,
      ~tidyr::fill(.x, get_baseline_varnames(.x))
    ) |>
    dplyr::filter(.data[["fup_id"]] != 0L)
}


# tests -----------------------------------------------------------
library(testthat)
library(tidyverse)
library(lubridate)

with_reporter(default_reporter(), {
  # global setup
  db <- tribble(
    ~p_id, ~ev_id,         ~b_date,    ~ev_date,    ~fup_date, ~epil, ~sex,
    1,     "ev_1",  "12-03-1951", "28-7-2001",           NA,    NA,  "male",
    1,    "fup_1",           NA,          NA,   "13-8-2001", FALSE,  NA,
    1,    "fup_2",           NA,          NA,  "18-8-2001",  TRUE,  NA,

    2,     "ev_1",  "27-05-1982", "13-01-2017",          NA,    NA,  "female",
    2,     "ev_2",  "27-05-1982", "30-11-2018",          NA,    NA,  "female",
    2,    "fup_1",           NA,           NA,"12-12-2018",  TRUE,  NA,

    # this one's event is before the second one of p_id 5, but it's
    # first (and unique) fup is after the fup of the second event of the
    # p_id 5. So, if `tidy_event_fup` doesn't run by patient the result
    # will be wrong!
    3,     "ev_1",  "12-08-1994", "13-11-2018",          NA,     NA, "female",
    3,    "fup_1",           NA,           NA,"18-12-2018",  FALSE,  NA,

    4,     "ev_1",  "12-03-1951", "27-7-2001",           NA,    NA, NA,
    4,    "fup_1",           NA,          NA,   "2-8-2001",  TRUE, NA,
    4,    "fup_2",           NA,          NA,  "11-8-2001",  TRUE, NA,

    5,     "ev_1",  "27-05-1982", "13-01-2017",          NA,    NA,  "female",
    5,    "fup_1",           NA,           NA,"22-1-2018",  TRUE,  NA,
    5,    "fup_2",           NA,           NA,"31-1-2018",  TRUE,  NA,
    5,     "ev_2",  "27-05-1982", "30-11-2018",          NA,    NA,  "female",
    5,    "fup_1",           NA,           NA,"12-12-2018",  TRUE,  NA,

  ) |>
    mutate(across(ends_with("date"), dmy))


  context("get_baseline_varnames")
  test_that("get_baseline_varnames", {
    # setup
    expected <- c("b_date", "ev_date", "sex")

    # evaluation
    result <- get_baseline_varnames(db)

    # tests
    result |> expect_equal(expected)
  })


  context("tidy_redcap")
  test_that("tidy_redcap works", {
    # setup
    expected <- tribble(
      ~p_id, ~ev_id, ~fup_id,      ~b_date,     ~ev_date,    ~fup_date, ~epil, ~sex,
      1,       1,       1,    "12-03-1951",  "28-7-2001",   "13-8-2001", FALSE,  "male",
      1,       1,       2,    "12-03-1951",  "28-7-2001",  "18-8-2001",  TRUE,  "male",
      2,       2,       1,    "27-05-1982", "30-11-2018", "12-12-2018",  TRUE,"female",
      3,       1,       1,    "12-08-1994", "13-11-2018", "18-12-2018", FALSE,"female",
      4,       1,       1,    "12-03-1951",  "27-7-2001",   "2-8-2001",  TRUE,      NA,
      4,       1,       2,    "12-03-1951",  "27-7-2001",  "11-8-2001",  TRUE,      NA,
      5,       1,       1,    "27-05-1982", "13-01-2017", "22-1-2018",  TRUE,"female",
      5,       1,       2,    "27-05-1982", "13-01-2017", "31-1-2018",  TRUE,"female",
      5,       2,       1,    "27-05-1982", "30-11-2018", "12-12-2018",  TRUE,"female"
    ) |>
      mutate(across(ends_with("date"), dmy))

    # evaluate
    results <- tidy_redcap(db)

    # tests
    results |> expect_s3_class("data.frame")
    results |> expect_equal(expected)
  })

  context("tidy_event_fup")
  test_that("separate_event_fup works", {
    # setup
    united <- tribble(
     ~row,  ~ev_id,
        1,  "ev_1",
        2,  "ev_2",
        3,  "ev_3",
        4,  "fup_1",
        5,  "fup_2",
        6,  "fup_3"
    )

    # evaluate
    results <- separated_event_fup(united)

    # tests
    expected <- tribble(
      ~row,  ~ev_id, ~fup_id,
         1,       1,     NA,
         2,       2,     NA,
         3,       3,     NA,
         4,      NA,      1,
         5,      NA,      2,
         6,      NA,      3
    )

    results |> expect_equal(expected)
  })



  test_that("ordering_event_fup works", {
    # setup
    unordered <- tribble(
      ~row,  ~ev_id,    ~ev_date,    ~fup_date,
      1,     "ev_1", "27-7-2001",           NA,
      2,     "ev_2", "3-1-2008",           NA,
      3,     "ev_3","30-11-2018",           NA,
      4,    "fup_1",          NA,  "18-1-2008",
      5,    "fup_1",          NA,   "2-8-2001",
      6,    "fup_2",          NA,  "12-8-2001"
    ) |>
      mutate(across(ends_with("date"), dmy))

    # evaluation
    result <- ordering_event_fup(unordered)

    # tests
    expected <- tribble(
      ~row,  ~ev_id,    ~ev_date,    ~fup_date,
      1,     "ev_1", "27-7-2001",           NA,
      5,    "fup_1",          NA,   "2-8-2001",
      6,    "fup_2",          NA,  "12-8-2001",
      2,     "ev_2", "3-1-2008",            NA,
      4,    "fup_1",          NA,  "18-1-2008",
      3,     "ev_3","30-11-2018",           NA
    ) |>
      mutate(across(ends_with("date"), dmy))

    result |> expect_equal(expected)

  })


  test_that("tidy_event_fup works", {
    untidy <- tribble(
      ~row,  ~ev_id,    ~ev_date,    ~fup_date,
      1,     "ev_1", "27-7-2001",           NA,
      2,     "ev_2", "3-1-2008",           NA,
      3,     "ev_3","30-11-2018",           NA,
      4,    "fup_1",          NA,  "18-1-2008",
      5,    "fup_1",          NA,   "2-8-2001",
      6,    "fup_2",          NA,  "12-8-2001"
    ) |>
      mutate(across(ends_with("date"), dmy))

    # evaluation
    result <- tidy_event_fup(untidy)

    # tests
    expected <- tribble(
      ~row,  ~ev_id, ~fup_id,     ~ev_date,    ~fup_date,
      1,          1,      NA,  "27-7-2001",           NA,
      5,          1,       1,           NA,   "2-8-2001",
      6,          1,       2,           NA,  "12-8-2001",
      2,          2,      NA,  "3-1-2008",            NA,
      4,          2,       1,          NA,  "18-1-2008",
      3,          3,      NA, "30-11-2018",           NA
    ) |>
      mutate(across(ends_with("date"), dmy))

    result |> expect_equal(expected)
  })

})

In tidy_redcap , the funciton tidy_event_fup should be applyed grouped by ID or the ordering (and the events filling could be wrong!!). Write an additional test to trigger that event too.

done