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

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

I don't use heap, but I've got wa7. Please give me some contrtests. Thanks.
Послано Crash_access_violation 9 июл 2008 01:44
CONST
 MaxN = 50000;

TYPE
 List = Record
  s, f, t : Longint;
  b : BooLean;
 End;

VAR
 N, M, K, P, Res : Longint;
 A : Array [1 .. MaxN] of List;
 Ans : Array [1 .. MaxN] of Longint;

PROCEDURE In_Data;
 Var
  i : Longint;
   Begin
    ReadLn(N, M, K, P);
     for i := 1 to K do
      begin
       ReadLn(A[i].s, A[i].f);
       A[i].t := i;
       A[i].b := false;
      end;
   End;

PROCEDURE qSort(L, R : Longint);
 Var
  i, j, x, y, temp : Longint;
   Begin
    i := L;
    j := R;
    x := A[(L + R) div 2].f;
    y := A[(L + R) div 2].s;
     Repeat
      while (A[i].f < x) or ((A[i].f = x) and (A[i].s < y)) do
       inc(i);
        while (A[j].f > x) or ((A[j].f = x) and (A[j].s > y)) do
         dec(j);
          if i <= j then
            begin
             temp   := A[i].s;
             A[i].s := A[j].s;
             A[j].s := temp;
             temp   := A[i].f;
             A[i].f := A[j].f;
             A[j].f := temp;
             temp   := A[i].t;
             A[i].t := A[j].t;
             A[j].t := temp;
             inc(i);
             dec(j);
            end;
     UntiL i > j;
      if L < j then
        qSort(L, j);
      if i < R then
        qSort(i, R);
   End;

PROCEDURE Solve;
 Var
  i, j, temp : Longint;
   Begin
    j := 1;
     while A[j].b and (j < K) do
      inc(j);
    if (j = K) and A[j].b then
      Exit;
    temp := 0;
     for i := j to K do
      if not A[i].b then
       if temp <= A[i].s then
         begin
          inc(Res);
          Ans[Res] := A[i].t;
          A[i].b := true;
          temp := A[i].f;
         end;
   End;

PROCEDURE Out_Data;
 Var
  i : Longint;
   Begin
    WriteLn(Res * P);
     for i := 1 to Res do
      Write(Ans[i], ' ');
   End;

PROCEDURE Run;
 Var
  i : Longint;
   Begin
    In_Data;
     if K > 1 then
      qSort(1, K);
      Res := 0;
     for i := 1 to M do
      Solve;
      Out_Data;
   End;

BEGIN
 Run;
END.
Re: I don't use heap, but I've got wa7. Please give me some contrtests. Thanks.
Послано Piratek-(akaDK) 6 авг 2008 22:01
You Algo is Wrong for 100 percent. First i solved as you now i AC
Crash_access_violation писал(a) 9 июля 2008 01:44
CONST
 MaxN = 50000;

TYPE
 List = Record
  s, f, t : Longint;
  b : BooLean;
 End;

VAR
 N, M, K, P, Res : Longint;
 A : Array [1 .. MaxN] of List;
 Ans : Array [1 .. MaxN] of Longint;

PROCEDURE In_Data;
 Var
  i : Longint;
   Begin
    ReadLn(N, M, K, P);
     for i := 1 to K do
      begin
       ReadLn(A[i].s, A[i].f);
       A[i].t := i;
       A[i].b := false;
      end;
   End;

PROCEDURE qSort(L, R : Longint);
 Var
  i, j, x, y, temp : Longint;
   Begin
    i := L;
    j := R;
    x := A[(L + R) div 2].f;
    y := A[(L + R) div 2].s;
     Repeat
      while (A[i].f < x) or ((A[i].f = x) and (A[i].s < y)) do
       inc(i);
        while (A[j].f > x) or ((A[j].f = x) and (A[j].s > y)) do
         dec(j);
          if i <= j then
            begin
             temp   := A[i].s;
             A[i].s := A[j].s;
             A[j].s := temp;
             temp   := A[i].f;
             A[i].f := A[j].f;
             A[j].f := temp;
             temp   := A[i].t;
             A[i].t := A[j].t;
             A[j].t := temp;
             inc(i);
             dec(j);
            end;
     UntiL i > j;
      if L < j then
        qSort(L, j);
      if i < R then
        qSort(i, R);
   End;

PROCEDURE Solve;
 Var
  i, j, temp : Longint;
   Begin
    j := 1;
     while A[j].b and (j < K) do
      inc(j);
    if (j = K) and A[j].b then
      Exit;
    temp := 0;
     for i := j to K do
      if not A[i].b then
       if temp <= A[i].s then
         begin
          inc(Res);
          Ans[Res] := A[i].t;
          A[i].b := true;
          temp := A[i].f;
         end;
   End;

PROCEDURE Out_Data;
 Var
  i : Longint;
   Begin
    WriteLn(Res * P);
     for i := 1 to Res do
      Write(Ans[i], ' ');
   End;

PROCEDURE Run;
 Var
  i : Longint;
   Begin
    In_Data;
     if K > 1 then
      qSort(1, K);
      Res := 0;
     for i := 1 to M do
      Solve;
      Out_Data;
   End;

BEGIN
 Run;
END.
Re: I don't use heap, but I've got wa7. Please give me some contrtests. Thanks.
Послано Crash_access_violation 6 авг 2008 22:13
what idea in your solution? sory for my bad english

Edited by author 06.08.2008 22:14