Merge pull request #13 from RConsortium/2-write-unit-tests-for-the-fu…

…nctions

Unit tests for pilot3utils function

.lintr

@@ -1,2 +1,2 @@
-linters: with_defaults(line_length_linter(150), object_usage_linter=NULL, cyclocomp_linter(complexity_limit = 20))
+linters: linters_with_defaults(line_length_linter(150), object_usage_linter=NULL, cyclocomp_linter(complexity_limit = 20))
 exclusions: list("R/data.R")

DESCRIPTION

@@ -22,7 +22,7 @@ Suggests:
     fs,
     ggplot2,
     haven,
-    testthat,
+    testthat (>= 3.0.0),
     knitr,
     pharmaRTF,
     r2rtf,
@@ -37,3 +37,4 @@ Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)  
 RoxygenNote: 7.2.3
+Config/testthat/edition: 3

R/example.r

@@ -0,0 +1,24 @@
+#' Retrieve paths to built-in example test files
+#'
+#' `testthat_examples()` retrieves path to directory of test files,
+#' `testthat_example()` retrieves path to a single test file.
+#'
+#' @keywords internal
+#' @param filename Name of test file
+#' @export
+#' @examples
+#' dir(testthat_examples())
+#' testthat_example("success")
+testthat_examples <- function() {
+  system.file("examples", package = "testthat")
+}
+
+#' @export
+#' @rdname testthat_examples
+testthat_example <- function(filename) {
+  system.file(
+    "examples", paste0("test-", filename, ".R"),
+    package = "testthat",
+    mustWork = TRUE
+  )
+}

tests/testthat.r

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(pilot3utils)
+
+test_check("pilot3utils")

tests/testthat/_snaps/Tplyr_helpers.md

@@ -0,0 +1,24 @@
+# nest_rowlabels works
+
+    Code
+      nest_rowlabels(.data)
+    Output
+      # A tibble: 12 x 7
+         row_label            var1_placebo    var1_x~1 var1_~2 ord_l~3 ord_l~4 ord_l~5
+         <chr>                <chr>           <chr>    <chr>     <dbl>   <dbl>   <dbl>
+       1 Baseline             ""              ""       ""            1       0       0
+       2 n                    "79"            "74"     "81"          1       1       1
+       3 Mean (SD)            "24.1 (12.19)"  "21.3 (~ "24.4 ~       1       1       2
+       4 Median (Range)       "21.0 (  5;61)" "18.0 (~ "21.0 ~       1       1       3
+       5 Week 24              ""              ""       ""            2       0       0
+       6 n                    "79"            "74"     "81"          2       1       1
+       7 Mean (SD)            "26.7 (13.79)"  "22.8 (~ "26.4 ~       2       1       2
+       8 Median (Range)       "24.0 (  5;62)" "20.0 (~ "25.0 ~       2       1       3
+       9 Change from Baseline ""              ""       ""            3       0       0
+      10 n                    "79"            "74"     "81"          3       1       1
+      11 Mean (SD)            " 2.5 ( 5.80)"  " 1.5 (~ " 2.0 ~       3       1       2
+      12 Median (Range)       " 2.0 (-11;16)" " 1.0 (~ " 2.0 ~       3       1       3
+      # ... with abbreviated variable names 1: var1_xanomeline_high_dose,
+      #   2: var1_xanomeline_low_dose, 3: ord_layer_index, 4: ord_layer_1,
+      #   5: ord_layer_2
+

tests/testthat/_snaps/adam_functions.md

@@ -0,0 +1,28 @@
+# format_dcsreas works
+
+    Code
+      format_dcsreas("WITHDRAWAL BY SUBJECT")
+    Output
+      [1] "Withdrew Consent"
+
+# format_eosstt works
+
+    Code
+      format_eosstt("SCREENING NOT COMPLETED")
+    Output
+      [1] "NOT STARTED"
+
+# format_sitegr1 works
+
+    Code
+      format_sitegr1("714")
+    Output
+      [1] "900"
+
+# round_sas works
+
+    Code
+      round_sas(10.56, digits = 0)
+    Output
+      [1] 11
+

tests/testthat/_snaps/eff_models.md

@@ -0,0 +1,54 @@
+# efficacy models works
+
+    Code
+      efficacy_models(adas, "CHG", 24)
+    Output
+      # A tibble: 9 x 3
+        row_label                            `var1_Xanomeline Low Dose` var1_Xanomel~1
+        <chr>                                <chr>                      <chr>         
+      1 "p-value(Dose Response) [1][2]"       <NA>                      "   0.245    "
+      2 ""                                    <NA>                      ""            
+      3 "p-value(Xan - Placebo) [1][3]"      "   0.569    "             "   0.233    "
+      4 "  Diff of LS Means (SE)"            "-0.5 (0.82)"              "-1.0 (0.84)" 
+      5 "  95% CI"                           "(-2.1;1.1)"               "(-2.7;0.7)"  
+      6 ""                                   ""                         ""            
+      7 "p-value(Xan High - Xan Low) [1][3]"  <NA>                      "   0.520    "
+      8 "  Diff of LS Means (SE)"             <NA>                      "-0.5 (0.84)" 
+      9 "  95% CI"                            <NA>                      "(-2.2;1.1)"  
+      # ... with abbreviated variable name 1: `var1_Xanomeline High Dose`
+
+---
+
+    WAoAAAACAAQCAwACAwAAAAMTAAAAAwAAABAAAAAJAAQACQAAAB1wLXZhbHVlKERvc2UgUmVz
+    cG9uc2UpIFsxXVsyXQAEAAkAAAAAAAQACQAAAB1wLXZhbHVlKFhhbiAtIFBsYWNlYm8pIFsx
+    XVszXQAEAAkAAAAXICBEaWZmIG9mIExTIE1lYW5zIChTRSkABAAJAAAACCAgOTUlIENJAAQA
+    CQAAAAAABAAJAAAAInAtdmFsdWUoWGFuIEhpZ2ggLSBYYW4gTG93KSBbMV1bM10ABAAJAAAA
+    FyAgRGlmZiBvZiBMUyBNZWFucyAoU0UpAAQACQAAAAggIDk1JSBDSQAAABAAAAAJAAQACQAA
+    AAJOQQAEAAkAAAACTkEABAAJAAAADCAgIDAuNTY5ICAgIAAEAAkAAAALLTAuNSAoMC44MikA
+    BAAJAAAACigtMi4xOzEuMSkABAAJAAAAAAAEAAkAAAACTkEABAAJAAAAAk5BAAQACQAAAAJO
+    QQAAABAAAAAJAAQACQAAAAwgICAwLjI0NSAgICAABAAJAAAAAAAEAAkAAAAMICAgMC4yMzMg
+    ICAgAAQACQAAAAstMS4wICgwLjg0KQAEAAkAAAAKKC0yLjc7MC43KQAEAAkAAAAAAAQACQAA
+    AAwgICAwLjUyMCAgICAABAAJAAAACy0wLjUgKDAuODQpAAQACQAAAAooLTIuMjsxLjEpAAAE
+    AgAAAAEABAAJAAAABWNsYXNzAAAAEAAAAAMABAAJAAAABnRibF9kZgAEAAkAAAADdGJsAAQA
+    CQAAAApkYXRhLmZyYW1lAAAEAgAAAAEABAAJAAAACXJvdy5uYW1lcwAAAA0AAAACgAAAAP//
+    //cAAAQCAAAAAQAEAAkAAAAFbmFtZXMAAAAQAAAAAwAEAAkAAAAJcm93X2xhYmVsAAQACQAA
+    ABl+dmFyMV9YYW5vbWVsaW5lIExvdyBEb3NlAAQACQAAABp+dmFyMV9YYW5vbWVsaW5lIEhp
+    Z2ggRG9zZQAAAP4=
+
+---
+
+    WAoAAAACAAQCAwACAwAAAAMTAAAAAwAAABAAAAAJAAQACQAAAB1wLXZhbHVlKERvc2UgUmVz
+    cG9uc2UpIFsxXVsyXQAEAAkAAAAAAAQACQAAAB1wLXZhbHVlKFhhbiAtIFBsYWNlYm8pIFsx
+    XVszXQAEAAkAAAAXICBEaWZmIG9mIExTIE1lYW5zIChTRSkABAAJAAAACCAgOTUlIENJAAQA
+    CQAAAAAABAAJAAAAInAtdmFsdWUoWGFuIEhpZ2ggLSBYYW4gTG93KSBbMV1bM10ABAAJAAAA
+    FyAgRGlmZiBvZiBMUyBNZWFucyAoU0UpAAQACQAAAAggIDk1JSBDSQAAABAAAAAJAAAACf//
+    //8AAAAJ/////wAEAAkAAAAMICAgMC41NjkgICAgAAQACQAAAAstMC41ICgwLjgyKQAEAAkA
+    AAAKKC0yLjE7MS4xKQAEAAkAAAAAAAAACf////8AAAAJ/////wAAAAn/////AAAAEAAAAAkA
+    BAAJAAAADCAgIDAuMjQ1ICAgIAAEAAkAAAAAAAQACQAAAAwgICAwLjIzMyAgICAABAAJAAAA
+    Cy0xLjAgKDAuODQpAAQACQAAAAooLTIuNzswLjcpAAQACQAAAAAABAAJAAAADCAgIDAuNTIw
+    ICAgIAAEAAkAAAALLTAuNSAoMC44NCkABAAJAAAACigtMi4yOzEuMSkAAAQCAAAAAQAEAAkA
+    AAAFbmFtZXMAAAAQAAAAAwAEAAkAAAAJcm93X2xhYmVsAAQACQAAABh2YXIxX1hhbm9tZWxp
+    bmUgTG93IERvc2UABAAJAAAAGXZhcjFfWGFub21lbGluZSBIaWdoIERvc2UAAAQCAAAAAQAE
+    AAkAAAAJcm93Lm5hbWVzAAAADQAAAAKAAAAA////9wAABAIAAAABAAQACQAAAAVjbGFzcwAA
+    ABAAAAADAAQACQAAAAZ0YmxfZGYABAAJAAAAA3RibAAEAAkAAAAKZGF0YS5mcmFtZQAAAP4=
+

tests/testthat/_snaps/fmt.md

@@ -0,0 +1,28 @@
+# fmt_num works
+
+    Code
+      fmt_num(4.25, digits = 3)
+    Output
+      [1] "  4.250"
+
+# fmt_est works
+
+    Code
+      fmt_est(1.25, 0.5)
+    Output
+      [1] "  1.2 ( 0.50)"
+
+# fmt_pval works
+
+    Code
+      fmt_pval(0.52, digits = 3)
+    Output
+      [1] "  0.520"
+
+# fmt_ci works
+
+    Code
+      fmt_ci(-2.5, -0.09, 2.07)
+    Output
+      [1] "-2.50 (-0.09, 2.07)"
+

tests/testthat/_snaps/helpers.md

@@ -0,0 +1,51 @@
+# pad_row works
+
+    Code
+      pad_row(.data)
+    Output
+      # A tibble: 7 x 5
+        STUDYID  USUBJID       PARAMCD PARAM                             AVISIT    
+        <chr>    <chr>         <chr>   <chr>                             <chr>     
+      1 "TEST01" "01-701-1015" "DIABP" "Diastolic Blood Pressure (mmHg)" "BASELINE"
+      2 "TEST01" "01-701-1015" "DIABP" "Diastolic Blood Pressure (mmHg)" "WEEK 2"  
+      3 "TEST01" "01-701-1015" "SYSBP" "Systolic Blood Pressure (mmHg)"  "BASELINE"
+      4 "TEST01" "01-701-1015" "SYSBP" "Systolic Blood Pressure (mmHg)"  "WEEK 2"  
+      5 "TEST01" "01-701-1028" "DIABP" "Diastolic Blood Pressure (mmHg)" "BASELINE"
+      6 "TEST01" "01-701-1028" "SYSBP" "Systolic Blood Pressure (mmHg)"  "BASELINE"
+      7 ""       ""            ""      ""                                ""        
+
+# num_fmt works
+
+    Code
+      num_fmt(5, digits = 0, size = 10, int_len = 3)
+    Output
+      [1] "  5       "
+
+# str_pad works
+
+    Code
+      str_pad("pilot3", 7, "left")
+    Output
+      [1] " pilot3"
+
+# nrow works
+
+    Code
+      nrow(matrix(1:12, 3, 4))
+    Output
+      [1] 3
+
+# round works
+
+    Code
+      round(c(0.3, 1.03, 2.67, 5, 8.91), digits = 1)
+    Output
+      [1] 0.3 1.0 2.7 5.0 8.9
+
+# format works
+
+    Code
+      format("GFG", width = 8, justify = "l")
+    Output
+      [1] "GFG     "
+

tests/testthat/test-Tplyr_helpers.r

@@ -0,0 +1,41 @@
+test_that("Pilot3 can use the testthat 3e", {
+  local_edition(3)
+  expect_true(TRUE)
+})
+
+test_that("nest_rowlabels works", {
+  .data <- tibble::tribble(
+    ~row_label1, ~row_label2, ~var1_placebo, ~var1_xanomeline_high_dose, ~var1_xanomeline_low_dose, ~ord_layer_index, ~ord_layer_1, ~ord_layer_2,
+    "Baseline", "n", "79", "74", "81", 1, 1, 1,
+    "Baseline", "Mean (SD)", "24.1 (12.19)", "21.3 (11.74)", "24.4 (12.92)", 1, 1, 2,
+    "Baseline", "Median (Range)", "21.0 (  5;61)", "18.0 (  3;57)", "21.0 (  5;57)", 1, 1, 3,
+    "Week 24", "n", "79", "74", "81", 2, 1, 1,
+    "Week 24", "Mean (SD)", "26.7 (13.79)", "22.8 (12.48)", "26.4 (13.18)", 2, 1, 2,
+    "Week 24", "Median (Range)", "24.0 (  5;62)", "20.0 (  3;62)", "25.0 (  6;62)", 2, 1, 3,
+    "Change from Baseline", "n", "79", "74", "81", 3, 1, 1,
+    "Change from Baseline", "Mean (SD)", " 2.5 ( 5.80)", " 1.5 ( 4.26)", " 2.0 ( 5.55)", 3, 1, 2,
+    "Change from Baseline", "Median (Range)", " 2.0 (-11;16)", " 1.0 ( -7;13)", " 2.0 (-11;17)", 3, 1, 3
+  )
+  .nest_rowlabels <- tibble::tribble(
+    ~row_label, ~var1_placebo, ~var1_xanomeline_high_dose, ~var1_xanomeline_low_dose, ~ord_layer_index, ~ord_layer_1, ~ord_layer_2,
+    "Baseline", "", "", "", 1, 0, 0,
+    "n", "79", "74", "81",  1, 1, 1,
+    "Mean (SD)", "24.1 (12.19)", "21.3 (11.74)", "24.4 (12.92)",  1, 1, 2,
+    "Median (Range)", "21.0 (  5;61)", "18.0 (  3;57)", "21.0 (  5;57)",  1, 1, 3,
+    "Week 24", "", "", "", 2, 0, 0,
+    "n", "79", "74", "81",  2, 1, 1,
+    "Mean (SD)", "26.7 (13.79)", "22.8 (12.48)", "26.4 (13.18)",  2, 1, 2,
+    "Median (Range)", "24.0 (  5;62)", "20.0 (  3;62)", "25.0 (  6;62)",  2, 1, 3,
+    "Change from Baseline", "", "", "", 3, 0, 0,
+    "n", "79", "74", "81",  3, 1, 1,
+    "Mean (SD)", " 2.5 ( 5.80)", " 1.5 ( 4.26)", " 2.0 ( 5.55)",  3, 1, 2,
+    "Median (Range)", " 2.0 (-11;16)", " 1.0 ( -7;13)", " 2.0 (-11;17)",  3, 1, 3
+  )
+  expect_equal(nrow(.data),  9)
+  expect_equal(nrow(.nest_rowlabels),  12)
+  expect_equal(nrow(nest_rowlabels(.data)),  12)
+  expect_s3_class(nest_rowlabels(.data), "tbl_df")
+  expect_snapshot(nest_rowlabels(.data), dplyr::select(.nest_rowlabels))
+  expect_length(nrow(.data), 1)
+  expect_length(nrow(.nest_rowlabels), 1)
+})

tests/testthat/test-adam_functions.r

@@ -0,0 +1,67 @@
+test_that("Pilot3 can use the testthat 3e", {
+  local_edition(3)
+  expect_true(TRUE)
+})
+
+test_that("format_dcsreas works", {
+  .data_format_dcsreas <- tibble::tribble(
+    ~OUTPUT,
+    "Withdrew Consent"
+  )
+  expect_equal(format_dcsreas("ADVERSE EVENT"), "Adverse Event")
+  expect_equal(format_dcsreas("STUDY TERMINATED BY SPONSOR"), "Sponsor Decision")
+  expect_equal(format_dcsreas("DEATH"), "Death")
+  expect_equal(format_dcsreas("WITHDRAWAL BY SUBJECT"), "Withdrew Consent")
+  expect_snapshot(format_dcsreas("WITHDRAWAL BY SUBJECT"), dplyr::select(.data_format_dcsreas))
+  expect_equal(format_dcsreas("PHYSICIAN DECISION"), "Physician Decision")
+  expect_equal(format_dcsreas("LACK OF EFFICACY"), "Lack of Efficacy")
+  expect_equal(format_dcsreas("PROTOCOL VIOLATION"), "Protocol Violation")
+  expect_equal(format_dcsreas("LOST TO FOLLOW-UP"), "Lost to Follow-up")
+  expect_length(format_dcsreas("ADVERSE"), 1)
+  expect_length(format_dcsreas("ADVERSE EVENT"), 1)
+  expect_length(format_dcsreas(NA), 1)
+})
+
+test_that("format_eosstt works", {
+  .data_format_eosstt <- tibble::tribble(
+    ~OUTPUT,
+    "NOT STARTED"
+  )
+  expect_equal(format_eosstt("SCREEN FAILURE"), "NOT STARTED")
+  expect_equal(format_eosstt("SCREENING FAILURE"), "DISCONTINUED")
+  expect_equal(format_eosstt("COMPLETED"), "COMPLETED")
+  expect_equal(format_eosstt("SCREENING NOT COMPLETED"), "NOT STARTED")
+  expect_snapshot(format_eosstt("SCREENING NOT COMPLETED"), dplyr::select(.data_format_eosstt))
+  expect_equal(format_eosstt(""), "DISCONTINUED")
+  expect_equal(format_eosstt(NA), "ONGOING")
+  expect_length(format_eosstt("SCREEN FAILURE"), 1)
+  expect_length(format_eosstt(NA), 1)
+})
+
+test_that("format_sitegr1 works", {
+  .data_format_sitegr1 <- tibble::tribble(
+    ~OUTPUT,
+    "900"
+  )
+  expect_equal(format_sitegr1("702"),  "900")
+  expect_equal(format_sitegr1("706"),  "900")
+  expect_equal(format_sitegr1("707"),  "900")
+  expect_equal(format_sitegr1("711"),  "900")
+  expect_equal(format_sitegr1("714"),  "900")
+  expect_snapshot(format_sitegr1("714"), dplyr::select(.data_format_sitegr1))
+  expect_equal(format_sitegr1("715"),  "900")
+  expect_equal(format_sitegr1("717"),  "900")
+  expect_length(format_sitegr1("717"), 1)
+})
+
+test_that("round_sas works", {
+  .data_round_sas <- tibble::tribble(
+    ~OUTPUT,
+    11
+  )
+  expect_equal(round_sas(10.56, digits = 0),  11)
+  expect_snapshot(round_sas(10.56, digits = 0), dplyr::select(.data_round_sas))
+  expect_equal(round_sas(9.06, digits = 0),  9)
+  expect_equal(round_sas(-5.6, digits = 0),  -6)
+  expect_length(round_sas(10.56, digits = 0), 1)
+})

tests/testthat/test-eff_models.r

@@ -0,0 +1,36 @@
+test_that("Pilot3 can use the testthat 3e", {
+  local_edition(3)
+  expect_true(TRUE)
+})
+test_that("efficacy models works", {
+  #use DESCRIPTION file imports/suggests packages for pilot3utils environment
+  adas <- haven::read_xpt("./adadas.xpt")
+  adas <- adas %>%
+    filter(
+      EFFFL == "Y",
+      ITTFL == "Y",
+      PARAMCD == "ACTOT",
+      ANL01FL == "Y"
+    )
+  model_portion <- efficacy_models(adas, "CHG", 24)
+  .data_model_portion <- tibble::tribble(
+    ~row_label, ~`~var1_Xanomeline Low Dose`, ~`~var1_Xanomeline High Dose`,
+    "p-value(Dose Response) [1][2]", "NA", "   0.245    ",
+    "", "NA", "",
+    "p-value(Xan - Placebo) [1][3]", "   0.569    ", "   0.233    ",
+    "  Diff of LS Means (SE)", "-0.5 (0.82)", "-1.0 (0.84)",
+    "  95% CI", "(-2.1;1.1)", "(-2.7;0.7)",
+    "", "", "",
+    "p-value(Xan High - Xan Low) [1][3]", "NA", "   0.520    ",
+    "  Diff of LS Means (SE)", "NA", "-0.5 (0.84)",
+    "  95% CI", "NA", "(-2.2;1.1)"
+  )
+  expect_equal(efficacy_models(adas, "CHG", 24), model_portion)
+  expect_snapshot(efficacy_models(adas, "CHG", 24), dplyr::select(model_portion))
+  expect_length(efficacy_models(adas, "CHG", 24), 3)
+  expect_s3_class(model_portion, "tbl_df")
+  expect_s3_class(.data_model_portion, "tbl_df")
+  expect_snapshot_value(.data_model_portion, "serialize")
+  expect_snapshot_value(model_portion, "serialize")
+  expect_length(.data_model_portion, 3)
+})