From 1a48b81bd92fb424a15403b9a96cf7fc38131711 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Thu, 24 Oct 2024 13:27:17 -0400 Subject: [PATCH 1/6] Simplify structure of `.colorFmt.rxEvid()` --- R/et.R | 34 +++++++++++++++++----------------- tests/testthat/test-et.R | 26 ++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 17 deletions(-) diff --git a/R/et.R b/R/et.R index f8ee9af85..e56c49064 100644 --- a/R/et.R +++ b/R/et.R @@ -1324,24 +1324,24 @@ c.rxEvid <- function(x, ...) { } .colorFmt.rxEvid <- function(x, ...) { .x <- unclass(x) - .x <- - ifelse(.x == 0, paste0(crayon::blue$bold("0"), ":", crayon::white("Observation")), - ifelse(.x == 1, paste0(crayon::blue$bold("1"), ":", crayon::yellow("Dose (Add)")), - ifelse(.x == 2, paste0(crayon::blue$bold("2"), ":", crayon::yellow("Other")), - ifelse(.x == 3, paste0(crayon::blue$bold("3"), ":", crayon::red("Reset")), - ifelse(.x == 4, paste0(crayon::blue$bold("4"), ":", crayon::red("Reset"), "&", crayon::yellow("Dose")), - ifelse(.x == 5, paste0(crayon::blue$bold("5"), ":", crayon::red("Replace")), - ifelse(.x == 6, paste0(crayon::blue$bold("6"), ":", crayon::yellow("Multiply")), - ifelse(.x == 7, paste0(crayon::blue$bold("7"), ":", crayon::yellow("Transit")), - paste0(crayon::blue$red(.x), ":", crayon::red("Invalid"))) - ) - ) - ) - ) - ) + if (is.numeric(.x)) { + .x <- + dplyr::case_match( + .x, + 0 ~ paste0(crayon::blue$bold("0"), ":", crayon::white("Observation")), + 1 ~ paste0(crayon::blue$bold("1"), ":", crayon::yellow("Dose (Add)")), + 2 ~ paste0(crayon::blue$bold("2"), ":", crayon::yellow("Other")), + 3 ~ paste0(crayon::blue$bold("3"), ":", crayon::red("Reset")), + 4 ~ paste0(crayon::blue$bold("4"), ":", crayon::red("Reset"), "&", crayon::yellow("Dose")), + 5 ~ paste0(crayon::blue$bold("5"), ":", crayon::red("Replace")), + 6 ~ paste0(crayon::blue$bold("6"), ":", crayon::yellow("Multiply")), + 7 ~ paste0(crayon::blue$bold("7"), ":", crayon::yellow("Transit")), + .default = paste0(crayon::blue$red(.x), ":", crayon::red("Invalid")) ) - ) - return(format(.x, justify = "left")) + } else { + .x <- paste0(crayon::blue$red(.x), ":", crayon::red("Invalid")) + } + format(.x, justify = "left") } #' @rdname rxEvid diff --git a/tests/testthat/test-et.R b/tests/testthat/test-et.R index 9ad735f1b..179cbac55 100644 --- a/tests/testthat/test-et.R +++ b/tests/testthat/test-et.R @@ -829,3 +829,29 @@ rxTest({ }) }) + +test_that(".colorFmt.rxEvid", { + expect_equal( + .colorFmt.rxEvid(-1:9), + c("\033[34m\033[31m-1\033[34m\033[39m:\033[31mInvalid\033[39m ", + "\033[34m\033[1m0\033[22m\033[39m:\033[37mObservation\033[39m ", + "\033[34m\033[1m1\033[22m\033[39m:\033[33mDose (Add)\033[39m ", + "\033[34m\033[1m2\033[22m\033[39m:\033[33mOther\033[39m ", + "\033[34m\033[1m3\033[22m\033[39m:\033[31mReset\033[39m ", + "\033[34m\033[1m4\033[22m\033[39m:\033[31mReset\033[39m&\033[33mDose\033[39m", + "\033[34m\033[1m5\033[22m\033[39m:\033[31mReplace\033[39m ", + "\033[34m\033[1m6\033[22m\033[39m:\033[33mMultiply\033[39m ", + "\033[34m\033[1m7\033[22m\033[39m:\033[33mTransit\033[39m ", + "\033[34m\033[31m8\033[34m\033[39m:\033[31mInvalid\033[39m ", + "\033[34m\033[31m9\033[34m\033[39m:\033[31mInvalid\033[39m " + ) + ) + expect_equal( + .colorFmt.rxEvid("A"), + "\033[34m\033[31mA\033[34m\033[39m:\033[31mInvalid\033[39m" + ) + expect_equal( + .colorFmt.rxEvid(0.5), + "\033[34m\033[31m0.5\033[34m\033[39m:\033[31mInvalid\033[39m" + ) +}) From 0d0aaf27c25cea4ebc34005b42a20d66c5ecf3a3 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Thu, 24 Oct 2024 13:29:03 -0400 Subject: [PATCH 2/6] Add test for `as.character.rxEvid()` --- tests/testthat/test-et.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/testthat/test-et.R b/tests/testthat/test-et.R index 179cbac55..6c4501935 100644 --- a/tests/testthat/test-et.R +++ b/tests/testthat/test-et.R @@ -855,3 +855,20 @@ test_that(".colorFmt.rxEvid", { "\033[34m\033[31m0.5\033[34m\033[39m:\033[31mInvalid\033[39m" ) }) + +test_that("as.character.rxEvid", { + expect_equal( + as.character.rxEvid(-1:9), + c("-1:Invalid", "0:Observation", "1:Dose (Add)", "2:Other", "3:Reset", + "4:Reset&Dose", "5:Replace", "6:Multiply", "7:Transit", "8:Invalid", + "9:Invalid") + ) + expect_equal( + as.character.rxEvid("A"), + "A:Invalid" + ) + expect_equal( + as.character.rxEvid(0.5), + "0.5:Invalid" + ) +}) From bd2b7211cf5ef320f51a6adfbb8ea5d31515c869 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Thu, 24 Oct 2024 13:31:15 -0400 Subject: [PATCH 3/6] simplify structure of `as.character.rxEvid()` --- R/et.R | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/R/et.R b/R/et.R index e56c49064..c0c1439ca 100644 --- a/R/et.R +++ b/R/et.R @@ -1348,24 +1348,24 @@ c.rxEvid <- function(x, ...) { #' @export as.character.rxEvid <- function(x, ...) { .x <- unclass(x) - .x <- - ifelse(.x == 0, "0:Observation", - ifelse(.x == 1, "1:Dose (Add)", - ifelse(.x == 2, "2:Other", - ifelse(.x == 3, "3:Reset", - ifelse(.x == 4, "4:Reset&Dose", - ifelse(.x == 5, "5:Replace", - ifelse(.x == 6, "6:Multiply", - ifelse(.x == 7, "7:Transit", - paste0(.x, ":Invalid")) - ) - ) - ) - ) - ) + if (is.numeric(.x)) { + .x <- + dplyr::case_match( + .x, + 0 ~ "0:Observation", + 1 ~ "1:Dose (Add)", + 2 ~ "2:Other", + 3 ~ "3:Reset", + 4 ~ "4:Reset&Dose", + 5 ~ "5:Replace", + 6 ~ "6:Multiply", + 7 ~ "7:Transit", + .default = paste0(.x, ":Invalid") ) - ) - return(.x) + } else { + .x <- paste0(.x, ":Invalid") + } + .x } From 326712b8d7f98c7d425389514b2b42768e8cf8fd Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 21 Nov 2024 15:07:53 -0600 Subject: [PATCH 4/6] use data.table::fcase --- R/et.R | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/R/et.R b/R/et.R index c0c1439ca..dc13d60d9 100644 --- a/R/et.R +++ b/R/et.R @@ -1326,17 +1326,16 @@ c.rxEvid <- function(x, ...) { .x <- unclass(x) if (is.numeric(.x)) { .x <- - dplyr::case_match( - .x, - 0 ~ paste0(crayon::blue$bold("0"), ":", crayon::white("Observation")), - 1 ~ paste0(crayon::blue$bold("1"), ":", crayon::yellow("Dose (Add)")), - 2 ~ paste0(crayon::blue$bold("2"), ":", crayon::yellow("Other")), - 3 ~ paste0(crayon::blue$bold("3"), ":", crayon::red("Reset")), - 4 ~ paste0(crayon::blue$bold("4"), ":", crayon::red("Reset"), "&", crayon::yellow("Dose")), - 5 ~ paste0(crayon::blue$bold("5"), ":", crayon::red("Replace")), - 6 ~ paste0(crayon::blue$bold("6"), ":", crayon::yellow("Multiply")), - 7 ~ paste0(crayon::blue$bold("7"), ":", crayon::yellow("Transit")), - .default = paste0(crayon::blue$red(.x), ":", crayon::red("Invalid")) + data.table::fcase( + .x == 0, paste0(crayon::blue$bold("0"), ":", crayon::white("Observation")), + .x == 1, paste0(crayon::blue$bold("1"), ":", crayon::yellow("Dose (Add)")), + .x == 2, paste0(crayon::blue$bold("2"), ":", crayon::yellow("Other")), + .x == 3, paste0(crayon::blue$bold("3"), ":", crayon::red("Reset")), + .x == 4, paste0(crayon::blue$bold("4"), ":", crayon::red("Reset"), "&", crayon::yellow("Dose")), + .x == 5, paste0(crayon::blue$bold("5"), ":", crayon::red("Replace")), + .x == 6, paste0(crayon::blue$bold("6"), ":", crayon::yellow("Multiply")), + .x == 7, paste0(crayon::blue$bold("7"), ":", crayon::yellow("Transit")), + default=paste0(crayon::blue$red(.x), ":", crayon::red("Invalid")) ) } else { .x <- paste0(crayon::blue$red(.x), ":", crayon::red("Invalid")) @@ -1376,11 +1375,13 @@ as.character.rxEvid <- function(x, ...) { as.rxEvid(NextMethod()) } +#' @rdname rxEvid +#' @param value It will be an error to set units for evid +#' @export `units<-.rxEvid` <- function(x, value) { stop("'evid' is unitless", call. = FALSE) } - #' @export `[<-.rxEvid` <- function(x, i, value) { as.rxEvid(NextMethod()) From beb2a4f893ebf072673b9e33628fe72872e00e74 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 21 Nov 2024 15:09:56 -0600 Subject: [PATCH 5/6] Now as.character.rxEvid --- R/et.R | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/R/et.R b/R/et.R index dc13d60d9..b246e91af 100644 --- a/R/et.R +++ b/R/et.R @@ -1349,17 +1349,16 @@ as.character.rxEvid <- function(x, ...) { .x <- unclass(x) if (is.numeric(.x)) { .x <- - dplyr::case_match( - .x, - 0 ~ "0:Observation", - 1 ~ "1:Dose (Add)", - 2 ~ "2:Other", - 3 ~ "3:Reset", - 4 ~ "4:Reset&Dose", - 5 ~ "5:Replace", - 6 ~ "6:Multiply", - 7 ~ "7:Transit", - .default = paste0(.x, ":Invalid") + data.table::fcase( + .x == 0, "0:Observation", + .x == 1, "1:Dose (Add)", + .x == 2, "2:Other", + .x == 3, "3:Reset", + .x == 4, "4:Reset&Dose", + .x == 5, "5:Replace", + .x == 6, "6:Multiply", + .x == 7, "7:Transit", + default = paste0(.x, ":Invalid") ) } else { .x <- paste0(.x, ":Invalid") From 10da9b4ad2106bf248b2916868a7ea4a46e1b4d0 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 21 Nov 2024 15:14:27 -0600 Subject: [PATCH 6/6] Remove color format tests; I don't believe it is used non-interactively --- tests/testthat/test-et.R | 26 -------------------------- 1 file changed, 26 deletions(-) diff --git a/tests/testthat/test-et.R b/tests/testthat/test-et.R index 6c4501935..b323e591a 100644 --- a/tests/testthat/test-et.R +++ b/tests/testthat/test-et.R @@ -830,32 +830,6 @@ rxTest({ }) }) -test_that(".colorFmt.rxEvid", { - expect_equal( - .colorFmt.rxEvid(-1:9), - c("\033[34m\033[31m-1\033[34m\033[39m:\033[31mInvalid\033[39m ", - "\033[34m\033[1m0\033[22m\033[39m:\033[37mObservation\033[39m ", - "\033[34m\033[1m1\033[22m\033[39m:\033[33mDose (Add)\033[39m ", - "\033[34m\033[1m2\033[22m\033[39m:\033[33mOther\033[39m ", - "\033[34m\033[1m3\033[22m\033[39m:\033[31mReset\033[39m ", - "\033[34m\033[1m4\033[22m\033[39m:\033[31mReset\033[39m&\033[33mDose\033[39m", - "\033[34m\033[1m5\033[22m\033[39m:\033[31mReplace\033[39m ", - "\033[34m\033[1m6\033[22m\033[39m:\033[33mMultiply\033[39m ", - "\033[34m\033[1m7\033[22m\033[39m:\033[33mTransit\033[39m ", - "\033[34m\033[31m8\033[34m\033[39m:\033[31mInvalid\033[39m ", - "\033[34m\033[31m9\033[34m\033[39m:\033[31mInvalid\033[39m " - ) - ) - expect_equal( - .colorFmt.rxEvid("A"), - "\033[34m\033[31mA\033[34m\033[39m:\033[31mInvalid\033[39m" - ) - expect_equal( - .colorFmt.rxEvid(0.5), - "\033[34m\033[31m0.5\033[34m\033[39m:\033[31mInvalid\033[39m" - ) -}) - test_that("as.character.rxEvid", { expect_equal( as.character.rxEvid(-1:9),