(Borland) Pascal-source til påskeberegningsprogrammet:

program dan_paaske_dokument_til_websitet;

(* Compiler-direktiver til optimering af kørselstiden: *)

(*$A+*) (* Align data to word boundary *)

(*$B-*) (* Short-circuit boolean evaluation *)

(*$G+*) (* Generate 80286 code *)

(*$Q-*) (* Overflow checking off *)

(*$R-*) (* Range checking off *)

(*$S-*) (* Stack overflow checking off *)

(* En stor tak skal gå til Claus Tøndering, Kgs. Lyngby,

www.tondering.dk/main/da og facebook.com/profile.php?id=1034906671,

bl.a. for hans fantastiske og uforlignelige Calendar FAQ, der altid

(ja, så længe jeg kan huske tilbage hér på nettet!) har været en stor

inspirationskilde, og fra hvilken algoritmerne til beregning af ugedag og

dato for påsken til dels er baseret: www.tondering.dk/claus/calendar.html *)

uses dos; (* I dette program kun til

function program_name *)

const cyklus_aar = 5700000; (* Påskedagene gentages efter 5,7 mio. år *)

forsk_datoer = 35; (* Antal mulige påskedatoer *)

type aarstal = record

forrige_ikke_skudaar,

forrige_skudaar,

naeste_ikke_skudaar,

naeste_skudaar : longint

end;

var aar_diff, (* ± i forhold til udgangspunkt *)

minus_plus_en,

c : integer;

paaske_tabel : array(. 1..forsk_datoer .) of aarstal;

antal : array(. 1..forsk_datoer .) of longint;

rank_fra,

rank_til : array(. 1..forsk_datoer .) of byte;

udfyldt : byte;

udgangspunkt,

aar_diff_abs,

p, y, m, d,

p_u, d_u, m_u,

pdnx, m_p : longint;

s : boolean;

ekstra_info : string;

(* Fra min standardunit indeholdende diverse konstanter, procedurer,

funktioner, mv.: *)

function dots(n : longint) : string;

(* Omformer tallet N til en streng, idet der indsættes punktummer

for hvert tredje ciffer (fra højre, naturligvis) *)

var temp : string;

i, l : byte;

begin

str(abs(n), temp);

l:= length(temp);

for i:= 1 to (l - 1) div 3 do insert('.', temp, l - 3 * i + 1);

if n < 0 then temp:= '-' + temp;

dots:= temp

end;

function nbr_to_str(n : longint) : string;

(* Funktion, der svarer til proceduren STR *)

var temp : string;

begin

str(n, temp);

nbr_to_str:= temp

end;

function program_name : string;

(* Returnerer programmets eget navn (uden drev, path og extension).

Navnet vil være i uppercase *)

var dir : dirstr;

name : namestr;

ext : extstr;

begin

fsplit(paramstr(0), dir, name, ext);

program_name:= name

end;

(* Fra min kalender-unit, modificeret til at kunne behandle meget store

årstal (LONGINT er 32 bit (svarende til fire bytes) lang med fortegn,

dvs. i tos komplement (se www.wikiwand.com/en/Two's_complement)

kan repræsentere værdierne -2^31 til 2^31 - 1; sidstnævnte er lig

godt og vel 2 mia. - helt præcis 2.147.483.647): *)

function skudaar(aar : longint) : boolean;

(* Returnerer TRUE, hvis året er skudår; ellers FALSE *)

(* Der ses bort fra, at år 4000 muligvis bliver ikke-skudår (for at

gøre kalenderen mere præcis i forhold til Jordens omløbstid om

Solen), ;-) *)

begin

skudaar:= ((aar mod 4) = 0) and

(((aar mod 100) > 0) or

((aar mod 400) = 0))

end;

function dage_i_md(md, aar : longint) : word;

(* Returnerer antallet af dage i den aktuelle måned *)

const dage_i_md_tab : array(. 1..12 .) of word

= (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

(* jan feb mar apr maj jun jul aug sep okt nov dec *)

begin

dage_i_md:= dage_i_md_tab(. md .) + ord((md = 2) and skudaar(aar))

end;

function dato(dagnr, aar : longint) : word;

(* Omsætter et dagnummer til en dato. Bruges sammen med

funktionen MAANED *)

var m : longint;

begin

m:= 1;

while dagnr > dage_i_md(m, aar) do begin

dagnr:= dagnr - dage_i_md(m, aar);

inc(m)

end;

dato:= dagnr

end;

function maaned(dagnr, aar : longint) : word;

(* Omsætter et dagnummer til en måned. Bruges sammen med

funktionen DATO *)

var m : word;

begin

m:= 1;

while dagnr > dage_i_md(m, aar) do begin

dagnr:= dagnr - dage_i_md(m, aar);

inc(m)

end;

maaned:= m

end;

function dagnummer(dato, md, aar : longint) : word;

(* Returnerer dagens nummer i det aktuelle år (1..366 i skudår,

1..365 i ikke-skudår) *)

var m, dnr : longint;

begin

dnr:= dato;

for m:= 1 to md - 1 do

dnr:= dnr + dage_i_md(m, aar);

dagnummer:= dnr

end;

function paaske(aar : longint) : word;

(* Returnerer dagnummer for påskedag i det aktuelle år (AAR) *)

var g, c, x, z, d, e, n : longint;

paaske_temp : word;

begin

g:= (aar mod 19) + 1;

c:= trunc(aar div 100) + 1;

x:= trunc(3 * c div 4) - 12;

z:= trunc((8 * c + 5) div 25) - 5;

d:= trunc(5 * aar div 4) - x - 10;

e:= (11 * g + 20 + z - x) mod 30;

if e < 0 then e:= e + 30;

if ((e = 25) and (g > 11)) or (e = 24) then inc(e);

n:= 44 - e;

if n < 21 then n:= n + 30;

n:= n + 7 - ((d + n) mod 7);

if n <= 31 then

paaske_temp:= dagnummer(n, 3, aar)

else

paaske_temp:= dagnummer(n - 31, 4, aar);

paaske:= paaske_temp

end;

function ugedag(dato, md, aar : longint) : longint;

(* Returnerer ugedag for den aktuelle dato : 1=mandag, 2=tirsdag,

3=onsdag, 4=torsdag, 5=fredag, 6=lørdag og 7=søndag *)

var faktor, temp : longint;

begin

(* For at få Borland Pascal til at regne i longints (hvilket er

nødvendigt pga. størrelsen af "faktor"), må følgende foretages: *)

temp:= 365;

temp:= temp * aar + dato + 31 * (md - 1);

if md <= 2 then

faktor:= temp

+ (aar - 1) div 4

- ((aar - 1) div 100 + 1) * 3 div 4

else

faktor:= temp

- trunc(0.4 * md + 2.3)

+ aar div 4

- (aar div 100 + 1) * 3 div 4;

ugedag:= ((faktor + 5) mod 7) + 1

end;

function antal_af_ugedag_i_maaned(maaned, aar, ugedagen : longint) : longint;

(* Returnerer antallet af den givne ugedag (1 for mandag, 2 for

tirsdag, etc.) i den givne måned, dvs. 4 eller 5 *)

begin

case dage_i_md(maaned, aar) of

28 : antal_af_ugedag_i_maaned:= 4;

29 : if ugedagen = ugedag(1, maaned, aar) then

antal_af_ugedag_i_maaned:= 5

else

antal_af_ugedag_i_maaned:= 4;

30 : if (ugedagen = ugedag(1, maaned, aar)) or

(ugedagen = ugedag(2, maaned, aar)) then

antal_af_ugedag_i_maaned:= 5

else

antal_af_ugedag_i_maaned:= 4;

31 : if (ugedagen = ugedag(1, maaned, aar)) or

(ugedagen = ugedag(2, maaned, aar)) or

(ugedagen = ugedag(3, maaned, aar)) then

antal_af_ugedag_i_maaned:= 5

else

antal_af_ugedag_i_maaned:= 4

end

end;

function dato_for_ugedag_i_maaned(maaned, aar, ugedagen : longint;

nr : integer) : longint;

(* Returnerer datoen for den første (nr=1), anden (nr=2), etc. af

den givne ugedag (1 for mandag, 2 for tirsdag, osv., til

7=søndag) i den givne måned i det givne år.

Det er også muligt at finde datoen for den sidste (nr=-1),

næst-/andensidste (nr=-2), osv.

Findes datoen ikke, returneres værdien 0 *)

var ant : longint;

begin

ant:= antal_af_ugedag_i_maaned(maaned, aar, ugedagen);

if nr < 0 then nr:= ant + nr + 1;

if (nr = 0) or (nr > ant) then

dato_for_ugedag_i_maaned:= 0

else

dato_for_ugedag_i_maaned:= (((ugedagen -

ugedag(1, maaned, aar) + 7) mod 7) + 1) +

7 * (nr - 1)

end;

(* "Ikke-udefrakommende" procedurer og en enkelt funktion: *)

procedure beregn_paaskecyklen;

var aar : longint;

ix1, ix2,

antal_med_samme_rank : byte;

stop : boolean;

begin

for ix1:= 1 to forsk_datoer do begin (* Påsken kan falde på disse *)

antal (. ix1 .):= 0; (* datoer med IX1 = PDN, *)

rank_fra (. ix1 .):= forsk_datoer (* påskedatonummeret *)

end;

for aar:= udgangspunkt to udgangspunkt + cyklus_aar - 1 do

inc(antal(. paaske(aar) - 31 - 28 - ord(skudaar(aar)) - 21 .));

(* jan. feb. evt. 29/2 21 dage af mar. *)

(* svarende til off. forårsjævndøgn *)

for ix1:= 1 to forsk_datoer do

for ix2:= 1 to forsk_datoer do

if (ix1 <> ix2) and (antal(. ix2 .) <= antal(. ix1 .)) then

dec(rank_fra(. ix1 .));

for ix1:= 1 to forsk_datoer do begin

antal_med_samme_rank:= 0;

for ix2:= 1 to forsk_datoer do

if antal(. ix1 .) = antal(. ix2 .) then inc(antal_med_samme_rank);

rank_til(. ix1 .):= rank_fra(. ix1 .) + antal_med_samme_rank - 1

end

end;

function pdn(d, m : longint) : word;

(* Returnerer påskedatonummeret (PDN) for datoen d/m *)

begin

if m = 3 then (* Marts: 22/3 har PDN 1 og 31/3 har PDN 10 *)

pdn:= d - 21

else (* April: 1/4 har PDN 11 og 25/4 har PDN = *)

pdn:= d + 10 (* FORSK_DATOER, 35, se ovenfor *)

end;

procedure initiering;

var i : byte;

begin

for i:= 1 to forsk_datoer do begin

paaske_tabel(. i .).forrige_ikke_skudaar:= 0;

paaske_tabel(. i .).forrige_skudaar := 0;

paaske_tabel(. i .).naeste_ikke_skudaar := 0;

paaske_tabel(. i .).naeste_skudaar := 0

end;

udfyldt:= 0;

aar_diff_abs:= 0

end;

procedure udskrivning;

var i : byte;

begin

(* Påsken (forstået som selve påskedag) kan falde på majestætens

fødselsdag - hvilket bl.a. sker i 2017 *)

if (m_u = 4) and (d_u = 16) then

ekstra_info:= ', hvor også H.M. Dronning Margrethe 2. fylder ' +

nbr_to_str(udgangspunkt - 1940)

else

(* Hvis påsken falder den sidste søndag i marts, angives, at der

samme dag gås fra normaltid (også kaldet "vintertid") til

sommertid; selvsagt kan påsken ikke falde sidste søndag i

*oktober*, hvor der gås den anden vej! *)

if (m_u = 3) and (d_u = dato_for_ugedag_i_maaned(m_u, udgangspunkt,

7, -1)) then

ekstra_info:= ', hvor også sommertid begynder'

else

ekstra_info:= '';

(* De to scenarier kan naturligvis ikke forekomme i samme år *)

(* I Calibri (Brødtekst), pitch 16: *)

writeln('Fordeling af påskedag:');

(* I Courier New, pitch 10,5: *)

writeln;

writeln('Denne tabel er dannet for ' + nbr_to_str(udgangspunkt) +

', hvor påsken falder på den ' + nbr_to_str(pdn(d_u, m_u)) +

'. mulige dag');

write ('af ' + nbr_to_str(forsk_datoer) + ', d. ' +

nbr_to_str(d_u), '. ');

if m_u = 3 then

write('marts')

else

write('april');

writeln(ekstra_info + '.');

writeln;

writeln('"Antal" angiver, hvor mange gange inden for en påskecyklus, ' +

'som er');

writeln(dots(cyklus_aar) + ' år, påskedatoen forekommer.');

writeln;

writeln;

writeln(' dato forrige næste ' +

'antal rank');

writeln(' ikke- ikke-');

writeln(' skudår skudår skudår skudår');

writeln;

(* Årstallet underlines og sættes i rød. Linjen, der relaterer til

påskedagen sættes helt i rød. Den *eventuelle* tekst vedr., at det

er majestætens fødselsdag, eller overgangen til sommertid, sættes i

kursiv.

De relevante årstal for nærmeste (forrige og næste) ikke-skudår og

skudår sættes i blå eller grøn, således, at dé to årstal, der er

nærmest det aktuelle år sættes med blå, og de to øvrige med grøn.

Til venstre for disse markeres påskedatonummeret og -datoen i

den relevante farve, i alle fire tilfælde.

De to gange "ikke-" ifm. overskrifterne "ikke-" og "skudår" sættes i

kursiv *)

for i:= 1 to forsk_datoer do begin

write(i : 3, ' ');

if i <= 10 then

write(i + 21, '.3')

else

write(i - 10 : 2, '.4');

write(paaske_tabel(. i .).forrige_ikke_skudaar : 10);

if paaske_tabel(. i .).forrige_skudaar = 0 then

write('----' : 10)

else

write(paaske_tabel(. i .).forrige_skudaar : 10);

write(paaske_tabel(. i .).naeste_ikke_skudaar : 10,

paaske_tabel(. i .).naeste_skudaar : 10,

dots(antal (. i .)) : 10,

rank_fra (. i .) : 9);

if rank_fra(. i .) = rank_til(. i .) then

writeln

else

writeln(' - ', rank_til(. i .) : 2)

end;

writeln;

writeln('Ranks er fra hyppigst (1) til sjældnest forekommende ' +

'(' + nbr_to_str(forsk_datoer) + ')');

writeln;

writeln('Er årstallet for forrige skudår udfyldt med "----", er det');

writeln('fordi, der ikke findes et sådant fra år 1700, da Danmark');

writeln('gik over til den gregorianske kalender');

writeln;

writeln;

(* I Calibri (Brødtekst), pitch 14: *)

writeln('Tilbage til websitet / Tilbage til profilen på Den Store Danske');

(* På "websitet" sættes hyperlink til http://urdata.dk og

på "Den Store Danske" sættes hyperlink til

*)

end;

begin (* Hovedprogram *)

if paramcount <> 1 then begin

writeln('Syntax: ', program_name, ' <årstal>');

writeln;

writeln('Programmet danner en tabel over påsken med udgangspunkt i ' +

'det angivne år');

halt

end;

val(paramstr(1), udgangspunkt, c);

if (c <> 0) or (udgangspunkt < 1700) or (udgangspunkt > 9999) then begin

writeln('Fejl i parameteren <årstal>');

writeln;

writeln('Der skal være tale om en numerisk værdi i ' +

'intervallet 1700-9999');

halt

end;

beregn_paaskecyklen;

initiering;

p_u:= paaske(udgangspunkt);

d_u:= dato (p_u, udgangspunkt);

m_u:= maaned(p_u, udgangspunkt);

m_p:= 1;

repeat

inc(aar_diff_abs);

for minus_plus_en:= m_p to 2 do begin

y:= udgangspunkt + (2 * minus_plus_en - 3) * aar_diff_abs;

p:= paaske(y);

m:= maaned(p, y);

d:= dato (p, y);

s:= skudaar(y);

pdnx:= pdn(d, m);

case minus_plus_en of

1 : begin

if not(s) and

(paaske_tabel(. pdnx .).forrige_ikke_skudaar = 0) then begin

paaske_tabel(. pdn(d, m) .).forrige_ikke_skudaar:= y;

inc(udfyldt)

end;

if s and (paaske_tabel(. pdnx .).forrige_skudaar = 0) then begin

paaske_tabel(. pdn(d, m) .).forrige_skudaar:= y;

inc(udfyldt)

end

end;

2 : begin

if not(s) and

(paaske_tabel(. pdnx .).naeste_ikke_skudaar = 0) then begin

paaske_tabel(. pdn(d, m) .).naeste_ikke_skudaar:= y;

inc(udfyldt)

end;

if s and (paaske_tabel(. pdnx .).naeste_skudaar = 0) then begin

paaske_tabel(. pdn(d, m) .).naeste_skudaar:= y;

inc(udfyldt)

end

end

end;

if y = 1700 then begin

m_p:= 2;

for pdnx:= 1 to forsk_datoer do begin

if paaske_tabel(. pdnx .).forrige_skudaar = 0 then

inc(udfyldt)

end

end

end

until udfyldt = 4 * forsk_datoer;

udskrivning

end.

Tilbage til websitet / til profilen på Den Store Danske /
til outputtet (den genererede tabel)