Mondial.pas

Un article de Wikipedia.

program Mondial;
type resultat=(perdu,nul,gagne);
     dataptr = ^data;
     data =record
      valeur:integer;
      suivant:dataptr;
      quantite:integer;
     end;
 
var ab,ac,ad,bc,bd,cd:resultat;
    a,b,c,d,n:integer;
    scores:dataptr;
    ensemble:dataptr;
function dataaddsort(premier:dataptr;d:integer;distinct:boolean):dataptr;
var precedent,actuel,tempptr:dataptr;
begin
 if premier = nil then
 begin
  new(premier);
  with premier^ do
  begin
   valeur:=d;
   quantite:=1;
   suivant:=nil;
  end;
 end
 else
 begin
  precedent:=nil;
  actuel:=premier;
  while (actuel^.suivant <> nil) and (d <= actuel^.valeur) do
  begin
   precedent:=actuel;
   actuel:=actuel^.suivant;
  end;
  if d < actuel^.valeur then
  begin
   new(actuel^.suivant);
   with actuel^.suivant^ do
   begin
    valeur:=d;
    quantite:=1;
    suivant:=nil;
   end;
  end
  else if d = actuel^.valeur then
  begin
   if distinct = true then
   begin
    new(actuel^.suivant);
    with actuel^.suivant^ do
    begin
     valeur:=d;
     quantite:=1;
     suivant:=nil;
    end;
   end
   else
    with actuel^ do
     quantite:=quantite+1;
  end
  else // d>actuel^.valeur
  begin
   if precedent = nil then
   begin
    new(precedent);
    with precedent^ do
    begin
     valeur:=d;
     quantite:=1;
     suivant:=actuel;
    end;
    premier:=precedent;
   end
   else if d = precedent^.valeur then
   begin
    if distinct = true then
    begin
     new(tempptr);
     with tempptr^ do
     begin
      valeur:=d;
      quantite:=1;
      suivant:=actuel;
     end;
     precedent^.suivant:=tempptr;
    end
    else
     with precedent^ do
      quantite:=quantite+1; 
   end
   else
   begin
    new(tempptr);
    with tempptr^ do
    begin
     valeur:=d;
     quantite:=1;
     suivant:=actuel;
    end;
    precedent^.suivant:=tempptr;
   end;
  end;
 end;
 dataaddsort:=premier;
end;
function datasize(premier:dataptr):integer;
var size:integer;
    actuel:dataptr;
begin
 if premier = nil then
  datasize:=0
 else
 begin
  size:=1;
  actuel:=premier;
  while actuel^.suivant <> nil do
  begin
   actuel:=actuel^.suivant;
   size:=size+1;
  end;
  datasize:=size;
 end;
end;
function dataclear(premier:dataptr):dataptr;
var actuel,precedent:dataptr;
begin
 if premier <> nil then
 begin
  actuel:=premier;
  while actuel^.suivant <> nil do
  begin
   precedent:=actuel;
   actuel:=actuel^.suivant;
   dispose(precedent);
  end;
  dispose(actuel);
 end;
 dataclear:=nil;
end;
function dataconvert(premier:dataptr):integer;
var resultat:integer;
    actuel:dataptr;
begin
 if premier <> nil then
 begin
  resultat:=0;
  actuel:=premier;
  while actuel^.suivant <> nil do
  begin
   resultat:=10*resultat+actuel^.valeur;
   actuel:=actuel^.suivant;
  end;
   resultat:=10*resultat+actuel^.valeur;
   dataconvert:=resultat;
 end
 else
  dataconvert:=-1;
end;
procedure dataprint(premier:dataptr);
var actuel:dataptr;
    n:integer;
begin
 if premier <> nil then
 begin
  n:=0;
  actuel:=premier;
  while actuel^.suivant <> nil do
  begin
   with actuel^ do
   begin
    write(valeur,' [',quantite:3,']  ');
   end;
   if n mod 3 = 2 then
    writeln;
   actuel:=actuel^.suivant;
   n:=n+1;
  end;
  with actuel^ do
  begin
   writeln(valeur,' [',quantite:3,']');
  end;
 end;
end;
function point(r:resultat):integer;
begin
 case r of
  perdu:point:=0;
    nul:point:=1;
  gagne:point:=3;
 end;
end;
function pointadv(r:resultat):integer;
begin
 case r of
  perdu:pointadv:=point(gagne);
    nul:pointadv:=point(nul);
  gagne:pointadv:=point(perdu);
 end;
end;
begin
 n:=0;
 for ab:=perdu to gagne do
  for ac:=perdu to gagne do
   for ad:=perdu to gagne do
    for bc:=perdu to gagne do
     for bd:=perdu to gagne do
      for cd:=perdu to gagne do
      begin
       a:=point(ab)+point(ac)+point(ad);
       b:=pointadv(ab)+point(bc)+point(bd);
       c:=pointadv(ac)+pointadv(bc)+point(cd);
       d:=pointadv(ad)+pointadv(bd)+pointadv(cd);
       scores:=dataaddsort(scores,a,true);
       scores:=dataaddsort(scores,b,true);
       scores:=dataaddsort(scores,c,true);
       scores:=dataaddsort(scores,d,true);
       ensemble:=dataaddsort(ensemble,dataconvert(scores),false);
       scores:=dataclear(scores);
       n:=n+1;
      end;
 writeln('Scores possibles au Mondial 2006');
 writeln('--------------------------------');
 writeln;
 dataprint(ensemble);
 writeln;
 writeln('Nombre de scores possibles : ',datasize(ensemble));
end.