Cod sursa(job #157880)

Utilizator Marinescu_DanyelMarinescu George Marinescu_Danyel Data 13 martie 2008 12:42:43
Problema NKPerm Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.95 kb
program perm;
{$N+}
uses crt;
type test=record
    x:comp;
    a:char;
    sol:array[1..100]of integer;
    end;

var sol1:array[1..100]of integer;
    ext:array[1..20]of integer;
    f,g:text;
    mx:array[1..1000]of ^test;
    n,k,t,t1,j,j1:integer;
    nr:comp;
    ok:boolean;



procedure citire;
var i,j:integer;
begin
for i:=1 to t do
begin
new(mx[i]);
read(f,mx[i]^.a);
if mx[i]^.a='A' then
   begin
   for j:=1 to n*k do
   read(f,mx[i]^.sol[j])
   end
else if mx[i]^.a='B' then read(f,mx[i]^.x);
readln(f);
end;
end;

function valid(l:integer):boolean;
begin
valid:=true;
ok:=true;
if l>1 then
   if (sol1[l]=sol1[l-1]) then
begin
valid:=false;
ok:=false;
end;
end;


procedure back(l:integer);
var i,j:integer;
    ok:boolean;
begin
if l=k*n+1 then
   begin
   nr:=nr+1;
   for i:=1 to t do
   if mx[i]^.a='B' then
      begin
      if nr=mx[i]^.x then
         for j:=1 to n*k do
         mx[i]^.sol[j]:=sol1[j];
      end
   else
       begin
       ok:=true;
       for j:=1 to n*k do
       if mx[i]^.sol[j]<>sol1[j] then ok:=false;
       if ok then mx[i]^.x:=nr;
       end;
   {for i:=1 to n*k do
   write(sol1[i],' ');
   writeln;}
   end
else
    for i:=1 to n do
     if ext[i]>0 then
        begin
        sol1[l]:=i;
        ext[i]:=ext[i]-1;
        if valid(l) then back(l+1);
        ext[i]:=ext[i]+1;
        end;
end;

procedure scriere;
var i,j:integer;
begin
for i:=1 to t do
if mx[i]^.a='A' then writeln(g,mx[i]^.x:0:0)
else
    if mx[i]^.a='B' then
    begin
    for j:=1 to n*k do
    write(g,mx[i]^.sol[j],' ');
    writeln(g);
    end;
close(G);
end;

begin
clrscr;
nr:=0;
assign(f,'nkperm.in');
assign(g,'nkperm.out');
rewrite(g);
reset(f);
readln(f,n,k,t);
citire;

for j:=1 to n do
ext[j]:=k;
back(1);
scriere;

{for j1:=1 to t do
begin
write('x) ',mx[j1]^.x,'a) ',mx[j1]^.a);
for j:=1 to n*k do
write(mx[j1]^.sol[j],' ');
end;}
end.