ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1218. Episode N-th: The Jedi Tournament

please help! I think my program is right, but always WA!
Послано Protsenko Sergey[ISPU] 22 авг 2003 00:57
here is my program.
 1 i find  a jedi which cannot be beaten by another jedi with the
ekception of then some jedi which i already visited during DFS.
 2 this jedi can be the winner
 and also jedi which can be reached from this vertex in both sides
(can beat and be beaten)

 please mail your sugestions about this to p_s_@list.ru


THANKS IN ADVANCE!



VAR
  Name : ARRAY[1..510] OF String[32];
  w1,w,good : ARRAY[1..510] OF integer;

  Stat : ARRAY[1..510, 0..2] OF LongInt;
  a:array[1..510,1..510] of integer;
  N,m,point,num, I, J, Sum,l,i1,k : LongInt;
  S : String;
  Ok : Boolean;

  PROCEDURE init;
  VAR
    J,i : LongInt;
  BEGIN
   fillchar(a,sizeof(a),0);
   fillchar(good,sizeof(good),0);
   for i:=1 to n do
    for j:=1 to n do
     if (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
       a[i,j]:=1;
       inc(good[i]);
        end;

  END;
 procedure find(i:integer);
  var
  j,max:integer;
  f:boolean;
  begin
   j:=1;
   for i:=2 to n do
    if good[j]<good[i] then j:=i;
   k:=j;

  end;

procedure getting1;
var
 j,i:integer;
 t:array[1..501] of integer;
 f:boolean;
begin
 fillchar(t,sizeof(t),0);
 t[k]:=1;
  repeat
   f:=true;
   for i:=1 to n do
    if t[i]=1 then
     begin
      for j:=1 to n do
       if (a[i,j]=1)and(t[j]=0) then
        begin
         t[j]:=1;
         f:=false;
        end;
     end;
    if f then break;
  until false;
 for i:=1 to n do
  w[i]:=t[i];
end;


procedure getting2;
var
 j,i:integer;
 t:array[1..501] of integer;
 f:boolean;
begin
 fillchar(t,sizeof(t),0);
 t[k]:=1;
  repeat
   f:=true;
   for i:=1 to n do
    if t[i]=1 then
     begin
      for j:=1 to n do
       if (a[j,i]=1)and(t[j]=0) then
        begin
         t[j]:=1;
         f:=false;
        end;
     end;
    if f then break;
  until false;
 for i:=1 to n do
  w1[i]:=t[i];
end;



BEGIN
  ReadLn(N);

  FOR I := 1 TO N DO
    BEGIN
      ReadLn(S); S := S+' ';
      for j:=1 to length(s) do
       begin
        if (s[j]in['A'..'Z'])or(s[j] in ['a'..'z']) then
        begin
      insert(s[j],name[i],length(s));
       k:=j;
        end;
       end;
      Delete(S, 1, k);
      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;
  init;
  ok:=false;
  fillchar(w,sizeof(w),0);
  find(1);
  fillchar(w,sizeof(w),0);
  fillchar(w1,sizeof(w1),0);
  getting1;
  getting2;

  for i:=1 to n do
   begin
    if (w[i]=1)and(w1[i]=1) then writeln(name[i]);
   end;


END.