Date de Pâques

Version imprimable

Date de Pâques

Bonjour !

Voici un programme qui calcule la date du dimanche de Pâques dans le calendrier grégorien.

Code:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
{ Date de Pƒques }
 
PROGRAM DDP;
USES Crt;
 
TYPE
  TDate=RECORD
          Jour:Byte;
          Mois:Byte;
          Annee:Word;
          ToutesLettres:String;
        END;
 
VAR
  Annee:Word;
  Date:TDate;
 
PROCEDURE CalculDateDePaques(a:Word;var ddp:TDate);
 
  { Algorithme d'Oudin }
  var G,C,C4,E,H,K,P,Q,I,B,J1,J2,R:Word;
 
  begin
    ddp.Annee:=a;
 
    G:=a mod 19;
    C:=a div 100;
    C4:=C div 4;
    E:=(8*C+13) div 25;
    H:=(19*G+C-C4-E+15) mod 30;
    K:=H div 28;
    P:=29 div (H+1);
    Q:=(21-G) div 11;
    I:=(K*P*Q-1)*K+H;
    B:=(a div 4)+a;
    J1:=B+I+2+C4-C;
    J2:=J1 mod 7;
    R:=28+I-J2;
 
    if R<32
    then
      begin
        ddp.Jour:=R;
        ddp.Mois:=3;
      end
    else
      begin
        ddp.Jour:=R-31;
        ddp.Mois:=4;
      end;
 
  end;
 
PROCEDURE DateLitterale(var d:TDate);
  const
    sp:Char=Chr(32);
  var
    jstr,mstr,astr:String;
  begin
    Str(d.Jour,jstr);
		if jstr='1' then jstr:='1er';
    case d.Mois of
      3:mstr:='mars' ;
      4:mstr:='avril' ;
    end ;
    Str(d.Annee,astr);
    d.ToutesLettres:=jstr +sp+ mstr +sp+ astr;
  end;
 
BEGIN
  TextBackground(Blue);
  TextColor(Yellow);
  ClrScr;
  Window(4,3,80,25);
  WriteLn('Date de Pƒques dans le calendrier gr‚gorien.');
  WriteLn;
	WriteLn;
  TextColor(White);
  WriteLn('Veuillez entrer une ann‚e … partir de 1583 :');
  WriteLn;
  ReadLn(Annee);
  WriteLn;
  CalculDateDePaques(Annee,Date);
  DateLitterale(Date);
  WriteLn('Le Dimanche de Pƒques est le ',Date.ToutesLettres,'.');
  WriteLn;
  ReadKey;
END.

L'algorithme utilisé est décrit dans le document suivant :

Algorithme d'Oudin pour le calcul de la date de Pâques

P.-S. Suite à la suggestion d'Alcatîz, le programme a été ajouté dans la rubriques "Codes sources" :

Date de Pâques

21/03/2012, 21h05
Alcatîz

Merci :)

Voilà le genre de code source qui aurait sa place dans nos téléchargements :
http://pascal.developpez.com/telecha...Borland-Pascal

;)

1 pièce(s) jointe(s)

Table des dates de Pâques de 1900 à 2199

Bonjour !

Je reviens à ce projet pour y apporter quelques améliorations.

En premier lieu, j'ai pensé à ajouter une table qui permettrait de vérifier le résultat du calcul. Je suis parti de ce document et j'ai écrit un programme qui extrait les dates et produit un fichier source les contenant sous la forme d'un tableau de nombres (suivant la convention utilisée pour la variable R de l'algorithme Oudin : 31 = 31 mars, 32 = 1er avril, etc.).

En fonction de la directive de compilation, le code produit est du Basic, du C ou du Pascal.

Code:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
 
{ Extraire les dates de Pâques contenues dans le fichier "estr-tbl.txt".
  Convertir les dates en nombres entiers (15 avril = 15 + 31 = 46).
  Produire un fichier source en Basic, en C ou en Pascal. }
 
program MakeSource;
 
{$IFDEF VPASCAL}
{&PMTYPE PM}
{$ELSE}
{$APPTYPE GUI}
{$ENDIF}
 
{-DEFINE B} // Basic
{-DEFINE C} // C
{$DEFINE P} // Pascal
 
uses
  SysUtils;
 
const
  filename = 'estr-tbl.txt';
 
type
  tReader = object
    table: array[0..299] of integer;
    procedure FillTable;
    procedure MakeSourceFile;
  end;
 
procedure tReader.FillTable;
var
  t: text;
  s: string;
  i, j: integer;
  erreur: integer;
begin
  i := -1;
  Assign(t, filename);
  Reset(t);
  while not Eof(t) do
  begin
    ReadLn(t, s);
    for j := 1 to Length(s) do
      if (s[j] = 'M') or (s[j] = 'A') then
      begin
        Inc(i);
        if i < 300 then
        begin
          Val(Copy(s,j+3,2), table[i], erreur);
          if s[j] = 'A' then
            Inc(table[i], 31);
        end else
        begin
          Close(t);
          Exit;
        end;
      end;
  end;
end;
 
procedure tReader.MakeSourceFile;
const
  {$IFDEF B}name = 'tbl.bas';{$ENDIF}
  {$IFDEF C}name = 'tbl.c';{$ENDIF}
  {$IFDEF P}name = 'tbl.pas';{$ENDIF}
var
  f: text;
  i: integer;
begin
  Assign(f, name);
  Rewrite(f);
  WriteLn(f);
  {$IFDEF B}Write(f, 'dim as integer tbl(299)={_'#13#10);{$ENDIF}
  {$IFDEF C}Write(f, 'const int tbl[300]={'#13#10);{$ENDIF}
  {$IFDEF P}Write(f, 'const tbl:'#13#10'array[0..299]of integer=('#13#10);{$ENDIF}
  for i := 0 to 299 do
    if i mod 10 = 9 then
      if i < 299 then
        {$IFDEF B}Write(f, Concat(IntToStr(table[i]), ',_'#13#10)){$ENDIF}
        {$IFDEF C}Write(f, Concat(IntToStr(table[i]), ','#13#10)){$ENDIF}
        {$IFDEF P}Write(f, Concat(IntToStr(table[i]), ','#13#10)){$ENDIF}
      else
        {$IFDEF B}Write(f, Concat(IntToStr(table[i]), '}')){$ENDIF}
        {$IFDEF C}Write(f, Concat(IntToStr(table[i]), '};')){$ENDIF}
        {$IFDEF P}Write(f, Concat(IntToStr(table[i]), ');')){$ENDIF}
    else
      Write(f, Concat(IntToStr(table[i]),','));
  WriteLn(f);
  Close(f);
end;
 
var
  r: tReader;
 
begin
  r.FillTable;
  r.MakeSourceFile;
end.

Naturellement, vos observations ou vos conseils sont les bienvenus. :)

24/03/2015, 12h11
Roland Chastain

1 pièce(s) jointe(s)

Bonjour !

J'ai passé un coup de chiffon dans le programme ci-dessus. J'en ai profité pour ajouter un langage supplémentaire (Lua).