schiaucu.pas

This ar the basic programs that i did in highschool. From very simple to medium programs. From array

{Problema nr. 11}
const m=maxlongint;
type matrice=array[1..30,1..30] of integer;
var c:matrice; n,i,j,k,a:integer;  f:text;
     min:longint;   as,ev:boolean;
     t:array[1..50] of integer;  {t este vectorul transformarilor}
procedure citire;
 begin
  write('n=  ' );readln(n);
    assign(f,'p11.txt');reset(f);
     for i:=1 to n do begin
       for j:=1 to n do
          read(f,c[i,j]); end;
        readln(f);
    close(f);
 end;
function succesor(p:integer):boolean;
  var ok:boolean;
 begin
     ok:=false;
   if (p<=n) and (t[p]<n)  then begin
      t[p]:=t[p]+1;  ok:=true;
    end;
   succesor:=ok;
 end;
function valid(p:integer):boolean;
   var ok:boolean;
  begin
      ok:=true;
       for i:=1 to p-1 do begin
          if t[i]=t[p] then ok:=false;
        end;
     valid:=ok;
  end;
procedure afisare(p:integer);
  begin
    write('(  ');
     for i:=1 to p do  write(t[i],'  ');
     write(')'); writeln;
  end;
begin
   citire;
    for i:=1 to 50 do t[i]:=0;
  min:=m; k:=1;
    while k>0 do begin
      repeat
         as:=succesor(k);
         if as then ev:=valid(k);
      until (not as) or (as and ev);
       if as then begin
          if (k=n) then begin
               a:=0;
             for i:=1 to n-1  do
                a:=a+ c[t[i],t[i+1]];
             if a<min then min:=a;
          end
            else begin
              k:=k+1;
              t[k]:=0;
            end;
       end
       else k:=k-1;
    end;
  write('Costul minim este ' ,min); readln;
    write('Ordinea este: ');writeln;
       k:=1;
   while k>0 do begin
      repeat
         as:=succesor(k);
         if as then ev:=valid(k);
      until (not as) or (as and ev);
       if as then begin
          if (k=n) then begin
               a:=0;
             for i:=1 to n-1  do
                a:=a+ c[t[i],t[i+1]];
             if a=min then afisare(k);
          end
            else begin
              k:=k+1;
              t[k]:=0;
            end;
       end
       else k:=k-1;
    end;
end.