sourcekode til påskeberegningsprogrammet

(Borland) Pascal-source til påskeberegningsprogrammet:

program udfyld_paaske_tabel;

(* 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 *)

const udgangspunkt = 2014; (* Betydning for forrige/næste år i tabel *)

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

forsk_datoer = 35; (* Antal datoer, påsken kan falde på *)

type aarstal = record

forrige,

naeste : longint

end;

var aar_diff : integer; (* +/- i forhold til "udgangspunkt" *)

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;

aar_diff_abs,

p, y, m, d,

p_u, d_u, m_u : word;

minus_plus_en : integer;

(* Fra min standardunit indeholdende diverse kontanter, 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;

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

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

dvs. 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;

(* Lokale 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, se ovenfor *)

end;

procedure initiering;

var i : byte;

begin

for i:= 1 to forsk_datoer do begin

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

paaske_tabel(. i .).naeste := 0

end;

udfyldt:= 0;

aar_diff_abs:= 0

end;

procedure udskrivning;

var i : byte;

begin

(* 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('.');

writeln;

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

'som er');

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

writeln;

writeln(' dato forrige næste antal rank');

writeln;

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 : 10,

paaske_tabel(. i .).naeste : 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;

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

writeln('Tilbage til websitet / ' +

'Tilbage til profilen på denstoredanske.dk');

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

(* På "profilen på denstoredanske.dk" tilsvarende til

http://www.denstoredanske.dk/User:Uffe_Rasmussen *)

end;

begin (* Hovedprogram *)

beregn_paaskecyklen;

initiering;

p_u:= paaske(udgangspunkt);

d_u:= dato (p_u, udgangspunkt);

m_u:= maaned(p_u, udgangspunkt);

repeat

inc(aar_diff_abs);

for minus_plus_en:= 1 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);

case minus_plus_en of

1 : if paaske_tabel(. pdn(d, m) .).forrige = 0 then begin

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

inc(udfyldt)

end;

2 : if paaske_tabel(. pdn(d, m) .).naeste = 0 then begin

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

inc(udfyldt)

end;

end

until udfyldt = 2 * forsk_datoer;

udskrivning

end.