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

Обсуждение задачи 1078. Отрезки

I got WA! Why???
Послано Andrei Ghiuru [Agorex] 28 апр 2003 02:42
type list= array[1..500]of integer;
var e,c,d,a,b: list;
    n,i,j,k,m: longint;

procedure QuickSort(var A: List; Lo, Hi: Integer);

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      y := b[i]; b[i] := b[j]; b[j] := y;
      y := e[i]; e[i] := e[j]; e[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin {QuickSort};
  Sort(Lo,Hi);
end;


begin
 readln(n);
 for i:=1 to n do readln(a[i],b[i]);
 fillchar(c,sizeof(c),0);
 fillchar(d,sizeof(d),0);
 for i:=1 to n do e[i]:=i;
 quicksort(a,1,n);
 for i:=1 to n do
  begin
   k:=0;
   for j:=1 to i-1 do
    if (a[j]<a[i])and(b[j]>b[i])and(c[j]>k)then k:=j;
   if k<>0 then begin c[i]:=c[k]+1; d[i]:=k; end
   else begin c[i]:=1; d[i]:=0; end;
  end;
 k:=1; m:=1;
 for i:=1 to n do if c[i]>k then begin k:=i; m:=c[i]; end;
 writeln(m);
 m:=k;
 while m>0 do
  begin
   write(e[m],' ');
   m:=d[m];
  end;
end.