Ability to choose any weekday as week start

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))