I think it's right but i got WA many times.


program p1208;
const maxx=20;
type arr=array [1..maxx,1..3] of string [30];
var n,max,contro:integer; names:arr;

{$APPTYPE CONSOLE}

procedure init;
var i,j,k:integer; same:boolean; line:string;
begin
 {    assign(input,'f:\data.in'); reset(input);    }
     readln(n); max:=0;
     for i:=1 to n do
       begin
         readln(line); j:=1; k:=1;
         while (j<=length(line)) do
           begin
             same:=true;
             while (line[j]<>' ') and (j<=length(line)) do
               begin
                 names[i,k]:=names[i,k]+line[j]; inc(j); same:=false;
               end;
             inc(j); if not same then inc(k);
           end;
       end;
end;

procedure solve(dep:integer);
var temp:arr; s,i,j,k:integer;
    function ok(p,r:integer):boolean;
    var i,j:integer;
    begin
         for i:=1 to 3 do
           for j:=1 to 3 do
             if (temp[p,i]=temp[r,j]) then begin ok:=true; exit; end;
         ok:=false;
    end;
begin
     s:=0;
     for i:=1 to maxx do
       for j:=1 to 3 do temp[i,j]:='';
     for i:=1 to n do
       for j:=1 to 3 do temp[i,j]:=names[i,j];
     for i:=dep to n do
       begin
         for j:=(i+1) to n do
           if (temp[j,1]<>'') and ok(i,j) then
             for k:=1 to 3 do temp[j,k]:='';
       end;
     for i:=dep to n do
       if (temp[i,1]<>'') then inc(s);
     if (max<s) then max:=s;
end;

procedure sout;
begin
    { assign(output,'f:\data.out'); rewrite(output);   }
     writeln(max);
end;

begin
     init;
     for contro:=1 to n do solve(contro);
     sout;
end.

I've found it!