I think my program is right, but it get WA!
VAR
Name, Win : ARRAY[1..510] OF String[32];
Flag, Killed : ARRAY[1..510] OF Byte;
Stat : ARRAY[1..510, 0..2] OF LongInt;
N, I, J, Sum : LongInt;
S : String;
Ok : Boolean;
PROCEDURE Solve(I : LongInt);
VAR
J : LongInt;
BEGIN
IF Killed[I] = 1 THEN Exit;
Killed[I] := 1;
FOR J := 1 TO N DO
IF (Killed[J] = 0) AND (I <> J) AND
(((Stat[I][0] > Stat[J][0]) AND (Stat[I][1] > Stat[J][1])) OR
((Stat[I][2] > Stat[J][2]) AND (Stat[I][1] > Stat[J][1])) OR
((Stat[I][0] > Stat[J][0]) AND (Stat[I][2] > Stat[J][2]))) THEN
BEGIN
Solve(J);
END;
END;
BEGIN
ReadLn(N);
FillChar(Flag, SizeOf(Flag), 0);
FOR I := 1 TO N DO
BEGIN
ReadLn(S); S := S+' ';
Name[I] := Copy(S, 1, Pos(' ', S)-1);
Delete(S, 1, Pos(' ', S));
WHILE (S[1] = ' ') DO Delete(S, 1, 1);
Sum := 0;
WHILE (S[1] <> ' ') DO
BEGIN
Sum := Sum*10+Ord(S[1])-Ord('0');
Delete(S, 1, 1);
END;
WHILE (S[1] = ' ') DO Delete(S, 1, 1);
Stat[I][0] := Sum;
Sum := 0;
WHILE (S[1] <> ' ') DO
BEGIN
Sum := Sum*10+Ord(S[1])-Ord('0');
Delete(S, 1, 1);
END;
WHILE (S[1] = ' ') DO Delete(S, 1, 1);
Stat[I][1] := Sum;
Sum := 0;
WHILE (S[1] <> ' ') DO
BEGIN
Sum := Sum*10+Ord(S[1])-Ord('0');
Delete(S, 1, 1);
END;
Stat[I][2] := Sum;
END;
FOR I := 1 TO N DO
BEGIN
FillChar(Killed, SizeOf(Killed), 0);
Solve(I);
Ok := True;
FOR J := 1 TO N DO
IF Killed[J] = 0 THEN Ok := False;
IF Ok THEN Flag[I] := 1;
END;
Sum := 0;
FOR I := 1 TO N DO
IF Flag[I] = 1 THEN
BEGIN
Inc(Sum);
Win[Sum] := Name[I]
END;
FOR I := 1 TO Sum-1 DO WriteLn(Win[I]);
Write(Win[Sum]);
END.