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