here is my program:




type arr=array[1..54]of string;
var team1:arr;
    a:array[1..18,1..3]of string;
    x:longint;
    s:string;
    max_t,max,i,j,n,h:longint;
procedure team(num:longint);
var i,j:longint;
function p(f:longint):boolean;
var i,j:longint;
begin
     p:=true;
     for i:=1 to x*3 do
         if (a[f,1]=team1[i])or(a[f,2]=team1[i])or(a[f,3]=team1[i])
            then begin p:=false;exit;end;
end;
begin
     if num=n then exit;
     for i:=num+1 to n do
         if p(i) then begin
         team1[x*3+1]:=a[i,1];
         team1[x*3+2]:=a[i,2];
         team1[x*3+3]:=a[i,3];
         inc(max_t);inc(x);
         for j:=i+1 to n do team(j);
         if max_t>max then max:=max_t;
         dec(max_t);dec(x);
         team1[x*3+1]:='';
         team1[x*3+2]:='';
         team1[x*3+3]:='';
         end;
end;
begin
     readln(n);
     for i:=1 to n do
         begin
              readln(s);h:=1;
              for j:=1 to length(s) do
                  if s[j]<>' ' then a[i,h]:=a[i,h]+s[j]
                               else inc(h);
                  end;
                  s:='';
                  max:=1;x:=1;
     i:=1;
     while i<n-max do begin team1[1]:=a[i,1];team1[2]:=a[i,2];team1
[3]:=a[i,3];team(i);inc(i);end;
     writeln(max);
end.