From cc4e7b2c561c35c4a424ff04b142b6c3acf8efac Mon Sep 17 00:00:00 2001 From: Nicolas Casajus Date: Fri, 29 Mar 2024 12:34:05 +0100 Subject: [PATCH] feat: filter events by time period --- NAMESPACE | 1 + R/calendar-package.R | 9 +++ R/filter_events.R | 153 ++++++++++++++++++++++++++++++++++++++++ man/calendar-package.Rd | 2 +- man/filter_events.Rd | 38 ++++++++++ 5 files changed, 202 insertions(+), 1 deletion(-) create mode 100644 R/calendar-package.R create mode 100644 R/filter_events.R create mode 100644 man/filter_events.Rd diff --git a/NAMESPACE b/NAMESPACE index 3e5ef17..84ac7a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(filter_events) export(get_calendar) export(number_of_days) importFrom(grDevices,dev.off) diff --git a/R/calendar-package.R b/R/calendar-package.R new file mode 100644 index 0000000..b63e151 --- /dev/null +++ b/R/calendar-package.R @@ -0,0 +1,9 @@ +#' @keywords internal +"_PACKAGE" + +# Imports: start ---- +#' @importFrom grDevices dev.off pdf +#' @importFrom graphics par rect text +# Imports: end ---- + +NULL diff --git a/R/filter_events.R b/R/filter_events.R new file mode 100644 index 0000000..1910bd6 --- /dev/null +++ b/R/filter_events.R @@ -0,0 +1,153 @@ +#' Filter calendar events to match the extent on the calendar +#' +#' @param data a `data.frame` with at least the following columns: `from`, the +#' start of the event, `to`, the end of the event, `event`, the name of the +#' event, and `category`, the category of the event (used for different +#' colors). +#' +#' @param year either an `integer` or a `character` of length 1. Must have 4 +#' characters (e.g. '2024' and not '24'). Default is the current year. +#' +#' @param month either an `integer` or a `character` of length 1. Must have 1 +#' or 2 characters (e.g. '01' or '1'). Default is the current month. +#' +#' @param format a `character` of length 1. Used to specify the format of the +#' date. Default is `"%Y-%m-%d"` (i.e. 2024-12-25). +#' +#' @return A `data.frame`, same as the input but with only events matching the +#' extent on the calendar. +#' +#' @export +#' +#' @examples +#' ## No example --- + +filter_events <- function(data, year = format(Sys.Date(), "%Y"), + month = format(Sys.Date(), "%m"), + format = "%Y-%m-%d") { + + ## Check args ---- + + if (!is.character(year) && !is.numeric(year)) { + stop("Argument 'year' must either a character or an integer", call. = FALSE) + } + + if (length(year) > 1) { + stop("Argument 'year' must be of length 1", call. = FALSE) + } + + if (nchar(year) != 4) { + stop("Argument 'year' must be of the form 'YYYY'", call. = FALSE) + } + + if (!is.character(month) && !is.numeric(month)) { + stop("Argument 'month' must either a character or an integer", + call. = FALSE) + } + + if (length(month) > 1) { + stop("Argument 'month' must be of length 1", call. = FALSE) + } + + if (nchar(month) == 1) { + month <- paste0("0", month) + } + + if (nchar(month) != 2) { + stop("Argument 'month' must be of the form 'MM' or 'M' (e.g. '01' or '1')", + call. = FALSE) + } + + if (missing(data)) { + stop("Argument 'data' is required", call. = FALSE) + } + + if (!is.data.frame(data)) { + stop("Argument 'data' must be a data.frame", call. = FALSE) + } + + if (nrow(data) == 0) { + stop("Argument 'data' must have at least one row (calendar event)", + call. = FALSE) + } + + if (!("from" %in% colnames(data))) { + stop("Column 'from' (start of the event) is missing from 'data'", + call. = FALSE) + } + + if (!("to" %in% colnames(data))) { + stop("Column 'to' (end of the event) is missing from 'data'", + call. = FALSE) + } + + if (!("event" %in% colnames(data))) { + stop("Column 'event' (name of the event) is missing from 'data'", + call. = FALSE) + } + + if (!("category" %in% colnames(data))) { + stop("Column 'category' (category of the event) is missing from 'data'", + call. = FALSE) + } + + if (!inherits(data$"from", "Date")) { + data$"from" <- as.Date(data$"from", format = format) + } + + + if (any(is.na(data$"from"))) { + stop("Error in converting dates. Please use the argument 'format' to ", + "specify the appropriate format. See '?strptime' for further ", + "information", call. = FALSE) + } + + if (!inherits(data$"to", "Date")) { + data$"to" <- as.Date(data$"to", format = format) + } + + + if (any(is.na(data$"to"))) { + stop("Error in converting dates. Please use the argument 'format' to ", + "specify the appropriate format. See '?strptime' for further ", + "information", call. = FALSE) + } + + + ## Filter event dates ---- + + calendar <- get_calendar(year, month) + + events <- data.frame() + + for (i in 1:nrow(data)) { + + dates <- seq(data[i, "from"], data[i, "to"], by = "days") + + dates <- dates[which(dates %in% calendar$"date")] + + if (length(dates) > 0) { + + events <- rbind(events, + data.frame("event" = data[i, "event"], + "from" = as.character(min(dates)), + "to" = as.character(max(dates)), + "category" = data[i, "category"])) + } + } + + + ## Order events by category (need to be improved) ---- + + if (nrow(events) > 0) { + + events$"order" <- ifelse(events$"category" == "Course", 1, + ifelse(events$"category" == "Group", 2, 3)) + + events <- events[with(events, order(from, order, event)), ] + + rownames(events) <- NULL + } + + events +} diff --git a/man/calendar-package.Rd b/man/calendar-package.Rd index 5abfc3c..4d46584 100644 --- a/man/calendar-package.Rd +++ b/man/calendar-package.Rd @@ -4,7 +4,7 @@ \name{calendar-package} \alias{calendar} \alias{calendar-package} -\title{calendar: Create a Monthly Calendar} +\title{calendar: Create a Monthly Calendar with Events} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} diff --git a/man/filter_events.Rd b/man/filter_events.Rd new file mode 100644 index 0000000..18f083f --- /dev/null +++ b/man/filter_events.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filter_events.R +\name{filter_events} +\alias{filter_events} +\title{Filter calendar events to match the extent on the calendar} +\usage{ +filter_events( + data, + year = format(Sys.Date(), "\%Y"), + month = format(Sys.Date(), "\%m"), + format = "\%Y-\%m-\%d" +) +} +\arguments{ +\item{data}{a \code{data.frame} with at least the following columns: \code{from}, the +start of the event, \code{to}, the end of the event, \code{event}, the name of the +event, and \code{category}, the category of the event (used for different +colors).} + +\item{year}{either an \code{integer} or a \code{character} of length 1. Must have 4 +characters (e.g. '2024' and not '24'). Default is the current year.} + +\item{month}{either an \code{integer} or a \code{character} of length 1. Must have 1 +or 2 characters (e.g. '01' or '1'). Default is the current month.} + +\item{format}{a \code{character} of length 1. Used to specify the format of the +date. Default is \code{"\%Y-\%m-\%d"} (i.e. 2024-12-25).} +} +\value{ +A \code{data.frame}, same as the input but with only events matching the +extent on the calendar. +} +\description{ +Filter calendar events to match the extent on the calendar +} +\examples{ +## No example --- +}