各种不解释,建图再拓扑判断是否可行
Var
map:array[1..40,1..40,0..9]of longint;
g,w:array[1..40,1..40]of longint;
v,ind:array[-1..19]of longint;
q:array[1..10000]of longint;
cz:array[0..9,0..9]of boolean;
head,tail,i,j:longint;
s:string;
Procedure init;
var
i,j:longint;
begin
map[1,1,0]:=1;map[1,1,1]:=1;
map[1,2,0]:=2;map[1,2,1]:=1;map[1,2,2]:=2;
map[1,3,0]:=2;map[1,3,1]:=2;map[1,3,2]:=3;
map[1,4,0]:=1;map[1,4,1]:=3;
map[2,1,0]:=2;map[2,1,1]:=1;map[2,1,2]:=4;
map[2,2,0]:=4;map[2,2,1]:=1;map[2,2,2]:=2;map[2,2,3]:=4;map[2,2,4]:=5;
map[2,3,0]:=4;map[2,3,1]:=2;map[2,3,2]:=3;map[2,3,3]:=5;map[2,3,4]:=6;
map[2,4,0]:=2;map[2,4,1]:=3;map[2,4,2]:=6;
map[3,1,0]:=2;map[3,1,1]:=4;map[3,1,2]:=7;
map[3,2,0]:=4;map[3,2,1]:=4;map[3,2,2]:=5;map[3,2,3]:=7;map[3,2,4]:=8;
map[3,3,0]:=4;map[3,3,1]:=5;map[3,3,2]:=6;map[3,3,3]:=8;map[3,3,4]:=9;
map[3,4,0]:=2;map[3,4,1]:=6;map[3,4,2]:=9;
map[4,1,0]:=1;map[4,1,1]:=7;
map[4,2,0]:=2;map[4,2,1]:=7;map[4,2,2]:=8;
map[4,3,0]:=2;map[4,3,1]:=8;map[4,3,2]:=9;
map[4,4,0]:=1;map[4,4,1]:=9;
fillchar(v,sizeof(v),0);
fillchar(w,sizeof(w),0);
fillchar(ind,sizeof(ind),0);
fillchar(cz,sizeof(cz),0);
fillchar(g,sizeof(g),0);
for i:=1 to 4 do
begin
for j:=1 to 4 do read(g[i,j]);
readln;
end;
end;
Procedure addgraph(x,y:longint);
begin
if not cz[x,y] then
begin
inc(ind[y]);
inc(v[x]);
w[x,v[x]]:=y;
cz[x,y]:=true;
end;
end;
Procedure setgraph;
var
i,j,k:longint;
begin
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to map[i,j,0] do
if map[i,j,k]<>g[i,j] then addgraph(g[i,j],map[i,j,k]);
end;
Procedure Enque(x:longint);
begin
inc(tail);
q[tail]:=x;
end;
Procedure topsort;
var
i,j,pre,pos:longint;
begin
head:=0;tail:=0;
for i:=1 to 9 do if ind[i]=0 then enque(i);
while head<tail do
begin
inc(head);
pre:=q[head];
for i:=1 to v[pre] do
begin
pos:=w[pre,i];
dec(ind[pos]);
if ind[pos]=0 then enque(pos);
end;
end;
write('THESE WINDOWS ARE ');
if tail=9 then writeln('CLEAN') else writeln('BROKEN');
end;
Begin
s:='';
while s<>'ENDOFINPUT' do
begin
readln(s);
if s='ENDOFINPUT' then break;
init;
setgraph;
topsort;
readln(s);
end;
End.