add vctrs

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

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

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")