home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 78 / IOPROG_78.ISO / soft / Codice / combina.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-01-29  |  2.3 KB  |  103 lines
  1. Program combinazioni;
  2. const DIM=10;
  3. type vettoreogg = array[1..DIM] of char;
  4.         vettore = array[1..DIM] of integer;
  5. var oggetti : vettoreogg;
  6.           n : integer; (* dimensione vettore(numero oggetti) *)
  7.  
  8. Procedure carica (var v:vettoreogg);
  9. var i:integer;
  10. Begin
  11.      write('numero oggetti -> ');
  12.      readln(n);
  13.      for i:=1 to n do
  14.          Begin
  15.               write('oggetto - ',i,' -> ');
  16.               readln(v[i]);
  17.          End;
  18. End;
  19.  
  20.  
  21. Procedure combina_2(v:vettoreogg);
  22. var i,j:integer;
  23. Begin
  24.      writeln('Combinazioni di ',n,' della classe 2');
  25.      for i := 1 to n do
  26.      Begin
  27.           for j := i+1 to n do
  28.               write(v[i]:4,v[j]:1);
  29.           writeln
  30.      End;
  31.      readln;
  32. End;
  33.  
  34. Procedure combina_3(v:vettoreogg);
  35. var i,j,h:integer;
  36. Begin
  37.      writeln('Combinazioni di ',n,' della classe 3');
  38.      for i := 1 to n do
  39.        for j := i+1 to n  do
  40.           begin
  41.               for h:=j+1 to n  do
  42.                  write(v[i]:4,v[j]:1,v[h]:1);
  43.               writeln
  44.           end;
  45.      readln;
  46. End;
  47.  
  48. procedure inizializza(var pc,pl:vettore; pk:integer);
  49. var   i:integer;
  50. Begin
  51.      for i:=1 to pk do
  52.      Begin
  53.           pc[i]:=i;
  54.           pl[pk-i+1]:=n-i+1
  55.      End;
  56.      pc[pk]:=pc[pk]-1
  57. end;
  58.  
  59. Procedure incrementa(var pc:vettore; pl:vettore; pk:integer);
  60. var cont1,cont2 : integer;
  61.            incr : boolean;
  62. Begin
  63.     cont1:= pk; incr:=false;
  64.     repeat
  65.         if pc[cont1] < pl[cont1] then
  66.         begin
  67.             incr := true;
  68.             pc[cont1] := pc[cont1]+1 ;
  69.             for cont2:=cont1 to pk do
  70.                 pc[cont2+1] := pc[cont2]+1 ;
  71.         end
  72.         else  cont1 := cont1 -1;
  73.     until (incr=true) or (pc[1]=pl[1])
  74. End;
  75.  
  76. procedure combina_k(v:vettoreogg);
  77. var  c,l : vettore;
  78.      k,d : integer;
  79. Begin
  80.      Write('Classe k ->');
  81.      readln(k);
  82.      inizializza(c,l,k);       // inizializzazione dei due vettori c e l
  83.      writeln('Combinazioni di ',n,' della classe ',k);
  84.      repeat
  85.            incrementa(c,l,k);
  86.            for d:=1 to k do
  87.            write(v[c[d]]);// ╚ presente un indicizzazione indiretta
  88.            writeln;
  89.      until c[1]=l[1];          // condizione d'uscita
  90. End;
  91.  
  92.  
  93.  
  94. Begin (* Principale *)
  95.       carica(oggetti);
  96.       combina_2(oggetti);
  97.       combina_3(oggetti);
  98.       combina_k(oggetti);
  99.       readln
  100. End.
  101.  
  102.  
  103.