diff --git a/R/add_events.R b/R/add_events.R index 4af19a3..29177a3 100644 --- a/R/add_events.R +++ b/R/add_events.R @@ -57,11 +57,14 @@ add_events <- function(data, year, month, palette, weekend) { for (i in 1:nrow(data)) { - x_lft <- calendar[which(calendar[ , "date"] == data[i, "from"]), "x"] - x_rght <- calendar[which(calendar[ , "date"] == data[i, "to"]), "x"] + from <- data[i, "from"] + to <- ifelse(is.na(data[i, "to"]), data[i, "from"], data[i, "to"]) - y_btm <- calendar[which(calendar[ , "date"] == data[i, "from"]), "y"] - y_top <- calendar[which(calendar[ , "date"] == data[i, "to"]), "y"] + x_lft <- calendar[which(calendar[ , "date"] == from), "x"] + x_rght <- calendar[which(calendar[ , "date"] == to), "x"] + + y_btm <- calendar[which(calendar[ , "date"] == from), "y"] + y_top <- calendar[which(calendar[ , "date"] == to), "y"] if (i == 1) { @@ -97,7 +100,7 @@ add_events <- function(data, year, month, palette, weekend) { y_line <- max(coords[which(coords$"key" %in% coord$"key"), "n"]) } - # if (data[i, "from"] != data[i, "to"]) { + if (!is.na(data[i, "to"])) { rect(xleft = x_lft - 1 + 0.025, xright = x_rght - 0.025, @@ -115,22 +118,22 @@ add_events <- function(data, year, month, palette, weekend) { font = 2, col = "#ffffff") - # } else { - - # points(x = x_lft - 1 + 0.075, - # y = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2, - # pch = 19, - # cex = 0.85, - # col = data[i, "color"]) - # - # text(x = x_lft - 1 + 0.075, - # y = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2 - 0.01, - # labels = data[i, "event"], - # cex = 0.65, - # font = 2, - # pos = 4, - # col = data[i, "color"]) - # } + } else { + + points(x = x_lft - 1 + 0.05, + y = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2, + pch = 19, + cex = 0.85, + col = data[i, "color"]) + + text(x = x_lft - 1 + 0.05, + y = y_btm - (0.18 * y_line + 0.02 * (y_line - 1)) - 0.18 / 2 - 0.01, + labels = data[i, "name"], + cex = 0.65, + font = 2, + pos = 4, + col = "#333333") + } } } diff --git a/R/check_events.R b/R/check_events.R index 5018a33..37d03ac 100644 --- a/R/check_events.R +++ b/R/check_events.R @@ -24,8 +24,9 @@ check_events <- function(data) { } days <- unlist(lapply(1:nrow(data), function(i) { - as.character(seq(as.Date(data[i, "from"]), as.Date(data[i, "to"]), - by = "days")) + from <- data[i, "from"] + to <- ifelse(is.na(data[i, "to"]), data[i, "from"], data[i, "to"]) + as.character(seq(as.Date(from), as.Date(to), by = "days")) })) n_events_by_day <- table(days) diff --git a/R/filter_events.R b/R/filter_events.R index 6c5f455..5e16b5b 100644 --- a/R/filter_events.R +++ b/R/filter_events.R @@ -110,11 +110,11 @@ filter_events <- function(data, year = format(Sys.Date(), "%Y"), } - 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) - } + # 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) + # } if (!is.character(format)) { stop("Argument 'format' must be a character", call. = FALSE) @@ -143,25 +143,38 @@ filter_events <- function(data, year = format(Sys.Date(), "%Y"), for (i in 1:nrow(data)) { - dates <- seq(data[i, "from"], data[i, "to"], by = "days") + if (!is.na(data[i, "to"])) { + + dates <- seq(data[i, "from"], data[i, "to"], by = "days") + case <- "multi_day" + + } else { + + dates <- data[i, "from"] + case <- "single_day" + } + dates <- dates[which(dates %in% calendar$"date")] if (length(dates) > 0) { - + + from <- as.character(min(dates, na.rm = TRUE)) + to <- ifelse(case == "single_day", NA, as.character(max(dates))) + if ("category" %in% colnames(data)) { events <- rbind(events, data.frame("name" = data[i, "name"], - "from" = as.character(min(dates)), - "to" = as.character(max(dates)), + "from" = from, + "to" = to, "category" = data[i, "category"])) } else { events <- rbind(events, data.frame("name" = data[i, "name"], - "from" = as.character(min(dates)), - "to" = as.character(max(dates)))) + "from" = from, + "to" = to)) } } } diff --git a/R/multiweek_events.R b/R/multiweek_events.R index ce371cf..a269f6b 100644 --- a/R/multiweek_events.R +++ b/R/multiweek_events.R @@ -16,10 +16,20 @@ multiweek_events <- function(data, year, month, weekend) { for (i in 1:nrow(data)) { - days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), - as.Date(data[i, "to"]), - by = "days"))) + case <- ifelse(is.na(data[i, "to"]), "single_day", "multi_day") + if (case == "single_day") { + + days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), + as.Date(data[i, "from"]), + by = "days"))) + } else { + + days <- data.frame("date" = as.character(seq(as.Date(data[i, "from"]), + as.Date(data[i, "to"]), + by = "days"))) + } + days <- merge(days, calendar, by = "date", all = FALSE) dates <- tapply(days$"date", days$"y", function(x) { @@ -41,11 +51,15 @@ multiweek_events <- function(data, year, month, weekend) { days[-1, "name"] <- paste(days[-1, "name"], "(continued)") } + days$"n_days" <- (as.Date(days$"to") - as.Date(days$"from")) + + if(case == "single_day") { + days$"to" <- NA + } + events <- rbind(events, days) } - events$"n_days" <- (as.Date(events$"to") - as.Date(events$"from")) - events <- events[with(events, order(from, -n_days, name)), ] rownames(events) <- NULL diff --git a/man/filter_events.Rd b/man/filter_events.Rd index a714b7d..76e5890 100644 --- a/man/filter_events.Rd +++ b/man/filter_events.Rd @@ -14,7 +14,7 @@ filter_events( } \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 +start of the event, \code{to}, the end of the event, \code{name}, the name of the event, and \code{category}, the category of the event (used for different colors).} diff --git a/man/monthly_calendar.Rd b/man/monthly_calendar.Rd index b5b5bf5..2be7e1d 100644 --- a/man/monthly_calendar.Rd +++ b/man/monthly_calendar.Rd @@ -12,7 +12,7 @@ monthly_calendar( title = NULL, events = NULL, weekend = TRUE, - palette = "#990000", + palette = "#333333", lang = NULL, holidays = NULL, moon = FALSE, @@ -35,7 +35,7 @@ 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}, +\item{events}{an optional \code{data.frame} with the following columns: \code{name}, 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.}