Описание
На остановке останавливаются автобусы одного или нескольких маршрутов. Человек пришел на автобусную остановку в 12:00 и находился на ней до 12:59, записывая все моменты прибытия автобусов за этот период с точностью до минуты. Известно, что:

  • в указанный период останавливались по крайней мере два автобуса каждого маршрута

  • автобусы одного маршрута прибывают с равными интервалами (через одинаковые промежутки времени)

  • количество маршрутов не превосходит 17

  • несколько автобусных маршрутов могут иметь одинаковые моменты прибытия и/или одинаковые интервалы

Задание
Требуется по записанным моментам прибытия определить наименьшее количество автобусных маршрутов, которые могут проходить через данную остановку, и график движения автобусов по этим маршрутам


Входные данные
В первой строке входного файла содержится целое число N - количество моментов времени, записанных человеком (1
N300). Во второй строке записаны сами моменты - N целых чисел (0N59), идущих в порядке неубывания

Выходные данные
Выведите в выходной файл график движения автобусов по маршрутам. Каждый маршрут записывается в отдельную строку и задается моментом прибытия первого автобуса и интервалом движения, заданным в минутах. Порядок вывода маршрутов не важен. В случае нескольких возможных решений следует выдать любое из них.


Например:

BUS.IN
17
0 3 5 13 13 15 21 26 27 29 37 39 39 45 51 52 53

BUS.OUT
0 13
3 12
5 8





Комментарии
Записанные моменты прибытия автобусов назовем отсчетами. Для ускорения перебора стоит по заданным отсчетам заранее посчитать все возможные маршруты, т.е. пары (m,d). где m - время прибытия первого автобуса, a d - интервал движения (m>d, m+d59). Наша задача - разбить все множество отсчетов на наименьшее число маршрутов

Вначале все отсчеты "свободны" т.е. ни один из них еще не отнесен ни к какому маршруту. На каждом шаге поиска разбиения мы находим первый свободный отсчет т и перебираем все возможные маршруты (m,d) с таким временем прибытия первого автобуса (если m>29, то заведомо нет ни одного нужного маршрута, и следует вернуться к предыдущему шагу). Для каждого маршрута проверяем, можно ли его выделить из отсчетов, оставшихся свободными. Если можно, то выделяем (т.е. относим соответствующие отсчеты к этому маршруту), увеличиваем счетчик маршрутов Cnt на единицу и рекурсивно переходим к следующему шагу. Если на очередном шаге все отсчеты оказались задействованными, то мы получили разбиение, и необходимо сравнить его с наилучшим из ранее найденных

К сожалению, этот простой алгоритм "не укладывается" во временные рамки, указанные в условии задачи. Поэтому надо думать о сокращении перебора Первое наблюдение Большинство маршрутов имеют длину 2, т.е. содержат два отсчета. Назовем такие маршруты большими парами. Оказывается, что для разбиения какого-либо множества отсчетов на большие пары можно применять "жадный" алгоритм: взять первый свободный отсчет и подобрать к нему первый подходящий для образования большой пары, затем опять взять первый свободный отсчет, проделать с ним то же самое и т.д. (докажите это самостоятельно). Если на каком-то шаге не удается найти подходящий свободный отсчет, то разбиение невозможно

Тем самым, приведенный выше алгоритм можно модифицировать следующим образом. Взяв первый свободный отсчет m (m
29), мы пытаемся либо отнести его к одному из маршрутов (m,d) длины не менее 3 (m+2d59), либо "оставить на потом" (для больших пар), увеличивая счетчик больших пар PCnt на единицу. Если на каком-то шаге число оставшихся свободных отсчетов Rem равно 2·РСnt, то пытаемся разбить их на большие пары с помощью "жадного" алгоритма

Второе наблюдение. Пусть к очередному шагу нами уже построено Cnt маршрутов, а первый свободный отсчет - m (m
29). Все маршруты, которые мы построим в дальнейшем, будут иметь длину не более L=[60/(m+1)]. Следовательно, если число Cnt+PCnt+[(Rem-2·PCnt)/L] больше или равно количеству маршрутов Мin в наилучшем из найденных разбиений, то эту "ветку" перебора можно не рассматривать (здесь [х] означает наименьшее целое число, большее или равное х). В начале работы программы нужно установить Min равным 18, т.к. известно, что число маршрутов в наилучшем разбиении не превосходит 17




Решение

{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+}

{$M 65520,0,655360}
 
Program Bus;
 
Const T=59;
      NMax=300;
      MaxRoute=17;
      MaxTime=Round(9*18.2);
 
Type Times=Set of 0..T;
     O=array[0..T] of Integer;
     TCan=Record
            Span,Numb:Integer;
            Route:Times
          End;
 
Var N,Min,Cnt,Res,NumP:Integer;
    Go:array[0..NMax] of Integer;
    Can:array[0..T,1..T+1] of TCan;
    Numb:O;
    Sol,SSol:array[1..NMax] of Record
                                 Time,Span:Integer
                               End;
    Count:array[0..T] of Integer;
    S:Times;
    SortR:array[1..NMax] of Integer;
    Time:Longint absolute $0000:$046C;
    breakTime : Longint;
    Succ:array[0..T,1..T] of Integer;
    Pair:array[0..T-1] of Integer;
 
Procedure Init;
Var i:Integer;
    TT:array[0..T] of Boolean;
 
  Procedure FillCan;
  Var i,j,k,Gop:Integer;
      S:Times;
  Begin
    FillChar(Can,SizeOf(Can),0);
    FillChar(Count,SizeOf(Count),0);
    For i:=0 to Go[N]-1 do
      For j:=i+1 to Go[N] do
        If (2*i-j<0) or not TT[2*i-j] then
            Begin
              k:=1;
              S:=[];
              Gop:=j-i;
              While (i+k*Gop<=Go[N]) and TT[i+k*Gop] do
                Begin
                  Include(S,i+k*Gop);
                  inc(k)
                End;
 
              If i+k*Gop>Go[N] then
                Begin
                  Inc(Count[i]);
                  Can[i,Count[i]].Span:=Gop;
                  Can[i,Count[i]].Route:=S;
                  Can[i,Count[i]].Numb:=
                    (Go[N]-i) div Gop+1
                End
            End;
  End(*FillCan*);
 
  Procedure FillSortR;
  Var i,j,t:Integer;
  Begin
    FillChar(SortR,SizeOf(SortR),0);
    For i:=1 to N do
      SortR[i]:=i;
 
    For i:=1 to N-1 do
      For j:=i+1 to N do
        If Can[Go[SortR[i]],1].Numbthen
          Begin
            t:=SortR[i];
            SortR[i]:=SortR[j];
            SortR[j]:=t
          End;
  End(*FillSortR*);
 
  Procedure SortCan;
  Var i,j,k:Integer;
      T1:TCan;
  Begin
    For i:=0 to T-1 do
      For j:=1 to Count[i]-1 do
        For k:=j+1 to Count[i] do
          If Can[i,j].Numbthen
            Begin
              T1:=Can[i,j];
              Can[i,j]:=Can[i,k];
              Can[i,k]:=T1
            End;
  End(*SortCan*);
 
  Procedure FillSucc;
  Var i,j,k:Integer;
  Begin
    FillChar(Succ,SizeOf(Succ),0);
    For i:=0 to T-1 do
      If Count[i]<>0 then
        Begin
          j:=1;
          k:=1;
          While k<=Count[i] do
            Begin
              k:=j+1;
              While (k<=Count[i]) and
                    (Can[i,j].Numb=Can[i,k].Numb) do
                inc(k);
              Succ[i,Can[i,j].Numb]:=k;
              j:=k
            End
        End;
  End(*FillSuc*);
 
  Procedure FillPair;
  Var i,j:Integer;
  Begin
    For i:=0 to T-1 do
      For j:=1 to Count[i] do
        If (Can[i,j].Numb=2) and (i-Can[i,j].Span<0) and 
           (2*(i+Can[i,j].Span)-i>59) then
          Begin
            Pair[i]:=j;
            Break
          End
  End(*FillPair*);
 
Begin
  Assign(input,'bus.in');   ReSet(input);
  Assign(output,'bus.out'); ReWrite(output);
 
  Read(N);
  FillChar(Go,SizeOf(Go),0);
  Go[0]:=-1;
  FillChar(TT,SizeOf(TT),False);
  FillChar(Numb,SizeOf(Numb),0);
  For i:=1 to N do
    Begin
      Read(Go[i]);
      TT[Go[i]]:=true;
      Inc(Numb[Go[i]]);
    End;
 
  FillCan; SortCan;
  FillSucc;
  FillPair;
  FillSortR;
  Cnt:=0;
  Min:=MaxRoute+1;
  S:=[];
  Res:=N;
  NumP:=0;
  breakTime := Time + maxTime;
End(*Init*);
 
Procedure Change(Down,Span:Integer);
Var i:integer;
Begin
  For i:=0 to (Go[N]-Go[Down]) div Span do
    Begin
      Dec(Numb[Go[Down]+i*Span]);
      If Numb[Go[Down]+i*Span]=0 then
        Include(S,Go[Down]+i*Span);
    End;
  Dec(Res,(Go[N]-Go[Down]) div Span+1)
End(*Change*);
 
Function NeedRoute(Res,K,Down:Integer):Integer;
Var i,j,Cnt,Route:integer;
Label Ex;
Begin
  Route:=0;
  Cnt:=0;
  For i:=1 to Numb[Go[K]] do
    Begin
      Inc(Route);
      Inc(Cnt,Can[Go[k],Down].Numb);
    End;
 
  If Cntthen
    For i:=1 to N do
      If SortR[i]>K then
        For j:=1 to Numb[Go[SortR[i]]] do
          Begin
            Inc(Route);
            Inc(Cnt,Can[Go[SortR[i]],1].Numb);
            If Cnt>=Res then
              Goto Ex
          End;
 
  Ex: NeedRoute:=Route
End(*NeedRoute*);
 
Var Fl:boolean;
    KK:integer;
 
Procedure Pairs;
Var i,j,k,Cnt_:Integer;
Begin
  k:=1;
  Cnt_:=Cnt;
  Repeat
    While (k<=N) and (Numb[Go[k]]=0) do
      Inc(k);
 
    If k>N then
      Begin
        If Res=0 then
          Begin
            SSol:=Sol;
            Min:=Cnt;
            Cnt:=Cnt_;
            Exit
          End
      End;
 
    i:=Pair[Go[k]];
    If i=0 then
      Begin
        Cnt:=Cnt_;
        Exit
      End;
 
    While (i<=Count[Go[k]]) and
          (Numb[Go[k]+Can[Go[k],i].Span]=0) do
      Inc(i);
 
    If i>Count[Go[k]] then
      Begin
        Cnt:=Cnt_;
        Exit
      End;
 
    Inc(Cnt);
    Sol[Cnt].Time:=Go[k];
    Sol[Cnt].Span:=Can[Go[k],i].Span;
    Dec(Numb[Go[k]]);
    Dec(Numb[Go[k]+Can[Go[k],i].Span]);
    Dec(Res,2)
  Until False
End(*Pairs*);
 
Procedure Solve(k,pred:integer);
Var Numb_:O;
    S_:Times;
    i,Res_,Down:Integer;
Begin
  If Time>=breakTime then Exit;
 
  If Res<=2*NumP then
    Begin
      If (Res=2*Nump) and (Cnt+NumP) then
        Pairs
      Else
        If Res=0 then
          Begin
            SSol:=Sol;
            Min:=Cnt
          End;
      Exit;
    End;
 
  i:=k;
  While (k<=N) and (Numb[Go[k]]=0) do
    inc(k);
 
  If k>N then
    Exit;
 
  If Go[k]=Go[i-1] then
    Down:=Pred
  Else
    Down:=1;
 
  Numb_:=Numb;
  S_:=S;
  Res_:=Res;
  Fl:=False;
  Inc(Cnt);
  i:=Down;
  While i<=Count[Go[k]] do
    Begin
      If (i=Down) or (Can[Go[k],i].Numb<>Can[Go[k],i-1].Numb) then
        If Cnt+NumP+NeedRoute(Res-2*NumP,k,i)-1>=Min then
           Begin
             Dec(Cnt);
             If i=Down then
               Begin
                 Fl:=true;
                 KK:=K
               End;
             Exit
           End;
 
      If i=Pair[Go[k]] then
        Begin
          inc(NumP);
          Dec(Cnt);
          Solve(k+1,i);
          dec(NumP);
          Exit
        End;
 
      If S*Can[Go[k],i].Route=[] then
        Begin
          Sol[Cnt].Time:=Go[k];
          Sol[Cnt].Span:=Can[Go[k],i].Span;
          Change(k,Can[Go[k],i].Span);
          Solve(k+1,i);
          S:=S_;
          Numb:=Numb_;
          Res:=Res_;
          If Fl and (Go[KK]then
            Begin
              i:=Succ[Go[k],Can[Go[k],i].Numb]-1;
              Fl:=False
            End
        End;
      inc(i)
    End;
  Dec(Cnt)
End(*Solve*);
 
Procedure Done;
Var i:Integer;
    L:Longint;
Begin
  For i:=1 to Min do
    Writeln(SSol[i].Time,' ',SSol[i].Span);
 
  Close(input);
  Close(output);
End(*Done*);
 
BEGIN
  Init;
  Solve(1,0);
  Done
END.

 




© Особенности национальных задач по информатике