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

Общий форум

Why I got 'Carsh(ACCESS_VIOLATION)',and Not'Time Limit' (1039)
Послано try try try 12 авг 2001 21:00
Type    Arr1    = Array[1..2] of Integer;
        Arr     = Array[0..12000] of Arr1;
        Arr2    = Array[0..6000] of Integer;
Var C           : Array[0..6000] of Integer;
    Root        : ^Arr2;
    Max         : Array[0..6000,1..2] of Longint;
    A           : ^Arr;
    Total       : Integer;
    N           : Integer;

Procedure Init;
Var i,j : Integer;
Begin
  New(A); New(Root);
  Fillchar(Root^,Sizeof(Root^),0);
  Fillchar(A^,Sizeof(A^),0);
  Readln(N);
  For i := 1 to N do
    Readln(C[i]);
  Repeat
    Readln(i,j);
    If i<>0 then
      Begin
        Inc(Total);
        If Total>N-1 then
          Begin
            Repeat
            Until Total<>Total;
          End;
        A^[Total,1] := i;
        A^[Total,2] := j;
        A^[Total+N-1,1] := j;
        A^[Total+N-1,2] := i;
      End;
  Until i=0;
End;

Procedure Sort(X,Y : Integer);
Var i,j             : Integer;
    k               : Arr1;

Begin
  If X>=Y then Exit;
  i := X-1; j := Y;
  Repeat
    If i<j then
      Repeat
        Inc(i);
      Until (i=j) or (A^[i,1]>=A^[j,1]);
    If A^[i,1]>A^[j,1] then
      Begin
        k := A^[i]; A^[i] := A^[j]; A^[j] := k;
      End;
    If i<j then
      Repeat
        Dec(j);
      Until (i=j) or (A^[i,1]>=A^[j,1]);
    If A^[i,1]>A^[j,1] then
      Begin
        k := A^[i]; A^[i] := A^[j]; A^[j] := k;
      End;
  Until i>=j;
  Sort(X,i-1); Sort(i+1,Y);
End;

Function Find(X : Integer) : Integer;
Var i,j,k       : Integer;
Begin
  i := 1; j := 2*N-2;
  Repeat
    k := (i+j) div 2;
    If X>A^[k,1] then i := k
                 else If X=A^[k,1] then Begin
                                          i := k;
                                          Break
                                        End
                                   else j := k;
  Until j-i<2;
  If A^[j,1]=X then i := i;

  Inc(i);
  Repeat
    Dec(i);
  Until (i=1) or (A^[i-1,1]<>X);
  Find := i;
End;

Procedure Main;
Var i,j,k      : Integer;
    H,T        : Integer;
    Point      : Integer;
    Q          : Array[1..6000] of Integer;
    B          : Array[1..6000] of Boolean;
    No_Change  : Boolean;
    Temp       : Arr1;

Begin
  For i := 1 to N div 4 do
    Begin
      j := Random((N-1)*2)+1;
      k := Random((N-1)*2)+1;
      Temp := A^[j]; A^[j] := A^[k]; A^[k] := Temp;
    End;
  Sort(1,(N-1)*2);
  H := 1; T := 1;
  Q[1] := 1;
  Fillchar(B,Sizeof(B),True);
  B[1] := False;

  Repeat
    j := Find(Q[H]);
    For i := j to (N*2-2) do
      If A^[i,1]<>Q[H] then Break else
        If B[A^[i,2]] then
          Begin
            Inc(T);
            Q[T] := A^[i,2];
            Root^[Q[T]] := Q[H];
            B[Q[T]] := False;
          End;
    Inc(H);
  Until H>T;
  Fillchar(B,Sizeof(B),True);
  For Point := T downto 1 do
    Begin
      i := Q[Point];
      Inc(Max[i,2],C[i]);
      If Root^[i] <> 0 then
        Begin
          If Max[i,1]>Max[i,2] then Inc(Max[Root^[i],1],Max
[i,1])
                               else Inc(Max[Root^[i],1],Max
[i,2]);
          Inc(Max[Root^[i],2],Max[i,1]);
        End;
      B[i] := False;
    End;
  If Max[1,1]>Max[1,2] then Writeln(Max[1,1])
                       else Writeln(Max[1,2]);
End;

Begin
  Init;
  Main;
End.