Cod sursa(job #833896)

Utilizator hkgamer46Butuza Andrei hkgamer46 Data 13 decembrie 2012 11:41:15
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.84 kb
program permutari;
var s:array[1..10] of byte;
    f,q:text;
    ok:boolean;
    n,k:integer;
function check(n:integer):boolean;
        var i:integer;
        begin
        check:=true;
        for i:=1 to n-1 do if s[i]=s[n] then check:=false;
end;
procedure mult(t:integer);
        var i:integer;
        begin
        for i:=1 to t do write(q,s[i],' ');
        writeln(q);
        end;
begin
assign(f,'permutari.in');
reset(f);
assign(q,'permutari.out');
rewrite(q);
readln(f,n);
k:=1;
while k>0 do
begin
        ok:=false;
        while (s[k]<n) and (ok=false) do
        begin
                s[k]:=s[k]+1;
                if check(k) then ok:=true;
        end;
        if ok then if k=n then mult(k)
                          else inc(k)
              else begin s[k]:=0; dec(k); end;
end;
close(f);
close(q);
end.