feat: add moon phases

DESCRIPTION

@@ -21,7 +21,10 @@ RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 Imports: 
     graphics,
-    grDevices
+    grDevices,
+    httr,
+    rvest,
+    tools
 Suggests: 
     knitr,
     rmarkdown

NAMESPACE

@@ -3,6 +3,7 @@
 export(filter_events)
 export(get_calendar)
 export(get_month_name)
+export(get_moon_phases)
 export(get_weekday_name)
 export(number_of_days)
 export(plot_calendar)

R/get_moon_phases.R

@@ -0,0 +1,82 @@
+#' Get moon phases for a given year
+#'
+#' @description
+#' Scraps the site <https://www.timeanddate.com> to retrive moon phases data.
+#'
+#' @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.
+#'   
+#' @return A `data.frame` with the following columns:
+#' - `new_moon`: the date of new moons (`YYYY-MM-DD`),
+#' - `full_moon`: the date of full moons (`integer`).
+#' 
+#' @export
+#'
+#' @examples
+#' ## Get moon phases for 2024 ----
+#' get_moon_phases(2024)
+
+get_moon_phases <- function(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)
+  }
+
+
+  ## Change user agent ----
+
+  ua <- paste0("Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:124.0) ",
+               "Gecko/20100101 Firefox/124.0")
+
+
+  ## Switch to US locale ----
+
+  lc_time    <- Sys.getlocale("LC_TIME")
+  on.exit(Sys.setlocale("LC_TIME", lc_time), add = TRUE)
+  Sys.setlocale("LC_TIME", "en_US.UTF-8")
+
+
+  ## Get data ----
+
+  url <- paste0("https://www.timeanddate.com/moon/phases/?year=", year)
+
+  page <- httr::GET(url, 
+                    httr::add_headers(`Accept-Language` = "en"),
+                    httr::user_agent(ua))
+
+  if (httr::status_code(page) != 200) {
+    stop("Unable to retrieve moon phases. Please wait a few minutes or check ", 
+         "you connexion.", call. = FALSE)
+  }
+
+  content <- httr::content(page)
+
+
+  ## Clean data ----
+
+  content <- rvest::html_nodes(content, "table")
+  content <- rvest::html_table(content, fill = TRUE)
+  content <- content[[2]][-1, c("New Moon", "Full Moon")]
+  content <- as.data.frame(content)
+  content <- content[grep("^[0-9]", content[ , 1]), ]
+  content <- content[grep("^[0-9]", content[ , 2]), ]
+  colnames(content) <- c("new_moon", "full_moon")
+
+  content$"new_moon"  <- paste(content$"new_moon",  year)
+  content$"full_moon" <- paste(content$"full_moon", year)
+
+  content$"new_moon"  <- as.character(as.Date(content$"new_moon", 
+                                              format = "%d %b %Y"))
+  content$"full_moon" <- as.character(as.Date(content$"full_moon", 
+                                              format = "%d %b %Y"))
+
+  content
+}

R/plot_calendar.R

@@ -35,6 +35,8 @@
 #'   (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.
+#' 
+#' @param moon a `logical`. If `TRUE` (default) adds new/full moon glyph.
 #'   
 #' @return No return value. The calendar will exported as a `pdf` file in 
 #' `path`.
@@ -50,7 +52,7 @@ 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",
-                          lang = NULL) {
+                          lang = NULL, moon = TRUE) {
 
   ## Check year ----
 
@@ -223,6 +225,13 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
   }
 
 
+  ## Get moon phases dates ----
+
+  if (moon) {
+    moon_dates <- get_moon_phases(year)
+  }
+
+
   ## Define x-axis range ----
 
   x_lim <- c(0, length(unique(calendar$"en_weekday")))  
@@ -352,6 +361,32 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
          labels = calendar[i, "day"],
          pos    = 4,
          cex    = 0.35)
+
+
+    ## Add moon phases ----
+
+    if (moon) {
+
+      if (calendar[i, "date"] %in% moon_dates$"new_moon") {
+
+        points(x   = calendar[i, "x"] - 0.10,
+               y   = calendar[i, "y"] - 0.10,
+               pch = 21,
+               col = "#333333",
+               bg  = "#333333",
+               cex = 1)   
+      }
+
+      if (calendar[i, "date"] %in% moon_dates$"full_moon") {
+
+        points(x   = calendar[i, "x"] - 0.10,
+               y   = calendar[i, "y"] - 0.10,
+               pch = 21,
+               col = "#333333",
+               bg  = "#ffffff",
+               cex = 1)   
+      }
+    }
   }