add biomarker colname meta-data and associated methods

NAMESPACE

@@ -8,6 +8,9 @@ S3method(autoplot,seroincidence.by)
 S3method(autoplot,summary.seroincidence.by)
 S3method(get_age,pop_data)
 S3method(get_age_var,pop_data)
+S3method(get_biomarker_levels,pop_data)
+S3method(get_biomarker_names,pop_data)
+S3method(get_biomarker_names_var,pop_data)
 S3method(get_id,pop_data)
 S3method(get_id_var,pop_data)
 S3method(get_value,pop_data)
@@ -17,6 +20,7 @@ S3method(print,seroincidence.by)
 S3method(print,summary.pop_data)
 S3method(print,summary.seroincidence.by)
 S3method(set_age,pop_data)
+S3method(set_biomarker_var,pop_data)
 S3method(set_id,pop_data)
 S3method(set_value,pop_data)
 S3method(strata,seroincidence.by)

R/as_pop_data.R

@@ -9,15 +9,19 @@
 #' @returns a `pop_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
 #' @export
 #' @examples
-#' xs_data <- load_pop_data("https://osf.io/download//n6cp3/")
+#' library(magrittr)
+#' xs_data <-
+#'   "https://osf.io/download//n6cp3/" %>%
+#'   readr::read_rds() %>%
+#'   as_pop_data()
 #'
 #' print(xs_data)
 as_pop_data <- function(data,
-                          antigen_isos = NULL,
-                          age = "Age",
-                          value = "result",
-                          id = "index_id",
-                          standardize = TRUE) {
+                        antigen_isos = NULL,
+                        age = "Age",
+                        value = "result",
+                        id = "index_id",
+                        standardize = TRUE) {
 
 
   pop_data <-
@@ -38,8 +42,8 @@ as_pop_data <- function(data,
   pop_data <- pop_data %>%
     set_age(age = age, standardize = standardize) %>%
     set_value(value = value, standardize = standardize) %>%
-    set_id(id = id, standardize = standardize)
+    set_id(id = id, standardize = standardize)  %>%
+    set_biomarker_var(biomarker = "antigen_iso", standardize = standardize)
 
   return(pop_data)
 }
-

R/load_pop_data.R

@@ -1,47 +1,20 @@
 #' Load a cross-sectional antibody survey data set
 #'
 #' @param file_path path to an RDS file containing a cross-sectional antibody survey data set, stored as a [data.frame()] or [tibble::tbl_df]
-#' @param antigen_isos [character()] vector of antigen isotypes to be used in analyses
-#' @param age a [character()] identifying the age column
-#' @param id a [character()] identifying the id column
-#' @param value a [character()] identifying the value column
-#' @param standardize a [logical()] to determine standardization of columns
-#' @returns a `pop_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
+#' @inheritDotParams as_pop_data
+#' @returns a `pop_data` object (a [tibble::tbl_df] with extra attributes)
 #' @export
 #' @examples
 #' xs_data <- load_pop_data("https://osf.io/download//n6cp3/")
 #'
 #' print(xs_data)
 load_pop_data <- function(file_path,
-                          antigen_isos = NULL,
-                          age = "Age",
-                          value = "result",
-                          id = "index_id",
-                          standardize = TRUE) {
-  if (file_path %>% substr(1, 4) == "http") {
-    file_path <- url(file_path)
-  }
+                          ...) {
 
   pop_data <-
     file_path %>%
-    readRDS() %>%
-    tibble::as_tibble()
-
-  class(pop_data) <-
-    c("pop_data", class(pop_data))
-
-  if (is.null(antigen_isos)) {
-    antigen_isos <- unique(pop_data$antigen_iso)
-  } else {
-    stopifnot(all(is.element(antigen_isos, pop_data$antigen_iso)))
-  }
-
-  attr(pop_data, "antigen_isos") <- antigen_isos
-
-  pop_data <- pop_data %>%
-    set_age(age = age, standardize = standardize) %>%
-    set_value(value = value, standardize = standardize) %>%
-    set_id(id = id, standardize = standardize)
+    readr::read_rds() %>%
+    as_pop_data(...)
 
   return(pop_data)
 }
@@ -118,6 +91,72 @@
   return(id_var)
 }
 
+set_biomarker_var <- function(object, ...) {
+  UseMethod("set_biomarker_var", object)
+}
+
+#' @export
+set_biomarker_var.pop_data = function(object,
+                                      biomarker = "antigen_iso",
+                                      standardize = TRUE,
+                                      ...)
+{
+  if (biomarker %in% colnames(object))
+  {
+    attr(object, "biomarker_var") <- biomarker
+  } else
+  {
+    cli::cli_abort('data does not include column "{biomarker}"')
+  }
+
+  if (standardize)
+  {
+    object <- object %>%
+      rename(c("antigen_iso" = attr(object, "biomarker_var")))
+
+    # update attribute
+    attr(object, "biomarker_var") <- "antigen_iso"
+  }
+
+  return(object)
+
+}
+
+get_biomarker_levels <- function(object, ...)
+{
+  UseMethod("get_biomarker_levels", object)
+}
+
+#' @export
+get_biomarker_levels.pop_data <- function(object, ...)
+{
+  attr(object, "antigen_isos")
+}
+
+get_biomarker_names <- function(object, ...) {
+  UseMethod("get_biomarker_names", object)
+}
+
+#' @export
+get_biomarker_names.pop_data <- function(object, ...) {
+  # get biomarker name data
+  biomarker_data <- object %>% pull(get_biomarker_names_var(object))
+
+  return(biomarker_data)
+}
+
+get_biomarker_names_var <- function(object, ...) {
+  UseMethod("get_biomarker_names_var", object)
+}
+
+#' @export
+get_biomarker_names_var.pop_data <- function(object, ...) {
+  # get value attribute
+  biomarker_var <- attributes(object)[["biomarker_var"]]
+
+  return(biomarker_var)
+}
+
 
 set_age <- function(object, ...) {
   UseMethod("set_age", object)