diff --git a/R/av.R b/R/av.R index c9200c1fe..9bed44fdb 100755 --- a/R/av.R +++ b/R/av.R @@ -506,6 +506,7 @@ is.av <- function(x) { # will be exported using s3_register() in R/zzz.R pillar_shaft.av <- function(x, ...) { out <- trimws(format(x)) + out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE) out[is.na(x)] <- font_na(NA) create_pillar_column(out, align = "left", min_width = 4) } @@ -556,7 +557,7 @@ as.data.frame.av <- function(x, ...) { "[<-.av" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - return_after_integrity_check(y, "antimicrobial code", AMR_env$AV_lookup$av) + return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av) } #' @method [[<- av #' @export @@ -564,7 +565,7 @@ as.data.frame.av <- function(x, ...) { "[[<-.av" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - return_after_integrity_check(y, "antimicrobial code", AMR_env$AV_lookup$av) + return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av) } #' @method c av #' @export @@ -573,7 +574,7 @@ c.av <- function(...) { x <- list(...)[[1L]] y <- NextMethod() attributes(y) <- attributes(x) - return_after_integrity_check(y, "antimicrobial code", AMR_env$AV_lookup$av) + return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av) } #' @method unique av diff --git a/R/vctrs.R b/R/vctrs.R index 19759820c..0c165a666 100644 --- a/R/vctrs.R +++ b/R/vctrs.R @@ -70,6 +70,20 @@ vec_cast.ab.character <- function(x, to, ...) { return_after_integrity_check(x, "antimicrobial code", as.character(AMR_env$AB_lookup$ab)) } +# S3: av +vec_ptype2.character.av <- function(x, y, ...) { + x +} +vec_ptype2.av.character <- function(x, y, ...) { + y +} +vec_cast.character.av <- function(x, to, ...) { + as.character(x) +} +vec_cast.av.character <- function(x, to, ...) { + return_after_integrity_check(x, "antiviral agent code", as.character(AMR_env$AV_lookup$av)) +} + # S3: mo vec_ptype2.character.mo <- function(x, y, ...) { x diff --git a/R/zzz.R b/R/zzz.R index 7c2372cf1..5e41b98c9 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -50,6 +50,11 @@ AMR_env$ab_previously_coerced <- data.frame( ab = character(0), stringsAsFactors = FALSE ) +AMR_env$av_previously_coerced <- data.frame( + x = character(0), + av = character(0), + stringsAsFactors = FALSE +) AMR_env$rsi_interpretation_history <- data.frame( datetime = Sys.time()[0], index = integer(0), @@ -87,11 +92,13 @@ if (utf8_supported && !is_latex) { # developers of the vctrs package: # https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R s3_register("pillar::pillar_shaft", "ab") + s3_register("pillar::pillar_shaft", "av") s3_register("pillar::pillar_shaft", "mo") s3_register("pillar::pillar_shaft", "rsi") s3_register("pillar::pillar_shaft", "mic") s3_register("pillar::pillar_shaft", "disk") s3_register("tibble::type_sum", "ab") + s3_register("tibble::type_sum", "av") s3_register("tibble::type_sum", "mo") s3_register("tibble::type_sum", "rsi") s3_register("tibble::type_sum", "mic") @@ -129,6 +136,11 @@ if (utf8_supported && !is_latex) { s3_register("vctrs::vec_ptype2", "ab.character") s3_register("vctrs::vec_cast", "character.ab") s3_register("vctrs::vec_cast", "ab.character") + # S3: av + s3_register("vctrs::vec_ptype2", "character.av") + s3_register("vctrs::vec_ptype2", "av.character") + s3_register("vctrs::vec_cast", "character.av") + s3_register("vctrs::vec_cast", "av.character") # S3: mo s3_register("vctrs::vec_ptype2", "character.mo") s3_register("vctrs::vec_ptype2", "mo.character")