ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1218. Episode N-th: The Jedi Tournament

please help! I think my program is right, but always WA!
Posted by Protsenko Sergey[ISPU] 22 Aug 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.