updates to sync parameter and external Id outputs

.Rhistory

@@ -83,3 +83,8 @@ library(gh)
 gh::gh_token("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")
 usethis::use_pkgdown_github_pages()
 usethis::use_pkgdown_github_pages()
+usethis::use_pkgdown_github_pages()
+getwd()
+pkgdown::build_site()
+pkgdown::build_site()
+pkgdown::build_site()

NAMESPACE

@@ -12,6 +12,8 @@ export(get_tests_ath)
 export(get_tests_group)
 export(get_tests_team)
 export(get_tests_type)
+importFrom(dplyr,relocate)
+importFrom(dplyr,select)
 importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
 importFrom(tidyr,unnest)

R/get_tests.R

@@ -67,6 +67,8 @@
 #'
 #' @importFrom rlang .data
 #' @importFrom tidyr unnest
+#' @importFrom dplyr select
+#' @importFrom dplyr relocate
 #' @export
 
 ## Get All Tests or Sync Tests -----
@@ -99,25 +101,23 @@ get_tests <- function(from = NULL, to = NULL, sync = FALSE) {
   # From DateTime
   fromDT <- if(base::is.null(from)) {
     ""
-  } else if(!is.numeric(from)) {
-    base::stop("date must be in numeric unix format")
-  } else{
-    base::paste0("&from=",from)
+  } else if(base::is.numeric(from) && base::isTRUE(sync)) {
+    base::paste0("?syncFrom=",from)
+  } else if(base::is.numeric(from) && base::isFALSE(sync)) {
+    base::paste0("?from=",from)
   }
 
 
   # To DateTime
   toDT <- if(base::is.null(to)) {
     ""
-  } else if(!is.numeric(to)) {
-    base::stop("date must be in numeric unix format")
-  } else if(base::is.null(from)) {
+  } else if(base::is.null(from) && base::isFALSE(sync)) {
     base::paste0("?to=",to)
   } else if(base::is.null(from) && base::isTRUE(sync)) {
     base::paste0("?syncTo=",to)
-  } else if(base::isTRUE(sync)) {
+  } else if(base::is.numeric(to) && base::isTRUE(sync)) {
     base::paste0("&syncTo=",to)
-  } else {
+  } else if(base::is.numeric(to) && base::isFALSE(sync)){
     base::paste0("&to=",to)
   }
 
@@ -167,11 +167,85 @@ get_tests <- function(from = NULL, to = NULL, sync = FALSE) {
       # The code ran successfully, and 'result' contains the data frame
     }
 
+    #-----#
+    ### Create data frame ###
+    #-----#
+
     # Clean Resp Headers
     base::names(x) <- base::sub("^data\\.", "", base::names(x))
 
-    # UnNest testType and Athlete data
-    x <- x %>% tidyr::unnest(c(.data$testType, .data$athlete), names_sep = ".")
+    ##-- External IDs --##
+
+    # Create externalId df
+    extDF <- x$athlete$external
+
+    # Prepare externalId vector
+    external <- base::c()
+
+    # Loop externalId columns
+    for (i in 1:base::nrow(extDF)) {
+
+      extRow <- NA
+
+      for (n in 1:base::ncol(extDF)) {
+
+        # get externalId name
+        extN <- base::names(extDF)[n]
+
+        # get ext id
+        extId <- extDF[i,n]
+
+        # create new external id name:id string
+        newExt <- base::paste0(extN, ":", extId)
+
+        # add new externalId string to row list if needed
+        extRow <- if( base::is.na(extId) ) {
+          # if extId NA, no change
+          extRow
+        } else {
+          # Add new string to extId Row
+          extRow <- if( base::is.na(extRow) ) {
+            base::paste0(newExt)
+          } else{
+            base::paste0(extRow, ",", newExt)
+          }
+        }
+
+      }
+
+      external <- base::c(external, extRow)
+    }
+
+    # Athlete df from original df
+    a <- x$athlete
+
+    # Remove old external from athlete df
+    a <- dplyr::select(.data = a, -dplyr::starts_with('external'))
+
+    # Bind external column to athlete df
+    a <- base::cbind(a, external)
+
+    # append Athlete prefix
+    base::names(a) <- base::paste0('athlete_', base::names(a))
+
+    ##-- Test Types --##
+
+    # Create testType df
+    t <- x$testType
+
+    # append testType prefix
+    base::names(t) <- base::paste0('testType_', base::names(t))
+
+    ##-- finish data frame --##
+
+    # select trial metadata metrics from DF
+    x1 <- dplyr::select(.data = x, base::c('id', 'timestamp', 'segment'))
+
+    # select all metrics from DF
+    x2 <- dplyr::select(.data = x, -base::c('id', 'timestamp', 'segment', 'testType', 'athlete'))
+
+    # create new complete DF
+    x <- base::cbind(x1, t, a, x2)
 
     # Clean colnames with janitor
     x <- janitor::clean_names(x)

R/get_tests_ath.R

@@ -4,7 +4,7 @@
 #' Get only tests of the specified athlete for an account.
 #'
 #' @usage
-#' get_tests_ath(athleteId, from, to)
+#' get_tests_ath(athleteId, from, to, sync)
 #'
 #' @param athleteId Supply an athlete’s id to receive tests for a specific athlete
 #'
@@ -16,6 +16,10 @@
 #' supply this value you will receive every test from the beginning of time or the optionally
 #' supplied `from` parameter. This parameter is best suited for bulk exports of historical data.
 #'
+#' @param sync  The result set will include updated and newly created tests. This parameter is best
+#' suited to keep your database in sync with the Hawkin database. If you do not supply this value
+#' you will receive every test.
+#'
 #' @return
 #' Response will be a data frame containing the trials from the specified team and within the time range (if specified).
 #'
@@ -64,10 +68,12 @@
 #'
 #' @importFrom rlang .data
 #' @importFrom tidyr unnest
+#' @importFrom dplyr select
+#' @importFrom dplyr relocate
 #' @export
 
 ## Get Tests Data by Athlete Id -----
-get_tests_ath <- function(athleteId, from = NULL, to = NULL) {
+get_tests_ath <- function(athleteId, from = NULL, to = NULL, sync = FALSE) {
 
   # Retrieve Access Token and Expiration from Environment Variables
   aToken <- base::Sys.getenv("accessToken")
@@ -98,7 +104,9 @@ get_tests_ath <- function(athleteId, from = NULL, to = NULL) {
     ""
   } else if(!is.numeric(from)) {
     base::stop("date must be in numeric unix format")
-  } else{
+  } else if(base::is.numeric(from) && base::isTRUE(sync)) {
+    base::paste0("&syncFrom=",from)
+  } else if(base::is.numeric(from) && base::isFALSE(sync)) {
     base::paste0("&from=",from)
   }
 
@@ -107,10 +115,13 @@ get_tests_ath <- function(athleteId, from = NULL, to = NULL) {
     ""
   } else if(!is.numeric(to)) {
     base::stop("date must be in numeric unix format")
-  } else{
+  } else if(base::is.numeric(to) && base::isTRUE(sync)) {
+    base::paste0("&syncTo=",to)
+  } else if(base::is.numeric(to) && base::isFALSE(sync)){
     base::paste0("&to=",to)
   }
 
+
   # Athlete Id
   aId <- if(base::is.character(athleteId)) {
     athleteId
@@ -153,18 +164,92 @@ get_tests_ath <- function(athleteId, from = NULL, to = NULL) {
     # Evaluate Response
     x <- if(resp$count[1] > 0) {
       # Convert to data frame
-      df <- base::data.frame(resp)
+      x <- base::data.frame(resp)
+
+      #-----#
+      ### Create data frame ###
+      #-----#
 
       # Clean Resp Headers
-      base::names(df) <- base::sub("^data\\.", "", base::names(df))
+      base::names(x) <- base::sub("^data\\.", "", base::names(x))
+
+      ##-- External IDs --##
+
+      # Create externalId df
+      extDF <- x$athlete$external
+
+      # Prepare externalId vector
+      external <- base::c()
+
+      # Loop externalId columns
+      for (i in 1:base::nrow(extDF)) {
+
+        extRow <- NA
+
+        for (n in 1:base::ncol(extDF)) {
+
+          # get externalId name
+          extN <- base::names(extDF)[n]
+
+          # get ext id
+          extId <- extDF[i,n]
+
+          # create new external id name:id string
+          newExt <- base::paste0(extN, ":", extId)
+
+          # add new externalId string to row list if needed
+          extRow <- if( base::is.na(extId) ) {
+            # if extId NA, no change
+            extRow
+          } else {
+            # Add new string to extId Row
+            extRow <- if( base::is.na(extRow) ) {
+              base::paste0(newExt)
+            } else{
+              base::paste0(extRow, ",", newExt)
+            }
+          }
 
-      # UnNest testType and Athlete data
-      df <- df %>% tidyr::unnest(c(.data$testType, .data$athlete), names_sep = ".")
+        }
 
-      # Clean column names with janitor
-      df <- janitor::clean_names(df)
+        external <- base::c(external, extRow)
+      }
 
-      df
+      # Athlete df from original df
+      a <- x$athlete
+
+      # Remove old external from athlete df
+      a <- dplyr::select(.data = a, -dplyr::starts_with('external'))
+
+      # Bind external column to athlete df
+      a <- base::cbind(a, external)
+
+      # append Athlete prefix
+      base::names(a) <- base::paste0('athlete_', base::names(a))
+
+      ##-- Test Types --##
+
+      # Create testType df
+      t <- x$testType
+
+      # append testType prefix
+      base::names(t) <- base::paste0('testType_', base::names(t))
+
+      ##-- finish data frame --##
+
+      # select trial metadata metrics from DF
+      x1 <- dplyr::select(.data = x, base::c('id', 'timestamp', 'segment'))
+
+      # select all metrics from DF
+      x2 <- dplyr::select(.data = x, -base::c('id', 'timestamp', 'segment', 'testType', 'athlete'))
+
+      # create new complete DF
+      x <- base::cbind(x1, t, a, x2)
+
+      # Clean colnames with janitor
+      x <- janitor::clean_names(x)
+
+      x
     } else {
       base::stop("No trials returned. Check athleteId or from/to entries")
     }
@@ -177,4 +262,3 @@ get_tests_ath <- function(athleteId, from = NULL, to = NULL) {
   return(Resp)
 
 }
-