program ioi94day2prb2ver4(input, output, inp, out);
{ Tom Verhoeff, Eindhoven University of Technology }
{ Backtracking with sorted candidate list and branch-and-bound }

{ General Section }

const
  Test = true ;
  Trace = false ;

var 
  inp, out: text ;

procedure Init ;
  begin
  if Test then
    writeln('IOI''94 - Day 2 - Problem 2: The Buses') ;
  assign(inp, 'input.txt') ;
  reset(inp) ;
  assign(out, 'output.txt') ;
  rewrite(out) ;
  if Test then writeln('Initialized')
  end { Init } ;

procedure Fini ;
  begin
  close(inp) ;
  close(out)
  end { Fini } ;


{ Problem Specific Section }

type
  BusRoute = record
    first   : 0..29;
    interval: 1..59; { first < interval < 59 - first }
    howoften: 2..60; { howoften = (60 - first) div interval }
    end;

procedure WriteTimes(var f: text); 
  var i, j: integer;
  begin
  for i:=0 to 5 do
    for j:=0 to 9 do
      write(f, i:1) ;
  writeln(f) ;
  for i:=0 to 5 do
    for j:=0 to 9 do
      write(f, j:1) ;
  writeln(f)
  end { WriteTimes } ;

procedure GraphBusRoute(var f: text; b: BusRoute);
  var i: integer;
  begin
  with b do begin
    write(f, 1:first+1) ;
    i := first + interval ;
    while (i <= 59) do begin
      write(f, 1:interval) ;
      i := i + interval
      end { while } ;
    write(f, ' ':62-i+interval) ;
    writeln(f, '[', first:2, ',', interval:2, ',', howoften:2, ']')
    end { with }
  end { GraphBusRoute } ;

var
  s: integer; { s = sum a[0..59] }
  a: array[0..59] of integer; { a[t] = # unaccounted arrivals at time t }

procedure GraphUnaccounted(var f: text);
  var h, i, j: integer;
  begin
  WriteTimes(f) ;
  for i:=0 to 5 do
    for j:=0 to 9 do begin
      h := a[10*i+j] ;
      if (h = 0) then write(f, ' ')
      else if (h < 10) then write(f, h:1)
      else write(f, chr(ord('A') + h - 10))
      end { for j } ;
  writeln(f, '   total = ', s:1)
  end { GraphUnaccounted } ;

procedure ReadInput;
  { read input into s and a }
  var i, j: integer;
  begin
  if Test then writeln('Reading input') ;
  readln(inp, s) ;
  if Test then writeln('Number of stops = ', s:1) ;
  for i:=0 to 59 do a[i] := 0 ;
  for i:=1 to s do begin
    read(inp, j) ;
    inc(a[j])
    end { for i } ;
  readln(inp) ;
  if Test then begin GraphUnaccounted(out) ; writeln end
  end { ReadInput } ;

function Fits(b: BusRoute): boolean;
  { check whether b fits with a, that is, all arrivals of b occur in a }
  { global: a }
  var i, j: integer;
  begin
  with b do begin
    i := first ; j := 60 ;
    { bounded linear search for earliest a[first + k*interval] = 0 }
    while i < j do
      if a[i] <> 0 then i := i+interval
      else j := i ;
    Fits := (i >= 60)
    end { with }
  end { Fits } ;

var
  n: integer; { # candidate bus routes }
  c: array[0..899] of BusRoute; { c[0..n-1] are candidate bus routes }

procedure FindBusRoutes;
  { post: c[0..n-1] are all bus routes fitting with a } 
  { global: a, n, c }
  var f, i, j, k: integer; b: BusRoute;
  begin
  if Test then begin
    writeln('Finding candidate bus routes') ;
    WriteTimes(out)
    end { if } ;
  n := 0 ;
  for f:=0 to 29 do begin
    if a[f] <> 0 then begin
      for i:=f+1 to 59-f do begin
        with c[n] do begin
          first := f ;
          interval := i ;
          howoften := 1 + (59 - f) div i
          end { with c[n] } ;
        if Fits(c[n]) then begin
          if Test then GraphBusRoute(out, c[n]) ;
          { insert c[n] into c[0..n-1] to keep sorted on howoften }
          j := 0 ; k := n ;
          while j <> k do
            if c[k-1].howoften < c[k].howoften then begin
              b := c[k-1] ; c[k-1] := c[k] ; c[k] := b ; dec(k)
              end { then }
            else j := k ;
          inc(n)
          end { if }
        end { for i }
      end { if }
    end { for f } ;
  if Test then begin
    writeln('Number of candidate bus routes = ', n:1) ;
    if Trace then for j:=0 to n-1 do with c[j] do
      writeln(first:4, ' ', interval:2, ' ', howoften:2)
    end { if }
  end { FindBusRoutes } ;

type
  Schedule = array [0..16] of BusRoute;

procedure WriteSchedule(var f: text; sc: Schedule; len: integer);
  var i: integer;
  begin
  for i:=0 to len-1 do with sc[i] do
    writeln(f, first:2, ' ', interval:2) ;
  if Test then writeln(f, '-----')
  end { WriteSchedule } ;

var
  t: longint; { # schedules found so far }
  freq: array [1..17] of longint; { freq[p] = # schedules with p bus routes }
  p: integer; { # buses in partial schedule so far }
  m: integer; { # buses in best schedule so far }
  sched: Schedule; { sched[0..p-1] is schedule so far }
  best: Schedule; { best[0..m-1] is best schedule so far }

procedure WriteFrequencies(var f: text);
   var i: integer;
   begin
   writeln(f, 'Frequency table for schedule lengths:') ;
   write(f, '  Len:') ;
   for i := 1 to 17 do
     if freq[i] <> 0 then write(f, i:4) ;
   writeln(f, 'total':6) ;
   write(f, '   # :') ;
   for i := 1 to 17 do
     if freq[i] <> 0 then write(f, freq[i]:4) ;
   writeln(f, t:6)
   end { WriteFrequencies } ;

procedure ScheduleFound;
  { pre: p < m }
  { global: s, a, t, p, m, sched, best }
  begin
  if Test then begin
    inc(t) ;
    inc(freq[p]) ;
    WriteSchedule(out, sched, p)
    end { if } ;
  m := p ;
  best := sched ;
  if Test then begin
    writeln('Best schedule so far:') ;
    WriteSchedule(output, best, m)
    end { if }
  end { ScheduleFound } ;

procedure Use(b: BusRoute);
  { global: s, a, p, sched }
  var i: integer;
  begin
  sched[p] := b ;
  inc(p) ;
  with b do begin
    i := first ;
    while (i <= 59) do begin
      dec(a[i]) ;
      i := i+interval
      end { while } ;
    s := s - howoften
    end { with } ;
  if Trace then begin
    WriteSchedule(output, sched, p) ;
    GraphUnaccounted(output)
    end { if }
  end { Use } ;

procedure RemoveLast;
  { global: s, a, p, sched }
  var i: integer;
  begin
  dec(p) ;
  with sched[p] do begin
    i := first ;
    while (i <= 59) do begin
      inc(a[i]) ;
      i := i+interval
      end { while } ;
    s := s + howoften
    end { with }
  end { Remove } ;

procedure FindBestSchedule(k: integer);
  { global: s, a, n, c, p, sched, m, best }
  { Find all schedules sched[0..r-1] with p <= r < m such that  
    bus routes sched[0..p-1] are as given,        
    sched[p..r-1] accounts for a and uses only bus routes from c[k..n-1] }
  { pre: p < m }
  begin
  if s = 0 then { nothing left to account for }
    ScheduleFound
  else begin { try each candidate c[k..n-1] that fits }
    while (k < n) {c}and (c[k].howoften > s) do inc(k) ;
    while (k < n) {c}and (p + 1 + (s-1) div c[k].howoften < m) do begin
      if Fits(c[k]) then begin
        Use(c[k]) ;
        FindBestSchedule(k) ;
        RemoveLast
        end { if } ;
      inc(k)
      end { while }
    end { else }
  end { FindBestSchedule } ;

procedure ComputeAnswer;
  begin
  FindBusRoutes ;
  if Test then writeln('Finding schedules') ;
  for p:=1 to 16 do freq[p] := 0 ;
  t := 0 ; p := 0 ; m := 18 ;
  FindBestSchedule(0) ;
  if Test then begin
    writeln('Number of schedules = ', t:1) ;
    WriteFrequencies(out)
    end { if }
  end { ComputeAnswer } ;

procedure WriteOutput;
  var i: integer;
  begin
  if (m > 17) then
    writeln('More than 17 bus routes')
  else begin
    if Test then begin
      for i:=0 to m-1 do GraphBusRoute(out, best[i]) ;
      writeln('Smallest number of bus routes = ', m:1) ;
      WriteSchedule(output, best, m)
      end { if } ;
    WriteSchedule(out, best, m)
    end { else }
  end { WriteOutput } ;

begin
Init ;
ReadInput ;
ComputeAnswer ;
WriteOutput ;
Fini
end.
