Cod sursa(job #720144)

Utilizator acs_davidAcs David acs_david Data 22 martie 2012 13:25:16
Problema Generare de permutari Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.6 kb
program backtrack;
type tomb=array[1..9] of integer;
var k,jo,van,n:integer;v:tomb;f,g:text;
procedure kovetkezo(k:integer;var van:integer);
begin
        if v[k]<n then
        begin
                van:=1;
                v[k]:=v[k]+1;
        end
        else
                van:=0;
end;
procedure ellenoriz(k:integer;var jo:integer);
var i:integer;
begin
        jo:=1;i:=1;
        while(i<>k) and (jo=1) do
                if v[k]=v[i] then
                        jo:=0
                else
                        i:=i+1;
end;
function megoldas(k:integer):integer;
var i:integer;
begin
        if k=n then
                i:=1
        else
                i:=0;
        megoldas:=i;
end;
procedure kiir(n:integer;v:tomb);
var i:integer;
begin
        for i:=1 to n do
                write(g,v[i],' ');
        writeln(g);
end;
BEGIN
        assign(f,'premutari.in');assign(g,'premutari.out');
        reset(f);read(f,n);k:=1;v[k]:=0;close(f);rewrite(g);
        while k>0 do
        begin
                repeat
                        kovetkezo(k,van);
                        if van=1 then
                                ellenoriz(k,jo);
                until ((van=1) and (jo=1)) or (van=0);
                if van=0 then
                        k:=k-1
                else
                        if megoldas(k)=1 then
                                kiir(k,v)
                        else
                        begin
                                k:=k+1;
                                v[k]:=0;
                        end;
        end;
close(g);
end.