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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
|
with Ada.Command_Line,Ada.Text_IO,Ada.Unchecked_Deallocation;
use Ada.Command_Line,Ada.Text_IO;
procedure partition is
type Cellule;
type Liste is access Cellule;
type BCellule;
type Bliste is access BCellule;
type BCellule is record
Val:Liste;
Suiv:BListe;
end record;
type Cellule is record
Val:Natural;
Suiv:Liste;
end record;
type Tab;
type Ptab is access Tab;
type Part is record
Val:Natural;
Rest:Natural;
Suiv:PTab;
end record;
type Tab is array(Natural range<>) of Part;
B:BListe;
N:Natural:=0;
procedure Free is new Ada.Unchecked_Deallocation(Cellule,Liste);
procedure Libere(L:in out Liste) is
Prec:Liste;
begin
while L/=null loop
Prec:=L;
L:=L.suiv;
Free(Prec);
end loop;
end;
function min(A:in Natural;B:in Natural) return Natural is
begin
if B=0 then return A; end if;
if A<B then return A;
else return B;
end if;
end;
procedure Traite(P:in out Part) is
Limite:Natural:=min(P.Rest,P.Val);
Entree:Part;
begin
P.Suiv:=new Tab(1..Limite);
for I in 1..Limite loop
Entree:=(Val=>I,Rest=>(P.Rest-I),Suiv=>null);
P.Suiv(I):=Entree;
end loop;
end;
procedure Partit(Rac: Part) is
begin
if Rac.Rest=0 then N:=N+1; return;
else
for I in Rac.Suiv'Range loop
Traite(Rac.Suiv(I));
Partit(Rac.Suiv(I));
end loop;
end if;
end;
procedure Construit(Rac:in Part;L:Liste) is
procedure AjoutB(A: in Liste) is
begin
B:=new BCellule'(Val=>A,Suiv=>B); return;
end;
function Copie(P: in Liste) return Liste is
PCourant:Liste:=P;
Debut:Liste:=new Cellule;
begin
Debut:=null;
while PCourant/=null loop
if PCourant.Val/=0 then
Debut:=new Cellule'(Val=>PCourant.Val,Suiv=>Debut);
end if;
PCourant:=PCourant.Suiv;
end loop;
return Debut;
end;
Eff:Liste:=L;
begin
if Rac.Rest=0 then AjoutB(new Cellule'(Val=>Rac.Val,Suiv=>L)); return;
else
for I in Rac.Suiv'Range
loop
Construit(Rac.Suiv(I),Copie(new Cellule'(Val=>Rac.Val,Suiv=>L)));
end loop;
Libere(Eff);
end if;
end;
procedure AfficheB is
Courant:BListe:=B;
I:Natural:=1;
procedure Affiche (L:in Liste) is
Courant:Liste:=L;
begin
if (Courant=null) then Put_Line("La liste est vide"); return; end if;
loop
Put(Natural'Image(Courant.Val));
Courant:=Courant.Suiv;
exit when (Courant=null);
end loop;
New_Line;
end;
begin
while Courant/=null loop
New_Line;
Put(Natural'Image(I)&": ");
I:=I+1;
Affiche(Courant.Val);
Courant:=Courant.Suiv;
end loop;
end;
Debut:Part;
L:Liste:=null;
begin
Put_Line(Command_Name&" renvoie l'ensemble des partitions de "&Argument(1)) ;
New_Line;
Put_Line("Pour donner une idee on a les resultats suivants:");
Put_Line("p(50) = 204226");
Put_Line("le maximum atteint par l'algo utilisé ici est p(78)=12132164");
Put_Line("p(100) = 190569292");
Put_Line("p(200) = 3972999029388");
Put_Line("p(1000) = 24061467864032622473692149727991");
Debut:=(Val=>0,Rest=>Natural'Value(Argument(1)),Suiv=>null);
Traite(Debut);
Partit(Debut);
Put_Line("Parti interessante de l'algo terminée"&Natural'Image(N));
Construit(Debut,L);
AfficheB;
end; |