P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

add vctrs

This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-11-12 23:47:01 +01:00
parent 8f021d042b
commit c7bfc47502
3 changed files with 30 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
R/av.R
View File

@ -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

14
R/vctrs.R
View File

@ -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

12
R/zzz.R
View File

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