MY PROGRAM:
var
  i , k , ppos: byte;
  dy : byte;
  name : array [1..100] of string[255];
  o : array [1..20,1..3] of byte;
  cann : array [1..100] of boolean;
  max : byte;
  e : boolean;
  now , pp , j , zz : byte;
  s , cc: string;
procedure init;
begin
  for i := 1 to 100 do cann[i] := true;
  dy := 0;
  now := 0;
  max := 0;
  readln(k);
  for i := 1 to k do begin
    readln(s);
    zz := 0;
    ppos := 1;
    while ppos<>0 do begin
      inc(zz);
      ppos := pos(' ',s);
      if ppos <> 0 then begin
      cc := copy(s,1,ppos-1);
      e := true;
      delete(s,1,ppos);
      while s[1] = ' ' do delete(s,1,1);
      end else cc := s;
      for j := 1 to dy do
        if name[j] = cc then begin
           o[i,zz] := j;
           e := false;
           break;
        end;
      if e then begin
        inc(dy);
        name[dy] := cc;
        o[i,zz] := dy;
      end;
    end;
  end;
end;

procedure sub(x : byte);
var
  jj : byte;
begin
  if now + 3 * (i - x + 1) < max then exit;
  if x = i+1 then begin
    if now > max then max := now;
    exit;
  end;
  for jj := 0 to 1 do
    if jj = 0 then sub(x+1) else
    if cann[o[x,1]] and cann[o[x,2]] and cann[o[x,3]] then begin
      cann[o[x,1]] := false;
      cann[o[x,2]] := false;
      cann[o[x,3]] := false;
      inc(now);
      sub(x+1);
      dec(now);
      cann[o[x,1]] := true;
      cann[o[x,2]] := true;
      cann[o[x,3]] := true;
    end;
end;
procedure out;
begin
  writeln(max);
end;
begin
  init;
  sub(1);
  out;
end.

i suggest you to try a again one day later.
i submit a same program twice then i got cash and AC..
-_-b

hoho