aboutsummaryrefslogtreecommitdiff
path: root/lib/kernel/computus.ml
blob: 1f60fb7052893365004cc144c880a64272794fb2 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
let mk y m d =
  match Date.make ~year:y ~month:m ~day:d with
  | Ok t -> t
  | Error e -> failwith ("computus: " ^ e)

(* Anonymous Gregorian algorithm (Meeus / Jones / Butcher). *)
let gregorian_easter y =
  let a = y mod 19 in
  let b = y / 100 and c = y mod 100 in
  let d = b / 4 and e = b mod 4 in
  let f = (b + 8) / 25 in
  let g = (b - f + 1) / 3 in
  let h = ((19 * a) + b - d - g + 15) mod 30 in
  let i = c / 4 and k = c mod 4 in
  let l = (32 + (2 * e) + (2 * i) - h - k) mod 7 in
  let m = (a + (11 * h) + (22 * l)) / 451 in
  let month = (h + l - (7 * m) + 114) / 31 in
  let day = ((h + l - (7 * m) + 114) mod 31) + 1 in
  mk y month day

(* Meeus Julian Easter: gives the JULIAN-calendar month/day; convert to the same
   physical day expressed in the proleptic Gregorian calendar by adding the
   Julian->Gregorian offset (days = y/100 - y/400 - 2). *)
let julian_easter y =
  let a = y mod 4 and b = y mod 7 and c = y mod 19 in
  let d = ((19 * c) + 15) mod 30 in
  let e = ((2 * a) + (4 * b) - d + 34) mod 7 in
  let month = (d + e + 114) / 31 in
  let day = ((d + e + 114) mod 31) + 1 in
  let offset = (y / 100) - (y / 400) - 2 in
  Date.of_rata (Date.to_rata (mk y month day) + offset)