#' Swimming Course Converter
#'
#' Used to convert times between Long Course Meters, Short Course Meters and
#' Short Course Yards
#'
#' @importFrom purrr map_chr
#'
#' @param time A time, or vector of times to convert. Can be in either seconds
#' (numeric, \code{95.97}) format or swim (character, \code{"1:35.97"}) format
#' @param event The event swum as \code{"100 Fly"}, \code{"200 IM"}, \code{"400
#' Free"}, \code{"50 Back"}, \code{"200 Breast"} etc.
#' @param course The course in which the time was swum as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#' @param course_to The course to convert the time to as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#' @param verbose If \code{TRUE} will return a data frame containing columns \itemize{ \item
#' Time \item Course \item Course_To \item Event \item Time_Converted_sec
#' \item Time_Converted_mmss }. If \code{FALSE} (the default) will return only a converted time.
#'
#' @return returns the \code{time} for a specified \code{event} and
#' \code{course} converted to a time for the specified \code{course_to} in
#' swimming format OR a data frame containing columns \itemize{ \item
#' Time \item Course \item Course_To \item Event \item Time_Converted_sec
#' \item Time_Converted_mmss } depending on the value of \code{verbose}
#'
#' @examples course_convert(time = "1:35.93", event = "200 Free", course = "SCY", course_to = "LCM")
#' course_convert(time = 95.93, event = "200 Free", course = "scy", course_to = "lcm")
#' course_convert(time = 53.89, event = "100 Fly", course = "scm", course_to = "scy")
#'
#' @note Relays are not presently supported.
#' @references Uses the USA swimming age group method described here:
#' \url{https://support.gomotionapp.com/en/articles/6457476-how-to-perform-course-conversion-factoring-of-times}
#' @export
course_convert <- function(time, event, course, course_to, verbose = FALSE) {
x <- purrr::map(time, course_convert_helper, event = event, course = course, course_to = course_to, verbose = verbose)
if(verbose == FALSE){
x <- unlist(x)
}
#### for verbose ####
# should return one data frame, but map will bury it as the first element of a list length 1
# don't want a data frame in a list
if(length(x) == 1){
x <- x[[1]]
}
return(x)
}
#' Swimming Course Convertor Helper
#'
#' Used to convert times between Long Course Meters, Short Course Meters and
#' Short Course Yards
#'
#' @importFrom dplyr mutate
#' @importFrom dplyr case_when
#' @importFrom stringr str_to_upper
#' @importFrom stringr str_to_title
#' @importFrom stringr str_split_fixed
#' @importFrom stringr str_detect
#' @importFrom purrr map_dbl
#'
#' @param time A time, or vector of times to convert. Can be in either seconds
#' (numeric, \code{95.97}) format or swim (character, \code{"1:35.97"}) format
#' @param event The event swum as \code{"100 Fly"}, \code{"200 IM"}, \code{"400
#' Free"}, \code{"50 Back"}, \code{"200 Breast"} etc.
#' @param course The course in which the time was swum as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#' @param course_to The course to convert the time to as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#' @param verbose If \code{TRUE} will return a data frame containing columns \itemize{ \item
#' Time \item Course \item Course_To \item Event \item Time_Converted_sec
#' \item Time_Converted_mmss }. If \code{FALSE} (the default) will return only a converted time.
#'
#' @return returns the \code{time} for a specified \code{event} and
#' \code{course} converted to a time for the specified \code{course_to} in
#' swimming format OR a data frame containing columns \itemize{ \item
#' Time \item Course \item Course_To \item Event \item Time_Converted_sec
#' \item Time_Converted_mmss } depending on the value of \code{verbose}
#'
#' @seealso \code{course_convert_helper} is a helper function inside \code{\link{course_convert}}
course_convert_helper <-
function(time, event, course, course_to, verbose = FALSE) {
#### testing ####
# time = "4:45.00"
# event = "500 Free"
# course = "SCY"
# course_to = "LCM"
#
# time = 53.89
# event = "100 Fly"
# course = "SCY"
# course_to = "LCM"
#### verbose must be TRUE or FALSE ####
if (any(is.logical(verbose) == FALSE, is.na(verbose) == TRUE)) {
stop("verbose must be either TRUE or FALSE")
}
if(is.na(time) == TRUE) return(NA)
#### event strings ####
stroke_strings <-
"(Freestyle)|(Free)|(Butterfly)|(Fly)|(Breaststroke)|(Breast)|(Backstroke)|(Back)|(Individual Medley)|(IM)"
non_IM_strings <-
"(Freestyle)|(Free)|(Butterfly)|(Fly)|(Breaststroke)|(Breast)|(Backstroke)|(Back)"
IM_strings <- "(Individual Medley)|(IM)"
#### Actual Function ####
#### Regularize
time <-
ifelse(is.character(time) == TRUE,
purrr::map_dbl(time, sec_format),
time)
course <- stringr::str_to_upper(course, locale = "en")
if (any(course %notin% c("LCM", "SCY", "SCM")) == TRUE)
stop("Enter a correctly formatted course")
course_to <-
stringr::str_to_upper(course_to, locale = "en")
if (any(course_to %notin% c("LCM", "SCY", "SCM")) == TRUE)
stop("Enter a correctly formatted course_to")
event_distance <-
as.numeric(stringr::str_extract(event, "\\d{2,4}"))
event_stroke <-
stringr::str_extract(event, stroke_strings)
#### fFactor ####
fFactor <- 1.11
if (all((course == "LCM"),
(course_to == "SCM")
)) {
fFactor <- 1.0
}
if (all((course == "LCM"),
(course_to == "SCY"),
stringr::str_detect(event, "(400.? Free)|(800.? Free)")
)) {
fFactor <- 0.8925
}
if (all((course == "LCM"),
(course_to == "SCY"),
stringr::str_detect(event, "1500.? Free"))) {
fFactor <- 1.02
}
if (all((course == "SCY"),
(course_to == "LCM"),
stringr::str_detect(event, "(500.? Free)|(1000.? Free)")
)) {
fFactor <- 0.8925
}
if (all((course == "SCY"),
(course_to == "LCM"),
stringr::str_detect(event, "1650.? Free"))) {
fFactor <- 1.02
}
#### Incre ####
Incre <- 1
if (all(stringr::str_detect(event_stroke, "(Butterf)?F?ly"))) {
Incre <- 0.7
}
if (all(stringr::str_detect(event_stroke, "Free(style)?"))) {
Incre <- 0.8
}
if (all(stringr::str_detect(Incre, "Back(stroke)?"))) {
Incre <- 0.6
}
if (all(stringr::str_detect(event_stroke, "Breast(stroke)?"))) {
# not strictly needed, default Incre is 1
Incre <- 1.0
}
if (all(stringr::str_detect(event_stroke, IM_strings))) {
#
Incre <- 0.8
}
#### fIncre ####
fIncre <- Incre
if (all(event_distance == 50)) {
fIncre <- Incre
}
if (all(event_distance == 100)) {
fIncre <- 2 * Incre
}
if (all(event_distance == 200)) {
fIncre <- 4 * Incre
}
if (all((event_distance == 400),
(course == "LCM"),
(course_to == "SCY"),
stringr::str_detect(event_stroke, IM_strings)
)) {
fIncre <- 6.4
}
if (all((event_distance == 400),
(course == "SCY"),
(course_to == "LCM"),
stringr::str_detect(event_stroke, IM_strings)
)) {
fIncre <- 6.4
}
if (all((event_distance > 200),
(course == "LCM"),
(course_to == "SCY"),
stringr::str_detect(event_stroke, non_IM_strings)
)) {
fIncre <- 0
}
if (all((event_distance > 200),
(course == "SCY"),
(course_to == "LCM"),
stringr::str_detect(event_stroke, non_IM_strings)
)) {
fIncre <- 0
}
if (all((event_distance %in% c(400, 500)),
(course == "SCM"),
(course_to == "LCM"),
stringr::str_detect(event_stroke, non_IM_strings)
)) {
fIncre <- 6.4
}
if (all((event_distance %in% c(800, 1000)),
(course == "SCM"),
(course_to == "LCM"))) {
fIncre <- 12.8
}
if (all((event_distance == 1500),
(course == "SCM"),
(course_to == "LCM"))) {
fIncre <- 24.0
}
if (all((event_distance == 400), (course == "LCM"), (course_to == "SCM"))) {
fIncre <- 6.4
}
if (all((event_distance == 800), (course == "LCM"), (course_to == "SCM"))) {
fIncre <- 12.8
}
if (all((event_distance == 1500),
(course == "LCM"),
(course_to == "SCM"))) {
fIncre <- 24.0
}
if (all((event_distance == 400),
(course == "LCM"),
(course_to == "SCY"),
stringr::str_detect(event_stroke, IM_strings)
)) {
fIncre <- 6.4
}
fIncre <- ifelse(is.na(fIncre) == TRUE, 0, fIncre)
#### Time_Converted_sec ####
if (all((course == "SCY"), (course_to %in% c("LCM", "SCM")))) {
Time_Converted_sec <- time * fFactor + fIncre
}
if (all((course == "LCM"), (course_to %in% c("SCY", "SCM")))) {
Time_Converted_sec <- (time - fIncre) / fFactor
}
if (all((course == "SCM"), (course_to == "SCY"))) {
Time_Converted_sec <- time / fFactor
}
if (all((course == "SCM"), (course_to == "LCM"))) {
Time_Converted_sec <- time + fIncre
}
if (all(course == course_to)) {
Time_Converted_sec <- time
}
Time_Converted_mmss <- mmss_format(Time_Converted_sec)
Time_Converted_sec <-
round(as.numeric(sprintf("%05.2f", Time_Converted_sec)), 2)
time <- mmss_format(time)
if (verbose == TRUE) {
df <- data.frame(
"Time" = time,
"Course" = course,
"Course_To" = course_to,
"Event" = event,
Time_Converted_sec,
Time_Converted_mmss
)
return(df)
} else {
return(Time_Converted_mmss)
}
}
#' Course converter, returns data frame - defunct
#'
#' Used to convert times between Long Course Meters, Short Course Meters and
#' Short Course Yards, returns data frame
#'
#' @importFrom dplyr mutate
#' @importFrom dplyr case_when
#' @importFrom dplyr select
#' @importFrom stringr str_to_upper
#' @importFrom stringr str_to_title
#' @importFrom stringr str_split_fixed
#' @importFrom purrr map_dbl
#'
#' @param time A time, or vector of times to convert. Can be in either seconds
#' (numeric, \code{95.97}) format or swim (character, \code{"1:35.97"}) format
#' @param event The event swum as \code{"100 Fly"}, \code{"200 IM"}, \code{"400
#' Free"}, \code{"50 Back"}, \code{"200 Breast"} etc.
#' @param course The course in which the time was swum as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#' @param course_to The course to convert the time to as \code{"LCM"},
#' \code{"SCM"} or \code{"SCY"}
#'
#' @return This function returns a data frame including columns: \itemize{ \item
#' Time \item Course \item Course_To \item Event \item Time_Converted_sec
#' \item Time_Converted_mmss }
#'
#' @note Relays are not presently supported.
#' @references Uses the USA swimming age group method described here
#' \url{https://support.gomotionapp.com/en/articles/6457476-how-to-perform-course-conversion-factoring-of-times}
course_convert_DF <- function(time, event, course, course_to) {
.Defunct(new = "course_convert(verbose = TRUE)", msg = "course_convert_df is defunct. Please use course_convert(verbose = TRUE) instead.", package = "SwimmeR")
}
#' @rdname course_convert_DF
#' @export
course_convert_df <- course_convert_DF
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.