diff options
| -rw-r--r-- | lib/rites/rite_of/precedence_of.ml | 90 | ||||
| -rw-r--r-- | lib/rites/rite_of/precedence_of.mli | 25 | ||||
| -rw-r--r-- | test/test_precedence_of.ml | 78 |
3 files changed, 192 insertions, 1 deletions
diff --git a/lib/rites/rite_of/precedence_of.ml b/lib/rites/rite_of/precedence_of.ml index 5d32ee2..2fab64d 100644 --- a/lib/rites/rite_of/precedence_of.ml +++ b/lib/rites/rite_of/precedence_of.ml @@ -254,3 +254,93 @@ let vigil_feast (_ : Vocab_of.rank Precedence.candidate) : Slug.t option = None together. *) let rules : (Vocab_of.season, Vocab_of.rank) Precedence.rules = { band; disposition; admit; vigil_feast } + +(* Normae n. 60 and Normae n. 5 together. THREE rules, in this priority order + -- n. 60's own text defers to n. 5 explicitly ("servatis iis quae n. 5 + statuuntur"), so the two are one rule set, not two competing ones. + + 1. THE ANNUNCIATION IN HOLY WEEK (Normae n. 60): "Sollemnitas vero + Annuntiationis Domini, quotiescumque occurrit aliquo die Hebdomadae + sanctae, semper ad feriam II post dominicam II Paschae erit + transferenda." A fixed destination, Easter + 8, not a search. The EF has + the identical rule for the identical feast (RG 96's own exception, "the + Monday after Low Sunday" -- Low Sunday IS the Second Sunday of Easter), + which is why Rite.t.transfer_target is a rite-supplied function at all; + see its own doc comment. + + 2. A SOLEMNITY ON A PRIVILEGED SUNDAY (Normae n. 5): "Sollemnitates autem in + his dominicis occurrentes ad feriam secundam sequentem transferuntur" -- + the FOLLOWING MONDAY, not a searched free day. "his dominicis" are n. 5's + own subject: the Sundays of Advent, Lent and Easter. The clause carries + its own exception -- "nisi agatur de occurrentia in Dominica in Palmis + aut in Dominica Resurrectionis Domini" -- and those two cases fall + through to rule 3, whose forward search handles them correctly (the + Monday after Palm Sunday is Tabula entry 2 and is therefore not free). + + 3. THE GENERAL RULE (Normae n. 60): "ad proximiorem diem transferatur qui + sit liber a diebus sub nn. 1-8 in tabula praecedentiae recensitis" -- + the nearest later day free of Tabula entries 1-8, i.e. the first date + whose occupant bands ABOVE 80 (entry 8 x 10). + + TERMINATION, which Rite.t.transfer_target requires the rite to guarantee: + the search is bounded at [max_search_days] steps and raises if exhausted. + That bound is STRUCTURAL -- it does not appeal to the real calendar's own + shape -- because Calendar's round guard bounds ROUNDS, not the internal + search of a single call, and an unbounded walk would hang the caller + outright before that guard was ever consulted. *) + +let max_search_days = 400 + +let annunciation_slug = "of-annunciation" + +(* Tabula entries 1-8, scaled: a day is FREE to receive a transfer when its + occupant bands strictly above entry 8. *) +let entry_8_band = 80 + +let transfer_target (c : Vocab_of.rank Precedence.candidate) (origin : Date.t) + (occupant : Date.t -> Vocab_of.rank Celebration.t) : Date.t = + let year = Date.year origin in + let easter = Computus.gregorian_easter year in + let offset d = Date.to_rata d - Date.to_rata easter in + let is_holy_week d = offset d >= -7 && offset d <= -1 in + (* Rule 1. *) + if Slug.to_string c.cel.slug = annunciation_slug && is_holy_week origin then + Date.add_days easter 8 + else + let season_of d = (Temporal_of.temporal d).Temporal.season in + let privileged_sunday d = + Date.weekday d = Date.Sun + && match season_of d with + | Vocab_of.Advent | Vocab_of.Lent | Vocab_of.Easter -> true + | Vocab_of.Christmas | Vocab_of.Ordinary_time -> false + in + let is_palm_sunday d = offset d = -7 in + let is_easter_sunday d = offset d = 0 in + (* Rule 2. *) + if + c.cel.rank = Vocab_of.Sollemnitas + && privileged_sunday origin + && (not (is_palm_sunday origin)) + && not (is_easter_sunday origin) + then Date.add_days origin 1 + else + (* Rule 3. *) + let free d = + let cel = occupant d in + let cand = { Precedence.cel; origin = Precedence.Temporal } in + let ctx = + { Precedence.date = d; season = season_of d; weekday = Date.weekday d } + in + band ctx cand > entry_8_band + in + let rec search d steps = + if steps > max_search_days then + failwith + (Printf.sprintf + "Precedence_of.transfer_target: no day free of Tabula entries \ + 1-8 within %d days of %s" + max_search_days (Date.to_iso8601 origin)) + else if free d then d + else search (Date.add_days d 1) (steps + 1) + in + search (Date.add_days origin 1) 1 diff --git a/lib/rites/rite_of/precedence_of.mli b/lib/rites/rite_of/precedence_of.mli index e81d35e..4822411 100644 --- a/lib/rites/rite_of/precedence_of.mli +++ b/lib/rites/rite_of/precedence_of.mli @@ -85,3 +85,28 @@ val vigil_feast : Vocab_of.rank Precedence.candidate -> Slug.t option (** The four functions assembled for {!Colitur_kernel.Precedence.resolve}. *) val rules : (Vocab_of.season, Vocab_of.rank) Precedence.rules + +(** [transfer_target c origin occupant]: where an impeded solemnity goes. + Normae n. 60 and Normae n. 5 together -- n. 60 defers to n. 5 explicitly + ("servatis iis quae n. 5 statuuntur"), so they are one rule set: + + - the Annunciation falling anywhere in Holy Week goes to Easter + 8, the + Monday after the Second Sunday of Easter (n. 60, a fixed destination); + - any other solemnity falling on a Sunday of Advent, Lent or Easter goes to + the following Monday (n. 5), except on Palm Sunday or Easter Sunday, + which n. 5 excludes and which fall through to the general rule; + - otherwise, the nearest later day free of Tabula entries 1-8 (n. 60). + + Shaped to match {!Colitur_kernel.Rite.t.transfer_target} exactly so a later + phase wires it with no adaptation, and honours both obligations that field + states: the result is strictly later than [origin], and the search carries + its own step bound rather than relying on {!Colitur_kernel.Calendar}'s + round guard, which bounds rounds rather than one call's internal search. + + @raise Failure if no free day is found within 400 days -- a structural + bound, not an appeal to the calendar's own shape. *) +val transfer_target : + Vocab_of.rank Precedence.candidate -> + Date.t -> + (Date.t -> Vocab_of.rank Celebration.t) -> + Date.t diff --git a/test/test_precedence_of.ml b/test/test_precedence_of.ml index 6c50fa9..db217e8 100644 --- a/test/test_precedence_of.ml +++ b/test/test_precedence_of.ml @@ -337,6 +337,72 @@ let test_vigil_feast_is_always_none () = (Rite_of.Precedence_of.vigil_feast c = None)) [ "of-nativity-vigil"; "of-nativity"; "of-pentecost"; "of-peter-and-paul" ] +(* An [occupant] callback of the shape Rite.t.transfer_target expects, backed + by the real temporal cycle -- so the search meets genuine Tabula entries + rather than a hand-made fiction. *) +let occupant d = (Rite_of.Temporal_of.temporal d).Temporal.office + +let annunciation = + mk ~subject:Subject.Lord ~slug:"of-annunciation" ~rank:Vocab_of.Sollemnitas + ~origin:Precedence.Sanctoral () + +let iso s = Date.of_iso8601 s |> Result.get_ok + +let test_annunciation_in_holy_week () = + (* 2027: Easter is 28 March, so 25 March is Holy Thursday -- inside Holy + Week. Normae n. 60 sends it to the Monday after the Second Sunday of + Easter, Easter + 8 = 5 April 2027. *) + let target = + Rite_of.Precedence_of.transfer_target annunciation (iso "2027-03-25") occupant in + Alcotest.(check string) "Annunciation 2027 goes to Easter+8" + "2027-04-05" (Date.to_iso8601 target) + +let test_annunciation_in_easter_octave () = + (* 2035: Easter is 25 March, so the Annunciation collides with Easter Sunday + itself -- NOT Holy Week, so n. 60's Annunciation clause does not fire and + the general search runs. Every Octave day is Tabula entry 2, so the first + day free of entries 1-8 is the Monday after the Second Sunday of Easter: + the same 2 April the explicit rule would have named. Asserted rather than + assumed. *) + let target = + Rite_of.Precedence_of.transfer_target annunciation (iso "2035-03-25") occupant in + Alcotest.(check string) "Annunciation 2035 also lands on Easter+8" + "2035-04-02" (Date.to_iso8601 target) + +let test_solemnity_on_a_lenten_sunday () = + (* Normae n. 5: a solemnity occurring on a Sunday of Advent, Lent or Easter + goes to the FOLLOWING MONDAY, not to a searched free day. 19 March 2028 + (St Joseph) is the Third Sunday of Lent. *) + let joseph = + mk ~slug:"of-joseph" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral () in + let target = + Rite_of.Precedence_of.transfer_target joseph (iso "2028-03-19") occupant in + Alcotest.(check string) "St Joseph 2028 goes to the following Monday" + "2028-03-20" (Date.to_iso8601 target) + +let test_target_is_strictly_later () = + (* Rite.t.transfer_target's own stated obligation: Calendar treats + target <= origin as a legitimate placement, so a rule that can stand + still would loop candidates in place rather than fail loudly. *) + List.iter + (fun s -> + let d = iso s in + let t = Rite_of.Precedence_of.transfer_target annunciation d occupant in + Alcotest.(check bool) + (Printf.sprintf "%s -> strictly later" s) + true (Date.compare t d > 0)) + [ "2027-03-25"; "2035-03-25"; "2026-03-25"; "2029-03-25"; "2032-03-25" ] + +let test_target_is_free_of_entries_1_to_8 () = + List.iter + (fun s -> + let t = Rite_of.Precedence_of.transfer_target annunciation (iso s) occupant in + let b = band_of_date t in + Alcotest.(check bool) + (Printf.sprintf "%s -> a day free of Tabula entries 1-8 (band %d)" s b) + true (b > 80)) + [ "2027-03-25"; "2035-03-25"; "2026-03-25"; "2029-03-25" ] + let suite = ( "precedence-of", [ Alcotest.test_case "Tabula part I (entries 1-4)" `Quick test_part1; @@ -346,5 +412,15 @@ let suite = Alcotest.test_case "disposition (Normae n. 60)" `Quick test_disposition; Alcotest.test_case "disposition never commemorates" `Quick test_disposition_never_commemorates; Alcotest.test_case "admit is always empty" `Quick test_admit_is_always_empty; - Alcotest.test_case "vigil_feast is always none" `Quick test_vigil_feast_is_always_none ] + Alcotest.test_case "vigil_feast is always none" `Quick test_vigil_feast_is_always_none; + Alcotest.test_case "Annunciation in Holy Week -> Easter+8" `Quick + test_annunciation_in_holy_week; + Alcotest.test_case "Annunciation in the Easter Octave -> Easter+8 too" `Quick + test_annunciation_in_easter_octave; + Alcotest.test_case "solemnity on a Lenten Sunday -> following Monday" `Quick + test_solemnity_on_a_lenten_sunday; + Alcotest.test_case "transfer_target is always strictly later" `Quick + test_target_is_strictly_later; + Alcotest.test_case "transfer_target lands free of Tabula entries 1-8" `Quick + test_target_is_free_of_entries_1_to_8 ] @ List.map QCheck_alcotest.to_alcotest [ prop_band_total ] ) |