[an error occurred while processing this directive]
Listing MINGEA.PAS
program Balls;
const mvec:array[1..12,1..5] of Byte=
{ muchiile adiacente fiecarei fete }
( (1,2,3,4,5),(1,10,11,12,6),
(2,6,13,14,7),(3,7,15,16,8),
(4,8,17,18,9),(10,5,9,19,20),
(11,20,21,26,25),(21,19,18,22,27),
(22,17,16,23,28),(23,15,14,24,29),
(24,13,12,25,30),(26,27,28,29,30) );
mnoi:array[1..12,1..5] of 0..1=
{ muchiile noi introduse de fiecare fata }
( (1,1,1,1,1),(0,1,1,1,1),(0,0,1,1,1),
(0,0,1,1,1),(0,0,1,1,1),(0,0,0,1,1),
(0,0,1,1,1),(0,0,0,1,1),(0,0,0,1,1),
(0,0,0,1,1),(0,0,0,0,1),(0,0,0,0,0));
type placa=array[1..5] of 0..2;
var Placi:array[1..12] of placa;
cul_muchie:array[1..30] of 0..3;
{ 3 = necolorat }
x:array[1..12] of Byte;
folosita:array[1..12] of Boolean;
OK:Boolean;
f:Text;
i:Byte;
procedure Citire;
var i,j:Byte;
begin
Assign(f,'BALL.IN'); Reset(f);
for i:=1 to 12 do
begin
for j:=1 to 5 do
Read(f,Placi[i,j]);
Readln(f)
end;
Close(f)
end;
procedure Scriere;
var i:Byte;
begin
Assign(f,'BALL.OUT'); Rewrite(f);
if OK
then
for i:=1 to 12 do
Writeln(f,x[i],' ',i)
else Writeln(f,'-1');
Close(f)
end;
procedure rotatie(var p:placa);
var i,temp:Byte;
begin
temp:=p[5];
for i:=5 downto 2 do
p[i]:=p[i-1];
p[1]:=temp
end;
function cont(k:Byte; p:placa):Boolean;
var j,m,color:Byte;
b:Boolean;
begin
b:=true;
j:=1;
while b and (j<=5) do
begin
m:=mvec[k,j];
color:=cul_muchie[m];
if (color<>3) and (color<>p[j])
then b:=false;
Inc(j)
end;
cont:=b
end;
procedure back(k:Byte);
var i,j,c:Byte;
p:placa;
begin
if OK then Exit;
if k=13
then
begin
OK:=true;
Exit
end;
for i:=1 to 12 do
if folosita[i]
then
else
begin
p:=Placi[i];
for j:=1 to 5 do
begin
if cont(k,p) and not OK
then
begin
for c:=1 to 5 do
if (mnoi[k,c]=1)
then
cul_muchie[mvec[k,c]]:=p[c];
x[k]:=i;
folosita[i]:=true;
back(k+1);
for c:=1 to 5 do
if (mnoi[k,c]=1)
then cul_muchie[mvec[k,c]]:=3;
folosita[i]:=false
end;
rotatie(p)
end
end
end;
Begin
for i:=1 to 30 do cul_muchie[i]:=3;
for i:=1 to 12 do folosita[i]:=false;
Citire;
OK:=false;
back(1);
Scriere
End.