-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
5 changed files
with
202 additions
and
1 deletion.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,9 @@ | ||
#' @keywords internal | ||
"_PACKAGE" | ||
|
||
# Imports: start ---- | ||
#' @importFrom grDevices dev.off pdf | ||
#' @importFrom graphics par rect text | ||
# Imports: end ---- | ||
|
||
NULL |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 | ||
} |
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.