raven вот мой вариант решения твоей задачи - примитивно
, но работает
даже если строки менять местами (я менял только две строки местами остальные не стал - торопился)
Код: PROGRAM raven;
USES crt;
TYPE
Mas=array[1..7,1..3] of String;
VAR
ppl: Mas;
iskl:array[1..4] of Integer;
rest:array[1..3] of Integer;
i,j,k,l,m,n,o,p: integer;
last: integer;
pass1, pass2, pass3, ok: boolean;
FUNCTION Check(ppl:Mas; a,c:integer): boolean;
Begin
if ((
(ppl[a,1]=ppl[c,1])or
(ppl[a,1]=ppl[c,2])or
(ppl[a,1]=ppl[c,3])
)
and
(
(ppl[a,2]=ppl[c,1])or
(ppl[a,2]=ppl[c,2])or
(ppl[a,2]=ppl[c,3])
))
OR
((
(ppl[a,1]=ppl[c,1])or
(ppl[a,1]=ppl[c,2])or
(ppl[a,1]=ppl[c,3])
)
and
(
(ppl[a,3]=ppl[c,1])or
(ppl[a,3]=ppl[c,2])or
(ppl[a,3]=ppl[c,3])
))
OR
((
(ppl[a,2]=ppl[c,1])or
(ppl[a,2]=ppl[c,2])or
(ppl[a,2]=ppl[c,3])
)
and
(
(ppl[a,3]=ppl[c,1])or
(ppl[a,3]=ppl[c,2])or
(ppl[a,3]=ppl[c,3])
))
then Check:=True
else Check:=False;
End;
BEGIN
clrscr;
ppl[1,1]:='Konstantin';
ppl[1,2]:='Dmitrij';
ppl[1,3]:='Svetlana';
ppl[2,1]:='Elza';
ppl[2,2]:='Vladimir';
ppl[2,3]:='Dmitrij';
ppl[3,1]:='Grigorij';
ppl[3,2]:='Maxim';
ppl[3,3]:='Bogdan';
ppl[4,1]:='Svetlana';
ppl[4,2]:='Zhanna';
ppl[4,3]:='Dmitrij';
ppl[5,1]:='Grigorij';
ppl[5,2]:='Zhanna';
ppl[5,3]:='Pavel';
ppl[6,1]:='Elza';
ppl[6,2]:='Maxim';
ppl[6,3]:='Pavel';
ppl[7,1]:='Vladimir';
ppl[7,2]:='Pavel';
ppl[7,3]:='Elza';
for k:= 1 to 7 do begin
iskl[4]:=k;
pass1:=false;
pass2:=false;
pass3:=false;
for i:= 1 to 3 do begin
iskl[i]:=0;
rest[i]:=0;
end;
for i:= 1 to 7 do begin
if k<>i then begin
if ((ppl[i,1]<>ppl[k,1]) and (ppl[i,1]<>ppl[k,2]) and (ppl[i,1]<>ppl[k,3])) and
((ppl[i,2]<>ppl[k,1]) and (ppl[i,2]<>ppl[k,2]) and (ppl[i,2]<>ppl[k,3])) and
((ppl[i,3]<>ppl[k,1]) and (ppl[i,3]<>ppl[k,2]) and (ppl[i,3]<>ppl[k,3]))
then begin
{заполняем мисключающий массив стркоми имена в который не совпадают с именами в строке k}
if (iskl[1]<>0) and (iskl[2]<>0) and (iskl[3]<>0) then
pass1:=false
else begin
if iskl[1]=0 then iskl[1]:=i
else if iskl[2]=0 then iskl[2]:=i
else if iskl[3]=0 then iskl[3]:=i;
if (iskl[1]<>0) and (iskl[2]<>0) and (iskl[3]<>0) then pass1:=true;
end;
end;
end;
end;
{если нашли три строки - заполняем массив оставшимися элементами т.е. без строки k и строк в исключающем массиве}
if pass1 then begin
for l:= 1 to 7 do begin
if (l<>iskl[1]) and (l<>iskl[2]) and (l<>iskl[3]) and (l<>iskl[4]) and (rest[1]=0) then rest[1]:=l
else if (l<>iskl[1]) and (l<>iskl[2]) and (l<>iskl[3]) and (l<>iskl[4]) and (rest[2]=0) then rest[2]:=l
else if (l<>iskl[1]) and (l<>iskl[2]) and (l<>iskl[3]) and (l<>iskl[4]) and (rest[3]=0) then rest[3]:=l;
end;
if (rest[1]<>0) and (rest[2]<>0) and (rest[3]<>0) then pass2:=true;
end;
{проверяем есть ли среди оставшихся строк две в которых 2 имени совпадают со строкой k}
if pass2 then begin
if ( (Check(ppl,rest[1],k)) and (Check(ppl,rest[2],k)) )
OR
( (Check(ppl,rest[2],k)) and (Check(ppl,rest[3],k)) )
OR
( (Check(ppl,rest[1],k)) and (Check(ppl,rest[3],k)) )
then
if pass3<>true then pass3:=true;
if (Check(ppl,rest[1],k)) and (Check(ppl,rest[2],k)) then last:=3;
if (Check(ppl,rest[2],k)) and (Check(ppl,rest[3],k)) then last:=1;
if (Check(ppl,rest[1],k)) and (Check(ppl,rest[3],k)) then last:=2
else
pass3:=false;
end;
{если такие две строки нашлись то третью проверяем на соответствие одного имени строки k}
if pass3 then begin
ok:=false;
if (ppl[last,1]=ppl[iskl[4],1]) or
(ppl[last,1]=ppl[iskl[4],2]) or
(ppl[last,1]=ppl[iskl[4],3]) or
(ppl[last,2]=ppl[iskl[4],1]) or
(ppl[last,2]=ppl[iskl[4],2]) or
(ppl[last,2]=ppl[iskl[4],3]) or
(ppl[last,3]=ppl[iskl[4],1]) or
(ppl[last,3]=ppl[iskl[4],2]) or
(ppl[last,3]=ppl[iskl[4],3])
then begin
if ok=false then ok:=true
else ok:=false;
end;
if ok then begin
Writeln('Winners (in string #',k,'):');
for n:=1 to 3 do writeln(n,'. ',ppl[iskl[4],n]);
readkey;
halt;
end;
end;
end;
Writeln('No winners!');
Readkey;
END.
