Merge pull request #46 from finddx/sample-classification

timestamp function add data.frame method

NAMESPACE

@@ -2,6 +2,9 @@
 
 S3method(make_clean_os_names,data.frame)
 S3method(make_clean_os_names,default)
+S3method(timestamp_to_date,character)
+S3method(timestamp_to_date,data.frame)
+S3method(timestamp_to_date,numeric)
 export("%>%")
 export(.data)
 export(any_pos_any_neg)
@@ -10,6 +13,7 @@ export(as_label)
 export(as_name)
 export(auth_os)
 export(convert_os_df_to_wide)
+export(convert_timestamp)
 export(create_folders)
 export(create_save_workbook)
 export(data_table)
@@ -59,7 +63,6 @@ export(select_patients_per_group)
 export(selected_aliquots_df)
 export(summarise_categorical_vars)
 export(timestamp_to_date)
-export(timestamp_to_date.data.frame)
 import(janitor)
 importFrom(DT,datatable)
 importFrom(data.table,":=")

R/convert_timestamp.R

@@ -0,0 +1,191 @@
+# WARNING - Generated by {fusen} from dev/OpenSpecimenAPI.Rmd: do not edit by hand
+
+#' Convert Timestamp to Date
+#'
+#' This function can handle numeric or character inputs to convert timestamps to date time objects, 
+#' and can also process specified timestamp columns in a data frame.
+#' @param x The numeric timestamp, character timestamp string, or a data frame.
+#' @param return_numeric (Optional) Return the converted date as numeric. Default is FALSE.
+#' @return The converted date as a date time object or a data frame with converted columns.
+#' @importFrom lubridate as_datetime
+#' @importFrom data.table setDT
+#' @export
+#' @examples
+#'
+#' timestamps <- c("1625068800000", "1625068801000", "1625068802000")
+#' converted_timestamps <- timestamp_to_date(timestamps)
+#' converted_timestamps
+#'
+#' timestamps_numeric <- c(1625068800000, 1625068801000, 1625068802000)
+#' converted_timestamps_numeric <- timestamp_to_date(timestamps_numeric)
+#' converted_timestamps_numeric
+#' timestamps_with_specials <- c("1625068800000", "2021-07-01 00:00:00", "1625068800/1000")
+#' timestamps_with_specials <- c("1625068800000", "2021-07-01 00:00:00", "1625068800/1000")
+#' timestamps_with_specials
+#' # Example 2: Convert timestamp columns in a data frame
+#' df <- data.table::data.table(id = c(1, 2, 3),
+#'                  event_date_num = c(1637892323000, 1637892423000, 1637892523000),
+#'                  event_date_char = c("1637892323000", "1637892423000", "1637892523000")
+#'                  )
+#'
+#'
+#' df = timestamp_to_date(df, return_numeric = FALSE)
+#'
+#' df
+#'
+#'
+#' date_time_strings <- c(
+#'   "2017-03-22 12:34:56", # ymd_HMS
+#'   "2017-03-22 12:34",    # ymd_HM
+#'   "2017-03-22 12",       # ymd_H
+#'   "2017-03-22",          # ymd
+#'   "22-03-2017 12:34:56", # dmy_HMS
+#'   "22-03-2017 12:34",    # dmy_HM
+#'   "22-03-2017 12",       # dmy_H
+#'   "22-03-2017",          # dmy
+#'   "03-22-2017 12:34:56", # mdy_HMS
+#'   "03-22-2017 12:34",    # mdy_HM
+#'   "03-22-2017 12",       # mdy_H
+#'   "03-22-2017"           # mdy
+#' )
+#'
+#' timestamp_to_date(date_time_strings)
+#'
+#'
+
+convert_timestamp <- function(x, return_numeric = FALSE) {
+  if (!is.numeric(x)) {
+    warning("Input must be numeric.")
+    return(x)
+  }
+
+  # Convert if x is in milliseconds
+  if (any(nchar(as.character(x)) > 10)) {
+    x <- x / 1000
+  }
+
+  if (return_numeric) {
+    return(x)
+  } else {
+    return(lubridate::as_datetime(x))
+  }
+}
+
+#' Convert Timestamp to Date
+#' This function converts a timestamp to a date time object
+#' @param timestamp The timestamp to convert.
+#' @param date_cols (Optional) The columns in the data frame to convert.
+#' @param ... Additional arguments to be passed to convert_timestamp function
+#' @seealso \code{\link{convert_timestamp}}
+#' @return The converted date as a date time object.
+#' @export
+
+timestamp_to_date <- function(timestamp,
+                              date_cols = NULL,
+                                ...) {
+
+  UseMethod("timestamp_to_date")
+}
+
+
+# Method for numeric class
+#' Convert Timestamp to Date
+#' This function converts a timestamp to a date time object
+#' @param timestamp The timestamp to convert.
+#' @param date_cols (Optional) The columns in the data frame to convert.
+#' @param ... Additional arguments to be passed to the method.
+#' @return The converted date as a date time object.
+#' @export
+timestamp_to_date.numeric <- function(timestamp,  
+                                      date_cols = NULL, 
+                                      ...) {
+
+  return(convert_timestamp(timestamp, ...))
+}
+
+
+# Method for character class
+#' Convert Timestamp to Date
+#' This function converts a timestamp to a date time object
+#' @param timestamp The timestamp to convert.
+#' @param date_cols (Optional) The columns in the data frame to convert.
+#' @param ... Additional arguments to be passed to the method.
+#' @return The converted date as a date time object.
+#' @export
+timestamp_to_date.character <- function(timestamp,date_cols, ...) {
+
+  has_special_characters <- function(input) {
+    input <- input[!is.na(input)]
+    any(grepl("[-/:]", input))
+  }
+
+  is_all_digits <- function(input) {
+    input <- input[!is.na(input)]
+    all(grepl("^\\d+$", input))
+  }
+
+  if (!has_special_characters(timestamp)) {
+    timestamp <- as.numeric(timestamp)
+    return(convert_timestamp(timestamp, ...))
+
+  }else if(!is_all_digits(timestamp)){
+
+    # Define the vector of formats
+    formats <- c("ymd_HMS", "ymd_HM", "ymd_H", "ymd",
+                 "dmy_HMS", "dmy_HM", "dmy_H", "dmy",
+                 "mdy_HMS", "mdy_HM", "mdy_H", "mdy")
+
+    timestamp <- lubridate::parse_date_time(timestamp,  formats) %>%
+      as.numeric()
+
+    return(convert_timestamp(timestamp, ...))
+
+
+
+  } else {  #(is.character(timestamp) & any(sapply(timestamp, has_special_characters)))
+
+    warning("Input timestamp is not numeric or contains special characters. Skipping conversion.")
+
+    return(timestamp)
+  }
+
+
+}
+
+
+#' Convert Timestamp Columns in a Data Frame to Date
+#'
+#' This method converts timestamp columns in a data frame to date columns.
+#'
+#' @param timestamp Data frame with timestamp columns.
+#' @param date_cols Names of the timestamp columns to convert.
+#' @param ... (Optional) Return the converted date as numeric. Default is FALSE.
+#'
+#' @return A modified data frame with converted timestamp columns.
+#'
+#' @export
+timestamp_to_date.data.frame <- function(timestamp, date_cols = NULL, ...){
+
+
+  if(is.null(date_cols)){
+
+    nms <- names(timestamp)
+
+    date_cols <- nms[grepl("date", nms, ignore.case = TRUE)]
+  }
+
+  data.table::setDT(timestamp)
+
+  leng <- length(date_cols)
+  if(leng != 0){
+
+    timestamp[, (date_cols) := lapply(.SD, timestamp_to_date, ...), .SDcols = date_cols]
+    #df[, (date_cols) := lapply(.SD, timestamp_to_date.character, return_numeric), .SDcols = date_cols]
+  }
+
+  return(timestamp)
+
+
+
+}
+

R/get_bulk_order_detail.R

@@ -47,7 +47,7 @@ get_bulk_order_detail <- function(auth_response, orders_ids, ...) {
   dt_final = data.table::rbindlist(list_dfs, fill = TRUE)
 
   cli::cli_alert_success(paste0("All ", i, " orders retrieved"))
-  timestamp_to_date.data.frame(dt_final)
+ # timestamp_to_date.data.frame(dt_final, return_numeric = TRUE)
   return(dt_final)
 
 }

R/get_order_detail.R

@@ -6,7 +6,7 @@
 #'
 #' @param auth_response The authentication response obtained from `auth_os`.
 #' @param order_id The ID of the order to retrieve details for.
-#'
+#' @param return_numeric Logical, whether to return timestamps as numeric values (default is TRUE). This function is parsed to parse order detail function
 #' @return A data table containing the parsed order detail data.
 #'
 #' @importFrom httr GET status_code 
@@ -16,7 +16,7 @@
 #'
 #' # df = get_order_detail(auth_response, order_id = 392)
 #'
-get_order_detail <- function(auth_response, order_id) {
+get_order_detail <- function(auth_response, order_id, return_numeric = TRUE) {
 
   # Check if order_id is an integer
   if (isTRUE(round(order_id) != order_id)) {
@@ -45,7 +45,8 @@ get_order_detail <- function(auth_response, order_id) {
 
 
   results <- parse_os_response(response,
-                               parse_data_function = "parse_order_detail_data")
+                               parse_data_function = "parse_order_detail_data",
+                               return_numeric = return_numeric)
 
   if(inherits(results, "data.frame")) {
 

R/parse_os_response.R

@@ -7,15 +7,16 @@
 #'
 #' @param response The response object from the OpenSpecimen API request.
 #' @param parse_data_function The function used to parse the response data
-#'
+#' @param skip_date_convertion Skip date conversion
+#' @param ... Additional arguments to be passed to timestamp_to_date
 #' @return Parsed content from the API response.
 #'
 #' @importFrom httr status_code content
 #'
 #' @export
 #' @examples
 #' #parse_os_response()
-parse_os_response <- function(response, parse_data_function) {
+parse_os_response <- function(response, parse_data_function, skip_date_convertion = FALSE, ...) {
 
 
 
@@ -29,10 +30,11 @@ parse_os_response <- function(response, parse_data_function) {
 
     # if inherits data.frame apply timestamp_to_date
 
-    if(inherits(df, "data.frame")){
+    if(inherits(df, "data.frame") & !skip_date_convertion){
 
 
-      timestamp_to_date(df)
+     df =  timestamp_to_date(df, ...)
+
     }
 
     return(df)