Merge pull request #102 from getwilds/metadata-sk

Author: realbp

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,cancerprof_metadata)
 S3method(print,cancerprof_tbl)
 export("%>%")
 export(demo_crowding)
@@ -39,5 +40,6 @@ importFrom(rlang,sym)
 importFrom(stats,setNames)
 importFrom(stringr,str_pad)
 importFrom(stringr,str_trim)
+importFrom(tibble,as_tibble)
 importFrom(utils,data)
 importFrom(utils,read.csv)

R/demo-crowding.R

@@ -20,6 +20,7 @@
 #' @importFrom httr2 req_url_query req_perform
 #' @importFrom stats setNames
 #' @importFrom dplyr mutate across
+#' @importFrom tibble as_tibble
 #'
 #' @returns A data frame with the following columns: Area, Area Code,
 #' Percent, Households, Rank.
@@ -34,8 +35,7 @@
 #'   area = "WA",
 #'   areatype = "county",
 #'   crowding = "household with >1 person per room",
-#'   race = "All Races (includes Hispanic)",
-#'   include_metadata = TRUE
+#'   race = "All Races (includes Hispanic)"
 #' )
 #'
 #' demo_crowding(
@@ -49,13 +49,12 @@
 #'   area = "pr",
 #'   areatype = "hsa",
 #'   crowding = "household with >1 person per room",
-#'   race = "black",
-#'   include_metadata = TRUE
+#'   race = "black"
 #' )
 #' }
-demo_crowding <- function(area, areatype, crowding, race, include_metadata=FALSE) {
+demo_crowding <- function(area, areatype, crowding, race) {
   req <- create_request("demographics")
-  
+
   resp <- req %>%
     req_url_query(
       stateFIPS = fips_scp(area),
@@ -69,29 +68,17 @@ demo_crowding <- function(area, areatype, crowding, race, include_metadata=FALSE
       output = 1
     ) %>%
     req_perform()
+
+  resp <- process_resp(resp, "demographics")
 
-  resp <- process_resp(resp, "demographics", include_metadata)
-  
-  if (include_metadata == TRUE) {
-    resp$data <- resp$data %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-    
-    result_df <- process_metadata(resp)
-    
-  } else {
-    resp %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-  }
+  resp$data <- resp$data %>%
+    setNames(c(
+      get_area(areatype),
+      "Percent",
+      "Households",
+      "Rank"
+    )) %>%
+    mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
+
+  process_metadata(resp)
 }

R/demo-education.R

@@ -44,8 +44,7 @@
 #'   areatype = "state",
 #'   education = "at least bachelors degree",
 #'   sex = "both sexes",
-#'   race = "all races (includes hispanic)",
-#'   include_metadata = TRUE
+#'   race = "all races (includes hispanic)"
 #' )
 #'
 #' demo_education(
@@ -54,7 +53,7 @@
 #'   education = "less than 9th grade"
 #' )
 #' }
-demo_education <- function(area, areatype, education, sex = NULL, race = NULL, include_metadata=FALSE) {
+demo_education <- function(area, areatype, education, sex = NULL, race = NULL) {
   req <- create_request("demographics")
 
   if (education == "less than 9th grade" && (!is.null(race) || !is.null(sex))) {
@@ -90,28 +89,17 @@ demo_education <- function(area, areatype, education, sex = NULL, race = NULL, i
   resp <- resp %>%
     req_perform()
 
-  resp <- process_resp(resp, "demographics", include_metadata)
+  resp <- process_resp(resp, "demographics")
 
-  if (include_metadata == TRUE) {
-    resp$data <- resp$data %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-    
-    result_df <- process_metadata(resp)
-    
-  } else {
-    resp %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-  }
+  resp$data <- resp$data %>%
+    setNames(c(
+      get_area(areatype),
+      "Percent",
+      "Households",
+      "Rank"
+    )) %>%
+    mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
+  
+  process_metadata(resp)
+
 }

R/get-metadata.R

@@ -0,0 +1,70 @@
+
+#helper function to remove key from values
+extract_values <- function(key, resp_metadata) {
+  values <- resp_metadata[grep(key, resp_metadata)]
+  values <- gsub(paste0("^\\s*", key, ":?\\s*"), "", values)
+  return(values)
+}
+
+#' Custom print function
+#'
+#' This custom print function processes the
+#' metadata output for a response object
+#'
+#' @param x
+#'
+#' @export
+print.cancerprof_metadata <- function(x, ...) {
+
+  cat("\033[38;5;246m# Data Report: \033[39m", "\n")
+  cat(paste(x$data_report, '"\n', sep = "", collapse = " "), "\n")
+  
+  cat("\033[38;5;246m# Sorted By: \033[39m", "\n")
+  cat(x$sortedby, "\n")
+  cat("\n")
+  
+  cat("\033[38;5;246m# Created By: \033[39m", "\n")
+  cat(x$createdby, "\n")
+  cat("\n")
+  
+  cat("\033[38;5;246m# Data Sources: \033[39m", "\n")
+  cat(x$data_sources, "\n")
+  cat("\n")
+  
+  cat("\033[38;5;246m# Data Dictionary: \033[39m", "\n")
+  cat(x$data_dictionary, "\n")
+  cat("\n")
+  
+  cat("\033[38;5;246m# Data Limitations: \033[39m", "\n")
+  cat(x$data_limitations, "\n")
+  
+  invisible(x)
+}
+
+
+get_metadata <- function(input_tbl) {
+  resp_metadata <- attr(input_tbl, "metadata")
+  
+  resp_metadata <- gsub("\\\"", "", resp_metadata)
+
+  data_report <- c(resp_metadata[1], resp_metadata[2], resp_metadata[3], resp_metadata[4])
+  sortedby <- extract_values("Sorted by", resp_metadata)
+  createdby <- extract_values("Created by", resp_metadata)
+  data_sources <- extract_values("Source", resp_metadata)
+  data_dictionary <- extract_values("For more information about", resp_metadata)
+  data_limitations <- extract_values("Data for", resp_metadata)
+
+
+  demo_metadata_list <- list(
+    data_report = data_report,
+    sortedby = sortedby,
+    createdby = createdby,
+    data_sources = data_sources,
+    data_dictionary = data_dictionary,
+    data_limitations = data_limitations
+  )
+  
+  class(demo_metadata_list) <- c("cancerprof_metadata", class(demo_metadata_list))
+  
+  print.cancerprof_metadata(demo_metadata_list)
+}

R/parse_metadata.R

@@ -0,0 +1,42 @@
+#' Custom print function
+#'
+#' This custom print function processes the
+#' metadata output for a response object
+#'
+#' @param x
+#'
+#' @export
+print.cancerprof_tbl <- function(x, ...) {
+  #cat("Metadata:", "\n")
+  # we actually need to figure out how to use pillar here
+  cat("\033[38;5;246m# Access metadata with `get_metadata()`\033[39m", "\n")
+  # for (i in seq_along(attr(x, "metadata"))) {
+  #   cat(names(attr(x, "metadata"))[i], attr(x, "metadata")[[i]], "\n")
+  # }
+  NextMethod(x, ...)
+}
+
+#' Process Metadata
+#'
+#' This function sets the class of the response data 
+#' to use the custom print function
+#'
+#' @param resp A response object
+#' 
+#' @returns A response object with Metadata and a tibble
+#' 
+#' @examples
+#' \dontrun{
+#' process_metadata(resp)
+#' }
+process_metadata <- function(resp) {
+  
+  resp_data <- resp$data
+  resp_metadata <- resp$metadata
+  
+  class(resp_data) <- c("cancerprof_tbl", class(resp_data))
+  attr(resp_data, "metadata") <- resp_metadata
+  
+  #print(resp_data)
+  return(resp_data)
+}

R/process-metadata.R

@@ -14,14 +14,15 @@
 #' @importFrom rlang sym
 #' @importFrom utils read.csv data
 #' @importFrom stringr str_trim
+#' @importFrom tibble as_tibble
 #'
 #' @returns A processed response data frame
 #'
 #' @noRd
 #'
 #' @examples
 #' process_resp(resp, "demographics")
-process_resp <- function(resp, topic, include_metadata) {
+process_resp <- function(resp, topic) {
   if (httr2::resp_content_type(resp) != "text/csv") {
     cli_abort("Invalid input, please check documentation for valid arguments.")
   }
@@ -83,15 +84,10 @@ process_resp <- function(resp, topic, include_metadata) {
     as_tibble()
 
   #store metadata
-  if (include_metadata == TRUE) {
-    #return dataframe AND metadata
-    resp_metadata <- c(
-      resp_lines[1: (index_first_line_break - 1)], resp_lines[(index_second_line_break + 1): line_length]
-    )
-    resp_with_metadata <- list(metadata = resp_metadata, data = resp)
-    
-    return(resp_with_metadata)
-  } else {
-    return(resp)
-  }
+  
+  #return dataframe AND metadata
+  resp_metadata <- c(
+    resp_lines[1: (index_first_line_break - 1)], resp_lines[(index_second_line_break + 1): line_length]
+  )
+  list(metadata = resp_metadata, data = resp)
 }

R/process-resp.R

@@ -7,10 +7,12 @@
 #'
 #' @export
 print.cancerprof_tbl <- function(x, ...) {
-  cat("Metadata:", "\n")
-  for (i in seq_along(attr(x, "metadata"))) {
-    cat(names(attr(x, "metadata"))[i], attr(x, "metadata")[[i]], "\n")
-  }
+  #cat("Metadata:", "\n")
+  # we actually need to figure out how to use pillar here
+  cat("\033[38;5;246m# Access metadata with `get_metadata()`\033[39m", "\n")
+  # for (i in seq_along(attr(x, "metadata"))) {
+  #   cat(names(attr(x, "metadata"))[i], attr(x, "metadata")[[i]], "\n")
+  # }
   NextMethod(x, ...)
 }
 
@@ -35,6 +37,6 @@ process_metadata <- function(resp) {
   class(resp_data) <- c("cancerprof_tbl", class(resp_data))
   attr(resp_data, "metadata") <- resp_metadata
 
-  print(resp_data)
+  #print(resp_metadata)
   return(resp_data)
 }