diff --git a/R/get_calendar.R b/R/get_calendar.R index 8e8de12..dc03b3e 100644 --- a/R/get_calendar.R +++ b/R/get_calendar.R @@ -8,6 +8,11 @@ #' #' @param weekend a `logical`. If `TRUE` keeps Saturdays and Sundays. Default is #' `FALSE`. +#' +#' @param lang a `character` of length 1. Used to change the default locale +#' (i.e. the language). Default is `NULL` (i.e. use the current locale). +#' See examples below. Depending on the OS and the locale, the output can be +#' weird. #' #' @return A `data.frame` with the following columns: #' - `date`: the date of the day (`YYYY-MM-DD`), @@ -34,9 +39,13 @@ #' #' ## Calendar for January 1970 ---- #' head(get_calendar(year = 1970, month = 1)) +#' +#' ## Change the locale ---- +#' head(get_calendar(year = 1970, month = 1, lang = "spanish")) get_calendar <- function(year = format(Sys.Date(), "%Y"), - month = format(Sys.Date(), "%m"), weekend = FALSE) { + month = format(Sys.Date(), "%m"), weekend = FALSE, + lang = NULL) { ## Check args ---- @@ -72,9 +81,9 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"), ## Switch to US locale ---- - locale <- Sys.getlocale("LC_TIME") + lc_time <- Sys.getlocale("LC_TIME") + on.exit(Sys.setlocale("LC_TIME", lc_time), add = TRUE) Sys.setlocale("LC_TIME", "en_US.UTF-8") - on.exit(Sys.setlocale("LC_TIME", locale)) ## Create sequence of days ---- @@ -88,24 +97,44 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"), ## Extract date info ---- - calendar <- data.frame("date" = dates, - "year" = as.integer(format(dates, "%Y")), - "month" = as.integer(format(dates, "%m")), - "day" = as.integer(format(dates, "%d")), - "month_name" = tools::toTitleCase(format(dates, "%B")), - "weekday" = tools::toTitleCase(format(dates, "%A")), - "week" = as.integer(format(dates, "%W"))) + calendar <- data.frame( + "date" = dates, + "year" = as.integer(format(dates, "%Y")), + "month" = as.integer(format(dates, "%m")), + "day" = as.integer(format(dates, "%d")), + "en_month_name" = tools::toTitleCase(format(dates, "%B")), + "en_weekday" = tools::toTitleCase(format(dates, "%A")), + "week" = as.integer(format(dates, "%W"))) + + + ## Translate names ---- + + if (is.null(lang)) { + lang <- lc_time + } + + Sys.setlocale("LC_TIME", lc_time) + + calendar$"user_month_name" <- unlist(lapply(calendar$"month", + get_month_name, + lang = lang)) + + calendar$"user_weekday" <- unlist(lapply(calendar$"date", + get_weekday_name, + lang = lang)) ## Add position on x-axis (day of the week) ---- - calendar <- merge(calendar, weekdays(), by = "weekday", all = TRUE) + calendar <- merge(calendar, weekdays(), by.x = "en_weekday", by.y = "weekday", + all = TRUE) ## Remove weekend (if required) ---- if (!weekend) { - calendar <- calendar[!(calendar$"weekday" %in% c("Saturday", "Sunday")), ] + calendar <- calendar[!(calendar$"en_weekday" %in% + c("Saturday", "Sunday")), ] } @@ -131,8 +160,9 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"), ## Order columns ---- - calendar <- calendar[ , c("date", "year", "month", "day", "week", "weekday", - "month_name", "x", "y")] + calendar <- calendar[ , c("date", "year", "month", "day", "week", + "en_weekday", "en_month_name", "user_weekday", + "user_month_name","x", "y")] calendar } diff --git a/R/plot_calendar.R b/R/plot_calendar.R index 0f47600..50f93e8 100644 --- a/R/plot_calendar.R +++ b/R/plot_calendar.R @@ -30,7 +30,12 @@ #' 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")`. -#' +#' +#' @param lang a `character` of length 1. Used to change the default locale +#' (i.e. the language). Default is `NULL` (i.e. use the current locale). +#' See examples below. Depending on the OS and the locale, the output can be +#' weird. +#' #' @return No return value. The calendar will exported as a `pdf` file in #' `path`. #' @@ -44,7 +49,8 @@ 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") { + events = NULL, weekend = FALSE, palette = "#990000", + lang = NULL) { ## Check year ---- @@ -206,20 +212,20 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"), ## Get calendar data ---- - calendar <- get_calendar(year, month, weekend) + calendar <- get_calendar(year, month, weekend, lang = lang) offs <- days_off(year) ## Create title ---- if (is.null(title)) { - title <- paste(unique(calendar[ , "month_name"]), year) + title <- paste(unique(calendar[ , "user_month_name"]), year) } ## Define x-axis range ---- - x_lim <- c(0, length(unique(calendar$"weekday"))) + x_lim <- c(0, length(unique(calendar$"en_weekday"))) ## Define y-axis range ---- @@ -233,6 +239,28 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"), y_lim[1] <- ifelse(n_weeks == 4, 2, y_lim[1]) + ## Switch locale ---- + + if (!is.null(lang)) { + + o_warn <- options()$"warn" + + lc_time <- Sys.getlocale("LC_TIME") + lc_ctype <- Sys.getlocale("LC_CTYPE") + lc_collate <- Sys.getlocale("LC_COLLATE") + + on.exit(options("warn" = o_warn), add = TRUE) + on.exit(Sys.setlocale("LC_TIME", lc_time), add = TRUE) + on.exit(Sys.setlocale("LC_CTYPE", lc_ctype), add = TRUE) + on.exit(Sys.setlocale("LC_COLLATE", lc_collate), add = TRUE) + + options("warn" = -1) + Sys.setlocale("LC_TIME", lang) + Sys.setlocale("LC_CTYPE", lang) + Sys.setlocale("LC_COLLATE", lang) + } + + ## Graphical parameters ---- cairo_pdf(filename = file.path(path, filename), @@ -282,7 +310,7 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"), ## Add weekend ---- - if (calendar[i, "weekday"] %in% c("Saturday", "Sunday")) { + if (calendar[i, "en_weekday"] %in% c("Saturday", "Sunday")) { rect(xleft = calendar[i, "x"] - 1, xright = calendar[i, "x"], @@ -331,9 +359,12 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"), for (i in 1:nrow(weekdays())) { + label <- which(calendar$"en_weekday" == weekdays()[i, "weekday"]) + label <- calendar[label[1], "user_weekday"] + text(x = weekdays()[i, "x"] - 0.5, y = 5.95, - labels = weekdays()[i, "weekday"], + labels = label, cex = 0.65, pos = 3, font = 2, diff --git a/man/get_calendar.Rd b/man/get_calendar.Rd index c50275e..0ee5a85 100644 --- a/man/get_calendar.Rd +++ b/man/get_calendar.Rd @@ -7,7 +7,8 @@ get_calendar( year = format(Sys.Date(), "\%Y"), month = format(Sys.Date(), "\%m"), - weekend = FALSE + weekend = FALSE, + lang = NULL ) } \arguments{ @@ -19,6 +20,11 @@ or 2 characters (e.g. '01' or '1'). Default is the current month.} \item{weekend}{a \code{logical}. If \code{TRUE} keeps Saturdays and Sundays. Default is \code{FALSE}.} + +\item{lang}{a \code{character} of length 1. Used to change the default locale +(i.e. the language). Default is \code{NULL} (i.e. use the current locale). +See examples below. Depending on the OS and the locale, the output can be +weird.} } \value{ A \code{data.frame} with the following columns: @@ -49,4 +55,7 @@ head(get_calendar(month = 4)) ## Calendar for January 1970 ---- head(get_calendar(year = 1970, month = 1)) + +## Change the locale ---- +head(get_calendar(year = 1970, month = 1, lang = "spanish")) } diff --git a/man/plot_calendar.Rd b/man/plot_calendar.Rd index 9982c21..a981908 100644 --- a/man/plot_calendar.Rd +++ b/man/plot_calendar.Rd @@ -12,7 +12,8 @@ plot_calendar( title = NULL, events = NULL, weekend = FALSE, - palette = "#990000" + palette = "#990000", + lang = NULL ) } \arguments{ @@ -46,6 +47,11 @@ 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")}.} + +\item{lang}{a \code{character} of length 1. Used to change the default locale +(i.e. the language). Default is \code{NULL} (i.e. use the current locale). +See examples below. Depending on the OS and the locale, the output can be +weird.} } \value{ No return value. The calendar will exported as a \code{pdf} file in