Cod sursa(job #159439)

Utilizator Marinescu_DanyelMarinescu George Marinescu_Danyel Data 14 martie 2008 09:44:31
Problema NKPerm Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.07 kb
program perm;
{$N+}
type test=record
    x:comp;
    a:char;
    go:boolean;
    sol:array[1..100]of byte;
    end;

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



procedure citire;
var i,j:integer;
begin
nr:=0;
assign(f,'nkperm.in');
reset(f);
readln(f,n,k,t);
for i:=1 to t do
  begin
  new(mx[i]);
  read(f,mx[i]^.a);
  mx[i]^.go:=true;
  if mx[i]^.a='A' then
     begin
     for j:=1 to n*k do
        read(f,mx[i]^.sol[j]);
     readln(f);
     end
  else
      if mx[i]^.a='B' then
         readln(f,mx[i]^.x);
  end;
for j:=1 to n do
  ext[j]:=k;
nk:=n*k;
t1:=0;
sol1[0]:=0;
end;

procedure tipar;
var ok:boolean;
    j,jj:integer;
begin
nr:=nr+1;
for j:=1 to t do
  if mx[j]^.go then
    if mx[j]^.a='B' then
      begin
      if nr=mx[j]^.x then
         begin
         for jj:=1 to nk do
           mx[j]^.sol[jj]:=sol1[jj];
         mx[j]^.go:=false;
         t1:=t1+1;
         end
      end
    else
      begin
      ok:=true;
      for jj:=1 to nk do
        if mx[j]^.sol[jj]<>sol1[jj] then
          ok:=false;
      if ok then
         begin
         mx[j]^.x:=nr;
         mx[j]^.go:=false;
         t1:=t1+1
         end;
      end;
end;

procedure back(l:integer);
var i:integer;
begin
for i:=1 to n do
  if (t1<t)and(ext[i]>0)and(i<>sol1[l-1]) then
     begin
     sol1[l]:=i;
     ext[i]:=ext[i]-1;
     if l=nk then
       tipar
     else
       back(l+1);
     ext[i]:=ext[i]+1;
     end;
end;

procedure scriere;
var i,j:integer;
begin
assign(g,'nkperm.out');
rewrite(g);
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 nk do
        write(g,mx[i]^.sol[j],' ');
      writeln(g);
      end;
close(G);
end;

begin
citire;
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.