An alternative calendar

woodiac.R

# imports lubridate, emo, glue, purrr

as_woodiac <- function(x) {
  
  is_dst <- lubridate::dst(as.POSIXct(x)) # pick up OS timzone

  x <- lubridate::as_date(x)
  date_2000 <- x
  lubridate::year(date_2000) <- 2000
  
  year <- lubridate::year(x)
  
  as_binary <- function(x) {
    bits <- as.integer(intToBits(x))
    str <- glue::glue_collapse(rev(bits))
    str <- sub("^0*", "", str)
    str
  }
  
  year_str <- purrr::map_chr(year, as_binary)
  
  cutoffs <- lubridate::as_date(
    c("2000-01-01", "2000-01-21", "2000-02-20", "2000-03-21", "2000-04-21", 
      "2000-05-22", "2000-06-22", "2000-07-23", "2000-08-23",
      "2000-09-24", "2000-10-24", "2000-11-23", "2000-12-22", "2001-01-01")
  )
  
  signs <- c("Capricorn", "Aquarius", "Pisces", "Aries",
             "Taurus", "Gemini", "Cancer", "Leo",
             "Virgo", "Libra", "Scorpio", "Sagittarius", "Capricorn")
  
  sign_fct <- cut(date_2000, breaks = cutoffs)
  sign_str <- signs[as.integer(sign_fct)]
  
  date <- as.numeric(date_2000) - as.numeric(lubridate::as_date(sign_fct)) + 1

  # correct for start of year
  date <- 
    ifelse(
      sign_str == "Capricorn" & month(x) == 1,
      date + 10,
      date
    )
  
  # correct for not leap year
  date <- 
    ifelse(
      sign_str == "Pisces" & month(x) == 3 & !lubridate::leap_year(x),
      date - 1,
      date
    )
  
  emoji <- 
    ifelse(
      is_dst, 
      emo::ji("scream_cat"),
      emo::ji("face screaming in fear")
    )
  
  # obvs, purrr needed to handle the scream_cat  
  date_str <- purrr::map2_chr(emoji, date, ~glue::glue_collapse(rep(.x, .y)))
  
  # glue
  woodiac <- glue::glue("{year_str}-{sign_str}-{date_str}")
  
  woodiac
}