From c9699fc4e884f43c7f455dfb79ec59a2cc5cd33d Mon Sep 17 00:00:00 2001 From: Nicolas Casajus Date: Fri, 29 Mar 2024 15:57:18 +0100 Subject: [PATCH] feat: main feature - plot calendar w/ events --- DESCRIPTION | 3 + NAMESPACE | 1 + R/add_events.R | 2 +- R/plot_calendar.R | 353 +++++++++++++++++++++++++++++++++++++++++++ man/plot_calendar.Rd | 61 ++++++++ 5 files changed, 419 insertions(+), 1 deletion(-) create mode 100644 R/plot_calendar.R create mode 100644 man/plot_calendar.Rd diff --git a/DESCRIPTION b/DESCRIPTION index f3030f3..8a11faa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,3 +18,6 @@ License: GPL (>= 2) Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 +Imports: + graphics, + grDevices diff --git a/NAMESPACE b/NAMESPACE index 9407148..ceec14f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(filter_events) export(get_calendar) export(number_of_days) +export(plot_calendar) importFrom(grDevices,dev.off) importFrom(grDevices,pdf) importFrom(graphics,mtext) diff --git a/R/add_events.R b/R/add_events.R index a1034fd..fca3593 100644 --- a/R/add_events.R +++ b/R/add_events.R @@ -14,7 +14,7 @@ add_events <- function(data, year, month, palette) { ## Add color to data ---- - categories <- unique(data$"categories") + categories <- unique(data$"category") if (length(palette) > 1) { diff --git a/R/plot_calendar.R b/R/plot_calendar.R new file mode 100644 index 0000000..7c082bf --- /dev/null +++ b/R/plot_calendar.R @@ -0,0 +1,353 @@ +#' Export a monthly calendar as pdf +#' +#' @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 path a `character` of length 1. The directory to save the `pdf` file. +#' Must exist. Default is the current directory. +#' +#' @param filename a `character` of length 1. The name of the `pdf` file. +#' Default is `calendar-YYYY-MM.pdf` (e.g. `calendar-2024-04.pdf`). +#' +#' @param title a `character` of length 1. The title of the calendar. Default is +#' `Month YYYY` (e.g. `April 2024`). +#' +#' @param events an optional `data.frame` with the following columns: `event`, +#' the name of the event, `from`, the starting date of the event, `to`, the +#' ending date of the event, and `category`, the category of the event. +#' +#' @param weekend a `logical`. If `TRUE` keeps Saturdays and Sundays. Default is +#' `FALSE`. +#' +#' @param palette a `character` vector of colors for the events. If only one +#' color is provided (default), all events will have this color. If +#' several colors are provided, the number of colors in `palette` must be +#' equal to the total number of event categories (duplicated colors are +#' accepted). Moreover, the `palette` argument must be a named vector, where +#' names match event categories. For example, let's that the `events` object +#' contains two categories (`cat_a` and `cat_b`), the `palette` argument must +#' be equal to `palette = c("cat_a" = "black", "cat_b" = "red")`. +#' +#' @return No return value. The calendar will exported as a `pdf` file in +#' `path`. +#' +#' @export +#' +#' @examples +#' \dontrun{ +#' ## Add an example ---- +#' } + +plot_calendar <- function(year = format(Sys.Date(), "%Y"), + month = format(Sys.Date(), "%m"), + path = getwd(), filename = NULL, title = NULL, + events = NULL, weekend = FALSE, palette = "#990000") { + + ## Check year ---- + + 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) + } + + + ## Check month ---- + + 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' (e.g. '01' instead of '1')", + call. = FALSE) + } + + + ## Check path ---- + + if (!is.character(path)) { + stop("Argument 'path' must be a character", call. = FALSE) + } + + if (length(path) != 1) { + stop("Argument 'path' must be a character of length 1", call. = FALSE) + } + + if (!dir.exists(path)) { + stop("The directory '", path, "' does not exist", call. = FALSE) + } + + + ## Check filename ---- + + if (!is.null(filename)) { + + if (!is.character(filename)) { + stop("Argument 'filename' must be a character", call. = FALSE) + } + + if (length(filename) != 1) { + stop("Argument 'filename' must be a character of length 1", call. = FALSE) + } + } + + + ## Check title ---- + + if (!is.null(title)) { + + if (!is.character(title)) { + stop("Argument 'title' must be a character", call. = FALSE) + } + + if (length(title) != 1) { + stop("Argument 'title' must be a character of length 1", call. = FALSE) + } + } + + + ## Check events ---- + + if (!is.null(events)) { + + if (!is.data.frame(events)) { + stop("Argument 'events' must be a data.frame", call. = FALSE) + } + + if (nrow(events) == 0) { + stop("Argument 'events' must have at least one row (calendar event)", + call. = FALSE) + } + + if (!("from" %in% colnames(events))) { + stop("Column 'from' (start of the event) is missing from 'events'", + call. = FALSE) + } + + if (!("to" %in% colnames(events))) { + stop("Column 'to' (end of the event) is missing from 'events'", + call. = FALSE) + } + + if (!("event" %in% colnames(events))) { + stop("Column 'event' (name of the event) is missing from 'events'", + call. = FALSE) + } + + if (!("category" %in% colnames(events))) { + stop("Column 'category' (category of the event) is missing from 'events'", + call. = FALSE) + } + } + + + ## Check weekend ---- + + if (!is.logical(weekend)) { + stop("Argument 'weekend' must be a logical ('TRUE' or 'FALSE')", + call. = FALSE) + } + + if (length(weekend) != 1) { + stop("Argument 'weekend' must be a logical ('TRUE' or 'FALSE')", + call. = FALSE) + } + + + ## Check palette ---- + + if (!is.character(palette)) { + stop("Argument 'palette' must be a character (color)", call. = FALSE) + } + + if (length(palette) > 1 && !is.null(events)) { + + if (any(names(palette) == "")) { + stop("Some colors in 'palette' don't have name", call. = FALSE) + } + + categories <- unique(events$"category") + + if (any(!(categories %in% names(palette)))) { + stop("Some event categories don't have color. Please check the ", + "argument 'palette'", call. = FALSE) + } + } + + + ## Create filename ---- + + if (is.null(filename)) { + filename <- paste("calendar", year, month, sep = "-") + } + + filename <- paste0(filename, ".pdf") + filename <- gsub("\\.pdf\\.pdf", ".pdf", filename) + + + ## Get calendar data ---- + + calendar <- get_calendar(year, month, weekend) + offs <- days_off(year) + + + ## Create title ---- + + if (is.null(title)) { + title <- paste(unique(calendar[ , "month_name"]), year) + } + + + ## Define x-axis range ---- + + x_lim <- c(0, length(unique(calendar$"weekday"))) + + + ## Define y-axis range ---- + + n_weeks <- length(unique(calendar$"week")) + + y_lim <- c(NA, 6) + + y_lim[1] <- ifelse(n_weeks == 6, 0, y_lim[1]) + y_lim[1] <- ifelse(n_weeks == 5, 1, y_lim[1]) + y_lim[1] <- ifelse(n_weeks == 4, 2, y_lim[1]) + + + ## Graphical parameters ---- + + pdf(file = file.path(path, filename), + width = 11.69291, + height = 8.26772, + paper = "a4r", + pointsize = 16) + + par(family = "serif", + mar = c(0.5, 0.5, 2.5, 0.5), + xaxs = "i", + yaxs = "i", + lend = "square", + cex.axis = 1.25, + mgp = c(1.5, 0.2, 0), + tcl = -0.25, + xpd = FALSE, + new = FALSE, + fig = c(0, 1, 0, 1), + fg = "#333333", + col = "#333333", + col.axis = "#333333", + col.lab = "#333333", + font.lab = 2, + cex.axis = 1.0) + + plot(0, + type = "n", + bty = "n", + axes = FALSE, + ann = FALSE, + xlim = x_lim, + ylim = y_lim) + + + ## Add calendar data (days and holidays) ---- + + for (i in 1:nrow(calendar)) { + + rect(xleft = calendar[i, "x"] - 1, + xright = calendar[i, "x"], + ybottom = calendar[i, "y"] - 1, + ytop = calendar[i, "y"], + col = "#ffffff", + lwd = 0.75, + xpd = TRUE) + + + ## Add holidays ---- + + if (calendar[i, "date"] %in% offs$"date") { + + rect(xleft = calendar[i, "x"] - 1, + xright = calendar[i, "x"], + ybottom = calendar[i, "y"] - 1, + ytop = calendar[i, "y"], + col = "#efefef", + lwd = 0.75, + xpd = TRUE) + + text(x = calendar[i, "x"] - 0.50, + y = calendar[i, "y"] - 0.75, + labels = paste0("OFF - ", offs[which(offs$"date" == + calendar[i, "date"]), + "event"]), + cex = 0.65, + font = 2, + col = "#666666") + } + + + ## Add day number ---- + + text(x = calendar[i, "x"] - 1.04, + y = calendar[i, "y"] - 0.10, + labels = calendar[i, "day"], + pos = 4, + cex = 0.35) + } + + + ## Add day names (top axis) ---- + + for (i in 1:nrow(weekdays())) { + + text(x = weekdays()[i, "x"] - 0.5, + y = 5.95, + labels = weekdays()[i, "weekday"], + cex = 0.65, + pos = 3, + font = 2, + xpd = TRUE) + } + + + ## Add title ---- + + mtext(title, + side = 3, + line = 1, + cex = 1.25, + font = 2) + + + ## Add events ---- + + if (!is.null(events)) { + + add_events(events, year, month, palette) + } + + + invisible(dev.off()) + + message("Calendar successfully exported as '", file.path(path, filename), "'") + + invisible(NULL) +} diff --git a/man/plot_calendar.Rd b/man/plot_calendar.Rd new file mode 100644 index 0000000..9982c21 --- /dev/null +++ b/man/plot_calendar.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_calendar.R +\name{plot_calendar} +\alias{plot_calendar} +\title{Export a monthly calendar as pdf} +\usage{ +plot_calendar( + year = format(Sys.Date(), "\%Y"), + month = format(Sys.Date(), "\%m"), + path = getwd(), + filename = NULL, + title = NULL, + events = NULL, + weekend = FALSE, + palette = "#990000" +) +} +\arguments{ +\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{path}{a \code{character} of length 1. The directory to save the \code{pdf} file. +Must exist. Default is the current directory.} + +\item{filename}{a \code{character} of length 1. The name of the \code{pdf} file. +Default is \code{calendar-YYYY-MM.pdf} (e.g. \verb{calendar-2024-04.pdf}).} + +\item{title}{a \code{character} of length 1. The title of the calendar. Default is +\verb{Month YYYY} (e.g. \verb{April 2024}).} + +\item{events}{an optional \code{data.frame} with the following columns: \code{event}, +the name of the event, \code{from}, the starting date of the event, \code{to}, the +ending date of the event, and \code{category}, the category of the event.} + +\item{weekend}{a \code{logical}. If \code{TRUE} keeps Saturdays and Sundays. Default is +\code{FALSE}.} + +\item{palette}{a \code{character} vector of colors for the events. If only one +color is provided (default), all events will have this color. If +several colors are provided, the number of colors in \code{palette} must be +equal to the total number of event categories (duplicated colors are +accepted). Moreover, the \code{palette} argument must be a named vector, where +names match event categories. For example, let's that the \code{events} object +contains two categories (\code{cat_a} and \code{cat_b}), the \code{palette} argument must +be equal to \code{palette = c("cat_a" = "black", "cat_b" = "red")}.} +} +\value{ +No return value. The calendar will exported as a \code{pdf} file in +\code{path}. +} +\description{ +Export a monthly calendar as pdf +} +\examples{ +\dontrun{ +## Add an example ---- +} +}