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

Обсуждение задачи 1019. Перекрашивание прямой

Why is this program getting Compilation Error ?
Послано Costel::icerapper@k.ro 3 мар 2002 23:41
program p1019;
Const Maxn=500;

Type ArrType1 = Array[0..2*maxn+1] of Longint;
     ArrType2 = Array[0..2*maxn+1] of Byte;
     SonTyp = Record
                   Dau,Cuoi:Longint;
                   M : Byte;
               End;
     ResultTyp = Record l,First,Last:Longint; End;

Var
    Moc : ArrType1;
    Mau : ArrType2;
    Amount , n : Longint;
    Result : ResultTyp;
    Minh : Array[1..Maxn] of SonTyp;
{}
Procedure them(u:Longint);
Var i:Integer;
Begin
     For i:=1 to Amount do If Moc[i]=u then Exit;
     Inc(Amount);
     Moc[Amount]:=u;
End;
{}
Procedure ReadInput;
Var i:Integer;
    ch:Char;
Begin
       Readln(n);
       For i:=1 to n do
         Begin
              Read(Minh[i].Dau,Minh[i].Cuoi);
              them(Minh[i].Dau);
              them(Minh[i].Cuoi);
              Read(ch);
              While not (ch in['b','w'] ) do Read(ch);
              If ch='b' then Minh[i].m := 1
              Else Minh[i].m:=0;
         End;
End;
{}
Procedure Prepare;
Begin
     Result. L := 0;
End;
{}
Procedure _Record (d,c:Longint);
Begin
     If c-d > Result. l then
       Begin
            Result. l := c-d;
            Result. First := D;
            Result. Last := c;
       End;
End;
{}
Procedure Sort(l,r:Integer);
Var i,j : Byte;
    Tg , TrungDiem : Longint;
Begin
     i:= l;
     j:= r;
     TrungDiem := Moc[(l+r) div 2];
     Repeat
           While Moc[i] < TrungDiem do Inc(i);
           While Moc[j] > TrungDiem do Dec(j);
           If i<=j then
             Begin
                  Tg:=Moc[i];
                  Moc[i]:=Moc[j];
                  Moc[j]:=Tg;

                  Inc(i);
                  Dec(j);
             End;
     Until i>j;

     If i<r then Sort(i,r);
     If l<j then Sort(l,j);

End;
{}
Procedure Paint;
Var i,j:Longint;
Begin
     For i:=1 to n do
       Begin
            j:=1;
            While Moc[j] < Minh[i].Dau do Inc(j);
            While Moc[j] < Minh[i].Cuoi do
              Begin
                   Mau[j]:=Minh[i].m;
                   Inc(j);
              End;
       End;
End;
{}
Procedure FindLongest;
Var d,c,i:Longint;
Begin
     Moc[0]:=0;
     Moc[Amount+1]:=1000000000;
     Mau[0]:=0;
     Mau[Amount+1]:=0;
     d:=0;
     c:=0;
     For i:=1 to Amount+1 do
      Begin
           c := Moc[i];
           _Record(d,c);
           If mau[i] = 1 then
              Begin
                   While (i<=Amount+1) and (Mau[i]=1) do Inc(i);
                   D:=Moc[i];
              End;
      End;
End;
{}
Procedure Solve;
Begin
     Sort(1,Amount);
     Paint;
     FindLongest;
End;
{}
Begin
     ReadInput;
     Prepare;
     Solve;
     Writeln(Result.First,' ',Result.Last);
End.