diff --git a/R/calendR.R b/R/calendR.R index 8b60143..86672f0 100644 --- a/R/calendR.R +++ b/R/calendR.R @@ -6,7 +6,7 @@ #' @param month Month of the year or `NULL` (default) for the yearly calendar. #' @param from Custom start date of the calendar. If `from != NULL`, `year` and `month` arguments won't be taken into account. #' @param to Custom end date of the calendar. -#' @param start `"S"` (default) for starting the week on Sunday or `"M"` for starting the week on Monday. +#' @param start `"S"` (default) for starting the week on Sunday or `"M"` for starting the week on Monday. Also accepts numbers 0 to 6, where 0 = Sunday and 6 = Saturday. #' @param orientation The calendar orientation: `"portrait"` or `"landscape"` (default). Also accepts `"p"` and `"l"`. #' @param title Title of the the calendar. If not supplied is the year and the month, or the year if `month = NULL`. #' @param title.size Size of the main title. @@ -83,7 +83,7 @@ calendR <- function(year = format(Sys.Date(), "%Y"), from = NULL, to = NULL, - start = c("S", "M"), + start = c("S", "M", 0:6), orientation = c("portrait", "landscape"), title, @@ -177,7 +177,8 @@ calendR <- function(year = format(Sys.Date(), "%Y"), } - match.arg(start, c("S", "M")) + match.arg(start |> as.character(), c("S", "M", 0:6)) + start <- ifelse(start == "S", 0, ifelse(start == "M", 1, as.integer(start))) match.arg(orientation, c("landscape", "portrait", "l", "p")) match.arg(papersize, c("A6", "A5", "A4", "A3", "A2", "A1", "A0")) @@ -336,108 +337,52 @@ calendR <- function(year = format(Sys.Date(), "%Y"), } } + weekdays <- weeknames[(0:6 + start - 1) %% 7 + 1] + t1 <- tibble(date = dates, fill = fills) %>% + right_join(filler, by = "date") %>% # fill in missing dates with NA + mutate(dow = as.numeric(format(date - start, "%w"))) %>% + mutate(month = format(date, "%B")) %>% + mutate(woy = as.numeric(format(date, "%U")) - (as.numeric(format(date, "%w")) < start)) %>% + mutate(year = as.numeric(format(date, "%Y"))) %>% + mutate(month = toupper(factor(month, levels = months, ordered = TRUE))) %>% + # arrange(year, month) %>% + mutate(monlabel = month) + + if (!is.null(month)) { # multi-year data set + t1$monlabel <- paste(t1$month, t1$year) + } - if(start == "M") { - - weekdays <- weeknames - - t1 <- tibble(date = dates, fill = fills) %>% - right_join(filler, by = "date") %>% # fill in missing dates with NA - mutate(dow = ifelse(as.numeric(format(date, "%w")) == 0, 6, as.numeric(format(date, "%w")) - 1)) %>% - mutate(month = format(date, "%B")) %>% - mutate(woy = as.numeric(format(date, "%W"))) %>% - mutate(year = as.numeric(format(date, "%Y"))) %>% - mutate(month = toupper(factor(month, levels = months, ordered = TRUE))) %>% - # arrange(year, month) %>% - mutate(monlabel = month) - - if (!is.null(month)) { # multi-year data set - t1$monlabel <- paste(t1$month, t1$year) - } - - t2 <- t1 %>% - mutate(monlabel = factor(monlabel, ordered = TRUE)) %>% - mutate(monlabel = fct_inorder(monlabel)) %>% - mutate(monthweek = woy - min(woy), - y = max(monthweek) - monthweek + 1) %>% - mutate(weekend = ifelse(dow == 6 | dow == 5, 1, 0)) - + t2 <- t1 %>% + mutate(monlabel = factor(monlabel, ordered = TRUE)) %>% + mutate(monlabel = fct_inorder(monlabel)) %>% + mutate(monthweek = woy - min(woy), + y = max(monthweek) - monthweek + 1) %>% + mutate(weekend = ifelse(as.numeric(format(date, "%w")) %in% c(0, 6), 1, 0)) - if( all(special.days == 0) == TRUE || length(special.days) == 0) { - special.col <- "white" - } else { - - if(is.character(special.days)) { + if( all(special.days == 0) == TRUE || length(special.days) == 0) { + special.col <- "white" + } else { - if (length(special.days) == length(dates)) { - fills <- special.days - } else { - if (special.days == "weekend") { - fills <- t2$weekend - } - } + if(is.character(special.days)) { + if (length(special.days) == length(dates)) { + fills <- special.days } else { - - if(gradient == TRUE) { - fills <- special.days - } else { - fills[special.days] <- 1 + if (special.days == "weekend") { + fills <- t2$weekend } } - } - } else { - - weekdays <- c(weeknames[7], weeknames[1:6]) - - t1 <- tibble(date = dates, fill = fills) %>% - right_join(filler, by = "date") %>% # fill in missing dates with NA - mutate(dow = as.numeric(format(date, "%w"))) %>% - mutate(month = format(date, "%B")) %>% - mutate(woy = as.numeric(format(date, "%U"))) %>% - mutate(year = as.numeric(format(date, "%Y"))) %>% - mutate(month = toupper(factor(month, levels = months, ordered = TRUE))) %>% - # arrange(year, month) %>% - mutate(monlabel = month) - - if (!is.null(month)) { # Multi-year data set - t1$monlabel <- paste(t1$month, t1$year) - } - - t2 <- t1 %>% - mutate(monlabel = factor(monlabel, ordered = TRUE)) %>% - mutate(monlabel = fct_inorder(monlabel)) %>% - mutate(monthweek = woy - min(woy), - y = max(monthweek) - monthweek + 1) %>% - mutate(weekend = ifelse(dow == 0 | dow == 6, 1, 0)) - - - if(all(special.days == 0) == TRUE || length(special.days) == 0) { - special.col <- "white" } else { - if(is.character(special.days)) { - - if (length(special.days) == length(dates)) { - fills <- special.days - } else { - if (special.days == "weekend") { - fills <- t2$weekend - } - } + if(gradient == TRUE) { + fills <- special.days } else { - - if(gradient == TRUE) { - fills <- special.days - } else { - fills[special.days] <- 1 - } + fills[special.days] <- 1 } } } - df <- data.frame(week = weekdays, pos.x = 0:6, pos.y = rep(max(t2$monthweek) + 1.75, 7))