Get meeting slots from session dates, session start times, session end times and number of slots per session

get_meeting_slots.R

## Author: Ioannis Kosmidis
## Version: 0.2
## Date: 20 April 2020
## NOT A POLISHED PIECE OF PUBLIC-USE SOFTWARE!  Provided "as is".
## NO WARRANTY OF FITNESS FOR ANY PURPOSE!


#' Get meeting slots from a vector of session dates, session start times, session
#' end times and number of slots per session

#' @param dates a vector of character strings with the session dates in YYYY-MM-DD format (e.g. "1999-12-31")
#' @param times a vector of character strings with the session start times in HH-MM 24h format (e.g. "00:01")
#' @param times a vector of character strings with the session start times in HH-MM 24h format (e.g. "12:02")
#' @param n_slots an integer for the number of slots to compute per session
#' @param path_to_csv the path where to write a CSV with the dates, start times, and end times of the slots. If \code{NULL} (default), then no CSV file is produced.
#'
#' @examples
#' ## Edit 1-4 as appropriate
#' 
#' ## 1. Dates where each session is being held in YYYY-MM-DD format
#' dates <- c("2020-04-20", "2020-04-24", "2020-04-27", "2020-05-01")
#'
#' ## 2. Start time of each session (corresponds to the dates) in HH:MM format (24h)
#' start_times <- c("09:30", "09:30", "09:30", "09:30")
#'
#' ## 3. End times of each session (corresponds to the dates) in HH:MM format (24h)
#' end_times <- c("10:30", "10:30", "10:30", "10:30")
#'
#' ## 4. Number of slots in each session
#' n_slots <- c(4, 4, 4, 4)
#'
#' Get the meeting slots
#' get_meeting_slots(dates, start_times, end_times, n_slots, verbose = TRUE)
#'
#' Get a data.frame with those
#' slots <- get_meeting_slots(dates, start_times, end_times, n_slots, verbose = FALSE)
#' slots
#'
#' Get a data.frame with the slots and write dates, start and end times on a CSV file
#' slots <- get_meeting_slots(dates, start_times, end_times, n_slots, verbose = FALSE, path_to_csv = "~/Downloads/slots.csv")
#' 
get_meeting_slots <- function(dates,
                              start_times,
                              end_times,
                              n_slots,
                              path_to_csv = NULL,
                              verbose = TRUE) {
    ns <- c(length(dates), length(start_times), length(end_times), length(n_slots))    
    if (!all(outer(ns, ns, "==")))
        stop("`dates`, `start_times`, `end_times` and `n_slots` must have the same lengths")
    start <- as.POSIXct(paste(dates, start_times), format = "%Y-%m-%d %H:%M")
    end <- as.POSIXct(paste(dates, end_times), format = "%Y-%m-%d %H:%M")
    sequences <- mapply(function(s, e, n) seq(s, e, length.out = n + 1), start, end, n_slots, SIMPLIFY = FALSE)    
    slots <- do.call("rbind", lapply(sequences, function(x) {
        data.frame(start = x[-length(x)], end = x[-1])
    }))
    if (verbose) {
        out <- mapply(function(s, e) {
            paste(format(s, format = "%d %b %Y %H:%M"), format(e, format = "%H:%M"), sep = "-")
        }, slots$start, slots$end)
        cat("\n")
        cat(paste0(out, collapse = "\n"), sep = "")
        cat("\n")
    }    
    if (!isTRUE(is.null(path_to_csv))) {
        out <- do.call("rbind", mapply(function(s, e) {
            data.frame(date = format(s, format = "%d %b %Y"),
                       start = format(s, format = "%H:%M"),
                       end = format(e, format = "%H:%M"), stringsAsFactors = FALSE)
        }, slots$start, slots$end, SIMPLIFY = FALSE))
        write.csv(out, path_to_csv)
    }
    invisible(slots)
}