Cod sursa(job #136895)

Utilizator ravediscret rave Data 16 februarie 2008 13:14:39
Problema Pitici Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.83 kb
program pitici;
var a,b:array[1..100,1..100] of integer;
    x,s:array[1..100] of integer;
    i,j,c,d,y,e,n,m,p,k:integer;
    f,g:text;


procedure citire;
begin
assign(f,'pitici.in');reset(f);
read(f,n);read(f,m);read(f,p);
for i:=1 to m do
begin
read(f,c);read(f,d);read(f,e);
a[c,d]:=1;b[c,d]:=e {matrice de adiacenta respectiv costuri};
end;
for i:=1 to n do begin
for j:=1 to n do write(b[i,j],' '); writeln end;
close(f)
end;

function init(k:integer):integer;
begin init:=0;
end;

function urm(k:integer):boolean;
begin
urm:=(x[k]<n);
x[k]:=x[k]+1;write('k=',k,' ',x[k], ' ')
end;

function OK(k:integer):boolean;
begin
OK:=true;
if a[x[k-1],x[k]]=0 then OK:=false;

end;

function sol(k:integer):boolean;
begin
sol:=(x[k]=9)
end;

procedure tip(k:integer);
var i:integer;
begin
for i:=1 to k do write(x[i], ' ')
end;


procedure ordonare;
var OK:boolean;i,aux:integer;
begin
repeat
OK:=true;
for i:=1 to y-1 do
if s[i]>s[i+1] then begin aux:=s[i];
                        s[i]:=s[i+1];
                        s[i+1]:=aux;
                        OK:=false
                  end;
until OK;
end;

procedure back(k:integer);
begin
if sol(k-1) then begin tip(k-1); y:=y+1; s[y]:=0;
                       for i:=2 to k do begin  s[y]:=s[y]+b[x[i-1],x[i]]  ;
                       end;
                       write('Suma drumului ',s[y],' ');
                 end
else begin x[k]:=init(k);
           while urm(k) do
           if OK(k) then back(k+1)
     end;
end;

begin
assign(g,'pitici.out');rewrite(g);
for i:=1 to 10 do writeln;
citire; y:=0;
x[1]:=1;
back(2);
writeln('Sirul S are valorile');
for i:=1 to y do write(s[i],' ');
ordonare;
writeln('Sirul  S ordonat are valorile:');
for i:=1 to y do write(s[i],' ');
for i:=1 to p do write(g,s[i],' ');
close(g)
end.