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

Обсуждение задачи 1040. Авиакомпания

(TLE) Give me some hints! Help!
Послано Grebnov Ilya[ISPU] 31 мар 2003 14:54
Can you help me speed up my algorithm?

VAR
  N, M, I, A0, A1 : LongInt;
  Dep : ARRAY[1..50, 0..50] OF LongInt;
  Num : ARRAY[1..1225] OF LongInt;

  FUNCTION GCD(A, B : LongInt) : LongInt;
  BEGIN
    IF A = 0 THEN
      GCD := B
    ELSE
      GCD := GCD(B MOD A, A);
  END;

  PROCEDURE QSort(iLo, iHi : LongInt);
  VAR
    Lo, Hi, Mid, T : LongInt;
  BEGIN
    IF iLo >= iHi THEN Exit;
    Lo := iLo;
    Hi := iHi;
    Mid := Num[(Lo+Hi) DIV 2];
    REPEAT
      WHILE Num[Lo] > Mid DO Inc(Lo);
      WHILE Num[Hi] < Mid DO Dec(Hi);
      IF Lo <= Hi THEN
        BEGIN
          T := Num[Lo];
          Num[Lo] := Num[Hi];
          Num[Hi] := T;
          Inc(Lo);
          Dec(Hi);
        END;
    UNTIL Lo > Hi;
    IF Hi > iLo THEN QSort(iLo, Hi);
    IF Lo < iHi THEN QSort(Lo, iHi);
  END;

  FUNCTION Test : Boolean;
  VAR
    I, J, GCDTst, L, Max : LongInt;
    Ok : Boolean;
  BEGIN
    Ok := True;
    L := M+1;
    FOR I := 1 TO N DO
      IF Dep[I, 0] > 1 THEN
        BEGIN
          GCDTst := Num[Dep[I, 1]];
          Max := Dep[I, 1];
          FOR J := 2 TO Dep[I, 0] DO
            BEGIN
              GCDTst := GCD(Num[Dep[I, J]], GCDTst);
              IF Dep[I, J] > Max THEN Max := Dep[I, J];
            END;
          IF GCDTst <> 1 THEN
            BEGIN
              Ok := False;
              IF L < Max THEN L := Max;
            END;
        END;
    IF Ok THEN
      BEGIN
        WriteLn('YES');
        FOR I := 1 TO M-1 DO Write(Num[I], ' ');
        Write(Num[M]);
        Halt;
      END;
    QSort(L+1, M);
  END;

  FUNCTION Next : Boolean;
  VAR
    I, J, T : LongInt;
  BEGIN
    I := M;
    WHILE (I > 1) AND (Num[I-1] >= Num[I]) DO Dec(I);
    IF I > 1 THEN
      BEGIN
        J := M;
        WHILE (Num[I-1] >= Num[J]) DO Dec(J);
        T := Num[I-1];
        Num[I-1] := Num[J];
        Num[J] := T;
        FOR J := 0 TO (M-I+1) DIV 2-1 DO
          BEGIN
            T := Num[I+J];
            Num[I+J] := Num[M-J];
            Num[M-J] := T;
          END;
        Next := False;
        Exit;
      END;
    Next := True;
  END;

BEGIN
  ReadLn(N, M);
  FOR I := 1 TO M DO
    BEGIN
      ReadLn(A0, A1);
      Inc(Dep[A0, 0]);
      Dep[A0, Dep[A0, 0]] := I;
      Inc(Dep[A1, 0]);
      Dep[A1, Dep[A1, 0]] := I;
    END;
  FOR I := 1 TO M DO Num[I] := I;
  REPEAT
    Test;
  UNTIL Next;
  Write('NO');
END.
Just use heuristics :) (-)
Послано Dmitry 'Diman_YES' Kovalioff 31 мар 2003 17:37