README.qmd

---
title: "Reality Bending Lab's Calendar"
format: gfm
---


```{r}
#| echo: false
#| message: false
#| warning: false

# Dependencies
library(lunar)
```

```{r astromical_events}
#| echo: false


daylength<-function(latitude,JDay,notimes.as.na=FALSE)
  # https://github.com/cran/chillR/
{
  if(missing(latitude)) stop("'latitude' not specified")
  if(missing(JDay)) stop("'JDay' not specified")
  if (!isTRUE(all(is.numeric(JDay)))) stop("'JDay' contains non-numeric values")
  if(length(latitude)>1) stop("'latitude' has more than one element")
  if (!is.numeric(latitude)) stop("'latitude' is not numeric")
  if(latitude>90|latitude<(-90)) warning("'latitude' is usually between -90 and 90")

  Gamma<-2*pi/365*((JDay)-1)
  Delta<-180/pi*(0.006918-0.399912*cos(Gamma)+0.070257*sin(Gamma)-0.006758*cos(2*Gamma)+
                   0.000907*sin(2*(Gamma))-0.002697*cos(3*(Gamma))+0.00148*sin(3*(Gamma)))
  CosWo<-(sin(-0.8333/360*2*pi)-sin(latitude/360*2*pi)*
            sin(Delta/360*2*pi))/(cos(latitude/360*2*pi)*cos(Delta/360*2*pi))
  
  normal_days<-which(CosWo>=-1&CosWo<=1)
  Sunrise<-rep(-99,length(CosWo))
  Sunrise[normal_days]<-12-acos(CosWo[normal_days])/(15/360*2*pi)
  Sunset<-rep(-99,length(CosWo))
  Sunset[normal_days]<-12+acos(CosWo[normal_days])/(15/360*2*pi)
  Daylength<-Sunset-Sunrise
  Daylength[which(CosWo>1)]<-0
  Daylength[which(CosWo<(-1))]<-24
  Sunrise[which(Daylength==24)]<-99
  Sunset[which(Daylength==24)]<-99
  
  if(notimes.as.na)
   {Sunrise[which(Sunrise %in% c(-99,99))]<-NA
    Sunset[which(Sunset %in% c(-99,99))]<-NA}
  Sunset[which(is.na(JDay))]<-NA
  Sunrise[which(is.na(JDay))]<-NA
  Daylength[which(is.na(JDay))]<-NA
 
 return(list(Sunrise=Sunrise,Sunset=Sunset,Daylength=Daylength))  
}




# This function computes the dates of astronomical events (equinoxes, solstices,
# and full moons) for a given year in a given latitude.
#
# Installation:
# It can loaded using `source("https://raw.githubusercontent.com/RealityBending/scripts/main/astronomical_dates.R")`
# It requires the 'chillR' and the 'lunar' packages to be installed.
#
# Author: Dominique Makowski
#
# Usage:
# > events <- astronomical_dates(year=2023, latitude = 50.8229)  # Latitude in Brighton, UK
# > events["Equinox_Spring"]
astronomical_dates <- function(year=2025, latitude = 50.8229){
  dates <- seq(ISOdate(year, 1, 1), ISOdate(year, 12, 31), by='day')
  # Julian days
  days <- strptime(paste(format(dates, "%m"), "/", format(dates, "%d"), "/", format(dates, "%Y"), sep = ""), "%m/%d/%Y")$yday + 1
  daylength <- daylength(latitude = latitude, days)$Daylength

  # Solstice ---------------------------------------------------------------
  solstice_winter <- as.Date(dates[which(daylength==min(daylength))])
  solstice_summer <- as.Date(dates[which(daylength==max(daylength))])

  # Equinox ---------------------------------------------------------------
  # Method 1: Where the daylength is closest to 12 hours
  equinox_spring <- as.Date(dates[which(abs(daylength[1:150] - 12) == min(abs(daylength[1:150] - 12)))])
  equinox_autumn <- as.Date(dates[which(abs(daylength[151:300] - 12) == min(abs(daylength[151:300] - 12)))+150])

  # Method 2: Where the rate of changes is minimum
  # equinox_spring <- as.Date(dates[which(diff(daylength)==max(diff(daylength)))+1])
  # equinox_autumn <- as.Date(dates[which(diff(daylength)==min(diff(daylength)))+1])

  # Method 3: Where there is an inversion in the rate of change
  # d <- diff(diff(daylength))
  # equinox_spring <- as.Date(dates[which(d > 0 & c(d[-1], 0) < 0)+2])
  # equinox_autumn <- as.Date(dates[which(d < 0 & c(d[-1], 0) > 0)+2])

  # Full moons
  phase <- lunar::lunar.illumination(dates)
  moon <- data.frame(dates = as.Date(dates),
                     phase = phase,
                     newmoon = FALSE,
                     fullmoon = FALSE)
  moon[which(diff(sign(diff(phase)))==-2)+1, "fullmoon"] <- TRUE
  moon[which(diff(sign(diff(phase)))==2)+2, "newmoon"] <- TRUE

  list("Solstice_Summer"=solstice_summer,
       "Solstice_Winter"=solstice_winter,
       "Equinox_Autumn"=equinox_autumn,
       "Equinox_Spring"=equinox_spring,
       "Moon_Full"=moon[moon$fullmoon==TRUE, "dates"],
       "Moon_New"=moon[moon$newmoon==TRUE, "dates"],
       "Dates"=dates)
}
```

```{r dates_celebrations}
#| echo: false

get_dates_celebrations <- function(year=2024){
  
  # Convenience function to find the midpoint between two dates
  midpoint <- function(date1, date2){
    days <- seq(date1, date2, by="days")
    days[round(length(days) / 2)]
  }
  
  # Get dates (latitude in Brightonn UK)
  astro_prev <- astronomical_dates(year=year-1, latitude = 50.8229)
  astro <- astronomical_dates(year=year, latitude = 50.8229)
  astro_next <- astronomical_dates(year=year+1, latitude = 50.8229)

  # Solar
  out <- c(
    "Preparationday"=midpoint(astro_prev$Solstice_Winter, astro$Equinox_Spring),  
    "Risefest"=astro$Equinox_Spring, 
    "Flowerday"=midpoint(astro$Equinox_Spring, astro$Solstice_Summer),
    "Sunfest"=astro$Solstice_Summer,
    "Harvestday"=midpoint(astro$Solstice_Summer, astro$Equinox_Autumn),
    "Fallfest"=astro$Equinox_Autumn,  
    "Rootday"=midpoint(astro$Equinox_Autumn, astro$Solstice_Winter),
    "Nightfest"=astro$Solstice_Winter  
    )
  
  # Lunar
  out <- c(
    out,
    "Winenight"=max(astro$Moon_Full[out["Preparationday"]-astro$Moon_Full > 0]), # Before Preparationday,
    "Innocentnight"=max(astro$Moon_Full[out["Risefest"]-astro$Moon_Full > 0]), # Before Risefest,
    "Deadsnight"=max(astro$Moon_Full[out["Rootday"]-astro$Moon_Full > 0]), # Before Nightfest
    "Loversnight"=astro$Moon_Full[which.min(abs(out["Flowerday"]-astro$Moon_Full))],  # Closest to Flowerday
    "Blacksun"=max(astro$Moon_Full[out["Nightfest"]-astro$Moon_Full > 0]) # Before Nightfest
    )
  
  # Other
  # blacksun_dates <- out["Nightfest"]-(7:14)
  # out <- c(out,
  #          "Blacksun" = blacksun_dates[weekdays(blacksun_dates) == "Friday"]
  # )
}
```

```{r find_closest}
#| echo: false


get_dates <- function(){
  today <- Sys.Date()
  year <- as.numeric(format(today, "%Y"))
  
  dates <- as.Date(c())
  for(y in c(year, year + 1)){
    dates <- c(dates, get_dates_celebrations(y))
    d <- today - dates
    dates <- dates[d <= 0]
  }
  
  d <- today - dates
  next_date <- which.max(d)
  celeb <- names(next_date)
  
  if (celeb %in% c("Fallfest", "Harvestday")){
    season <- "Summer"
    period <- "Bright Days"
    phase <- "Fall"
  } else if (celeb %in% c("Rootday", "Deadsnight", "Blacksun", "Nightfest")){
    season <- "Autumn"
    period <- "Dark Nights"
    phase <- "Fall"
  } else if (celeb %in% c("Winenight", "Risefest", "Preparationday")){
    season <- "Winter"
    period <- "Dark Nights"
    phase <- "Rise"
  } else if (celeb %in% c("Loversnight", "Lifesday", "Flowerday", "Sunfest")){
    season <- "Spring"
    period <- "Bright Days"
    phase <- "Rise"
  } else{
    season <- "FAILURE"
    period <- "FAILURE"
    phase <- "FAILURE"
  }
  
  # Celebrations
  list("N_Days" = abs(as.numeric(d[next_date])),
       "Next_Celebration" = celeb,
       "Season" = season,
       "Period" = period,
       "Phase" = phase)
}
```


```{r print}
#| echo: false
#| message: false
#| warning: false
#| results: 'asis'

info <- get_dates()

cat(paste0("We are in **",
           info$Season,
           "**. The **",
           info$Period,
           "** are upon us, and we are in the time of the **",
           info$Phase,
           "**. ",
           "The next celebration is [**", 
           info$Next_Celebration, 
           "**](https://github.com/RealityBending/Calendar#", 
           info$Next_Celebration, 
           ") in **", 
           info$N_Days, 
           "** days",
           ifelse(info$N_Days == 14, " (@DominiqueMakowski).", ".")))
```



## Celebrations


```{r calendar_plot}
#| echo: false
#| message: false
#| warning: false
#| dpi: 450
#| fig-width: 10.08
#| fig-height: 6

library(ggplot2)

year <- as.numeric(format(Sys.Date(), "%Y"))
days <- as.Date(seq(ISOdate(year, 1, 1), ISOdate(year, 12, 31), by='day'))
celebrations <- get_dates_celebrations(year)

# Create data
data <- data.frame(Day = days,
                   Celebration = NA,
                   Main = NA,
                   Type = ifelse(days %in% celebrations[c("Risefest", "Fallfest", "Nightfest", "Sunfest",
                                                           "Preparationday", "Flowerday", "Rootday", "Harvestday")], "Solar", "Lunar"))

for(i in 1:length(celebrations)) {
  if(is.na(data[data$Day == celebrations[i], "Celebration"])){
    data[data$Day == celebrations[i], "Celebration"] <- names(celebrations[i])
  } else{
    data[data$Day == celebrations[i], "Celebration"] <- paste(data[data$Day == celebrations[i], "Celebration"], "/", names(celebrations[i]))
  }
}

data$Bar <- ifelse(is.na(data$Celebration), 0, 1)
data$Width <- NA
data$Width[data$Celebration %in% c("Nightfest", "Risefest", "Sunfest", "Fallfest")] <- 2
data$Width[data$Celebration %in% c("Preparationday", "Flowerday", "Harvestday", "Rootday")] <- 1
data$Width[data$Celebration %in% c("Winenight", "Innocentnight", "Loversnight", 
                                   "Deadsnight", "Blacksun")] <- 1.5



# data$Bar[data$Type == "Solar" & data$Main == 0.5] <- 0
data$Bar[data$Type == "Lunar"] <- 0.9
data$Bar[data$Type == "Other"] <- 0.8

data_segments <- data[!is.na(data$Celebration) & data$Type == "Solar", ]
segments <- data.frame(
  Day = data_segments$Day[data_segments$Celebration %in% c("Risefest", "Sunfest", "Fallfest")],
  xend = data_segments$Day[data_segments$Celebration %in% c("Flowerday", "Harvestday", "Rootday")],
  y = 1)
# Add around beginning of year
segments <- rbind(segments, 
                  data.frame(Day=data_segments$Day[8], xend=max(data$Day), y=1),
                  data.frame(Day=min(data$Day),  xend=data_segments$Day[1], y=1))




ggplot(data, aes(x = Day, y=Bar)) +
  geom_bar(aes(fill=Type), width=data$Width, stat = "identity", position="identity") +
  geom_segment(data = segments, aes(xend = xend, y = y, yend = y), color = "#f44336", linewidth = 2) +
  geom_bar(data=data.frame(Day = Sys.Date(), Bar=0.8), fill="black", width=3, stat = "identity", position="identity") +
  geom_text(aes(label=Celebration), y=1.25, size = 3, angle = 0, fontface="italic") +
  coord_polar(start=0, clip = "off") +
  theme_void() +
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_text(face= "bold"),
        axis.ticks.y = element_blank(),
        axis.line.x = element_blank(),
        panel.border = element_blank(),
        panel.background = element_blank(),
        panel.grid.major.y = element_blank(), 
        panel.grid.major =  element_line(colour = "#FFB300")) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 1), breaks = NULL) +
  guides(fill="none") +
  scale_x_date(date_breaks = "1 month",
               date_labels = "%b",
               limits = range(c(days[1], days[-1]))) +
  scale_fill_manual(values=c("Lunar"="#2196F3", "Solar"= "#f44336", "Other"="purple"))
```

In the Reality Bending Lab, we follow an astronomical calendar. The year is divided in two main overlapping cycles, the **Rise/Fall** phases (December - June) and the **Dark nights/Bright days** periods (September - March). 

*Note: this calendar is automatically updated daily thanks to an automated R script that accounts for the exact dates of the solar and lunar astronomical events (solstices, equinoxes, full moons) of the current year.*


### Winenight

- **Fullmoon before Preparationday** `r format(celebrations["Winenight"], "*(%Y %B %d - %A)*")`

Wine drinking. (See [Anthesteria](https://en.wikipedia.org/wiki/Anthesteria)).

### Preparationday

- **Between Nightfest and Risefest** `r format(celebrations["Preparationday"], "*(%Y %B %d - %A)*")`

Ploughing and Sowing. Team building and planning of the work roadmap for the year. (See [Imbolc](https://en.wikipedia.org/wiki/Imbolc)).

### Festival of the Innocents

- **Fullmoon before Preparationday** `r format(celebrations["Innocentnight"], "*(%Y %B %d - %A)*")`

Masked party. Anonymity and roles. Wolves and sheep. Winter retreat. (See [Lupercalia](https://en.wikipedia.org/wiki/Lupercalia) and [Carnival of Venice](https://en.wikipedia.org/wiki/Carnival_of_Venice)).


### Risefest

- **Spring equinox** `r format(celebrations["Risefest"], "*(%Y %B %d - %A)*")`

Coming of **Bright days** and **Spring**. Drowning of the *Winter Woman* (See [Marzanna](https://wpna.fm/polish-traditions-the-drowning-of-marzanna/)). Eating eggs and water pranks.

### Loversnight

- **Fullmoon between Risefest and Sunfest** `r format(celebrations["Loversnight"], "*(%Y %B %d - %A night)*")`

Celebration of partners and loved ones. (see [Walpurgis' Night](https://en.wikipedia.org/wiki/Walpurgis_Night) and [Beltane](https://en.wikipedia.org/wiki/Beltane))

### Flowerday

- **Between Risefest and Sunfest** `r format(celebrations["Flowerday"], "*(%Y %B %d - %A)*")`

Celebration of life, youth and growth. Flowers in bloom and celebrations around the tree. (See [Floria](https://en.wikipedia.org/wiki/Floralia) and [May Day](https://en.wikipedia.org/wiki/May_Day)).

### Sunfest

- **Summer solstice** `r format(celebrations["Sunfest"], "*(%Y %B %d - %A)*")`

Crackers and fireworks at sunset. Popcorns made in fires in the night. (See [Kupala Night](https://en.wikipedia.org/wiki/Kupala_Night)).

### Harvestday

- **Between Sunfest and Fallfest** `r format(celebrations["Harvestday"], "*(%Y %B %d - %A)*")`

We harvest the fruits of our work and relax. Work superiors treat to dinner. Rewards and vacations. Start of summer break. (See [Lughnasadh](https://en.wikipedia.org/wiki/Lughnasadh)).  

### Fallfest

- **Autumn equinox** `r format(celebrations["Fallfest"], "*(%Y %B %d - %A)*")`

Coming of the **Dark Nights** and **Autumn**. Beginning of the school year.
Fires are lit (no electricity). [Wreaths](https://en.wikipedia.org/wiki/Do%C5%BCynki) symbolizing the successful readiness for the year to come. (See [Oktoberfest](https://en.wikipedia.org/wiki/Oktoberfest) and [Thanksgiving](https://en.wikipedia.org/wiki/Thanksgiving)).

### Deadsnight

- **Fullmoon before Rootday** `r format(celebrations["Deadsnight"], "*(%Y %B %d - %A)*")`

We go on a walk and collect materials to create along the way the *Winter Woman* doll, that will stay in the lab until Risefest. Followed by a *spooky hackathon* (See [Samhain](https://en.wikipedia.org/wiki/Samhain), [Halloween](https://en.wikipedia.org/wiki/Halloween)).

### Rootday

- **Between Fallfest and Nightfest** `r format(celebrations["Rootday"], "*(%Y %B %d - %A)*")`

Nature is withering, and we prepare for the cold. Celebrate our roots and ancestors. Cultural and historical activities.

### Blacksun

- **Fullmoon before Nightfest** `r format(celebrations["Blacksun"], "*(%Y %B %d - %A)*")`

When darkness is winning: Chaos and mischief. Elect a "Lord of Misrule". Inversed hierarchy (see [Saturnalia](https://en.wikipedia.org/wiki/Saturnalia)).

### Nightfest

- **Winter solstice** `r format(celebrations["Nightfest"], "*(%Y %B %d - %A)*")`

From that date until the 6th of January, people keep a tree inside of their houses. On the 21th, it is decorated with garlands, and people drink snake wine.


### Other (to be done)

- Move Loversnight to be consistently before/after FLowerday?