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

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

why?Here is my code.But time limited.If the differences cause it,what can I do?
Послано starhder 22 апр 2003 19:03
program Ural1019;
const
  maxn = 5001;
type
  node = record
           x, y, c:longint;
         end;
  linetree = object
               lchild, rchild:^linetree;
               l, r,
               llength, rlength,
               longest, x, colour:longint;
               procedure build(i, j:longint);
               procedure insert(i, j, col:longint);
             end;
var
  a:array [0..maxn] of node;
  a_x:array [0..maxn + maxn] of longint;
  n, nc:longint;
  xtree:linetree;

procedure linetree.build(i, j:longint);
begin
  l:=i; r:=j;
  x:=0;
  longest:=0; //a_x[r] - a_x[l];
  llength:=longest; rlength:=longest;
  colour:=0;
  if r - l > 1 then
    begin
      new(lchild);
      lchild^.build(i, (i + j) shr 1);
      new(rchild);
      rchild^.build((i + j) shr 1, j);
    end else
    begin
      lchild:=nil;
      rchild:=nil;
    end;
end;

procedure linetree.insert(i, j, col:longint);
begin
  if col = colour then exit;
  if (i <= l) and (r <= j) then colour:=col else
    begin
      if colour = 0 then
        begin
          if i < (l + r) shr 1 then lchild^.insert(i, j, col);
          if j > (l + r) shr 1 then rchild^.insert(i, j, col);
        end else
        begin
          if i < (l + r) shr 1 then lchild^.insert(i, j, col);
          if j > (l + r) shr 1 then rchild^.insert(i, j, col);
          if i > l then
            begin
              lchild^.insert(l, i, colour);
              if i > (l + r) shr 1 then rchild^.insert(l, i, colour);
            end;
          if j < r then
            begin
              rchild^.insert(j, r, colour);
              if j < (l + r) shr 1 then lchild^.insert(j, r, colour);
            end;
          colour:=0;
        end;
    end;
  if colour = 0 then
    begin
      if lchild^.colour = 1 then llength:=lchild^.llength +
rchild^.llength
                            else llength:=lchild^.llength;
      if rchild^.colour = 1 then rlength:=lchild^.rlength +
rchild^.rlength
                            else rlength:=rchild^.rlength;
      x:=lchild^.x;
      longest:=lchild^.longest;
      if longest < lchild^.rlength + rchild^.llength then
        begin
          longest:=lchild^.rlength + rchild^.llength;
          x:=a_x[lchild^.r] - lchild^.rlength;
        end;
      if longest < rchild^.longest then
        begin
          longest:=rchild^.longest;
          x:=rchild^.x;
        end;
      if longest = a_x[r] - a_x[l] then
        begin
          colour:=1;
          llength:=longest;
          rlength:=longest;
          x:=a_x[l];
        end;
//      if longest = 0 then colour:=2;
      exit;
    end;
  if colour = 1 then
    begin
      llength:=a_x[r] - a_x[l];
      rlength:=a_x[r] - a_x[l];
      x:=a_x[l];
      longest:=a_x[r] - a_x[l];
      exit;
    end;
  if colour = 2 then
    begin
      llength:=0;
      rlength:=0;
      x:=a_x[l];
      longest:=0;
    end;
end;

procedure qsort(l, r:longint);
var
  i, j, x, y:longint;
begin
  i:=l; j:=r; x:=a_x[l + random(r - l + 1)];
  repeat
    while a_x[i] < x do inc(i);
    while a_x[j] > x do dec(j);
    if i <= j then
      begin
        y:=a_x[i]; a_x[i]:=a_x[j]; a_x[j]:=y;
        inc(i); dec(j);
      end;
  until i > j;
  if i < r then qsort(i, r);
  if l < j then qsort(l, j);
end;

procedure optmize;
var
  tmp:array [0..maxn + maxn] of longint;
  i, k:longint;
begin
  k:=1;
  while k <= nc do
    begin
      i:=k;
      while (a_x[i] = a_x[i + 1]) and (i <= nc) do inc(i);
      inc(i);
      tmp[k]:=i;
      k:=i;
    end;
  i:=0; k:=1;
  while k <= nc do
    begin
      inc(i);
      a_x[i]:=a_x[k];
      k:=tmp[k];
    end;
  nc:=i;
end;

procedure divide;
var
  k, i, j, l, x:longint;
begin
  for l:=
The differences between pascal and delphi.
Послано starhder 22 апр 2003 19:05