-----------------------MY PROGRAM-----------------------
var a:array[1..300]of string[30];
    b:array[1..20,1..3]of integer;
    c:array[1..20]of byte;
    x,h,n,kol,max,i,j,l:integer;
    s,tmp:string;
function find(X:string):integer;
var i:integer;
begin
  for i:=1 to h do if a[i] = x then
  begin
    find:=i;exit;
  end;
  inc(h);
  a[h]:=X;
  find:=h;
end;

procedure r(k:integer);
begin
  if k = N+1 then
  begin
    if kol>max then max:=kol;
  end
  else
  begin
    if (c[b[k,1]] = 0)and(c[b[k,2]] = 0)and(c[b[k,3]] = 0) then
    begin
      c[b[k,1]] := 1;c[b[k,2]] := 1;c[b[k,3]] := 1;
      inc(kol);
      r(k+1);
      c[b[k,1]] := 0;c[b[k,2]] := 0;c[b[k,3]] := 0;
      dec(kol);
    end;
    r(k+1);
  end;
end;

begin
{  assign(input,'1208.dat');reset(input);}
  readln(N);
  max:=-10000;
  for i:=1 to N do
  begin
    readln(S);
    tmp:='';
    for j:=1 to length(s) do if s[j] in ['a'..'z'] then tmp:=tmp+s[j]
else break;
    l:=j;
    X:=find(tmp);
    b[i,1]:=X;
    for j:=l to length(s) do if s[j] in ['a'..'z'] then break;
    l:=j;
    tmp:='';
    for j:=l to length(s) do if s[j] in ['a'..'z'] then tmp:=tmp+s[j]
else break;
    l:=j;
    X:=find(tmp);
    b[i,2]:=X;
    for j:=l to length(s) do if s[j] in ['a'..'z'] then break;
    l:=j;
    tmp:='';
    for j:=l to length(s) do if s[j] in ['a'..'z'] then tmp:=tmp+s[j]
else break;
    l:=j;
    X:=find(tmp);
    b[i,3]:=X;
  end;
  r(1);
  writeln(max);
end.

You know, there can be some bug on this server concerning the arrays
named by one letter in Pascal (M[], S[], etc) Try to rename the
arrays if you really can't understand the mistake. See
acm.timus.ru/webboard.asp?id=1100 (webboard for the problem 1100) -
and read there.