Pagini recente » Cod sursa (job #2318254) | Cod sursa (job #1290839) | Cod sursa (job #341488) | Cod sursa (job #1300008) | Cod sursa (job #157880)
Cod sursa(job #157880)
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.