http://acm.pku.edu.cn/JudgeOnline/problem?id=1203

Код:
{$I-,S-,Q-,R-}

const
  inf = '';
  ouf = '';
  maxn = 101000;
  maxm = 1010000;
  maxt = 24 * 60;

type integer = longint;

var d, num, time, arrive, last, start: array[0 .. maxn] of integer;
    tow, reach, leave: array[0 .. maxm] of integer;
    buf: array[0 .. 1 shl 20] of integer;
    c: array[1 .. maxt, 1 .. 2] of integer;
    n, len: integer;

procedure get(var t: integer);
var ch: char;
begin
  read(ch); t := ord(ch) - ord('0');
  read(ch); t := t * 10 + ord(ch) - ord('0');
  read(ch);
end;

procedure updata;
var i, j, k, m, t1, t2: integer;
begin
  readln(n); m := 0; len := 0;
  for i := 1 to n do begin
    start[i] := m;
    readln(k);
    for j := 1 to k do begin
      m := m + 1;
      get(t1); get(t2); leave[m] := t1 * 60 + t2 + 1;
      get(t1); get(t2); reach[m] := t1 * 60 + t2 + 1;
      if reach[m] > len then len := reach[m];
      readln(tow[m]);
    end;
    last[i] := m;
  end;
end;

var temp: integer;

procedure swap(var i, j: integer);
begin
  temp := i; i := j; j := temp;
end;

procedure keepup(k: integer);
begin
  while (k > 1) and (arrive[d[k]] < arrive[d[k shr 1]]) do begin
    swap(d[k], d[k shr 1]);
    num[d[k]] := k;
    num[d[k shr 1]] := k shr 1;
    k := k shr 1;
  end;
end;

procedure keepdown(t: integer);
var now, p: integer;
begin
  now := 0;
  while (t shl 1 <= len) and (now <> t) do begin
    now := t; p := now shl 1;
    if arrive[d[p]] < arrive[d[t]] then t := p; p := p + 1;
    if (p <= len) and (arrive[d[p]] < arrive[d[t]]) then t := p;
    if now <> t then begin
      swap(d[now], d[t]);
      num[d[now]] := now;
      num[d[t]] := t;
    end;
  end;
end;

procedure print(t: integer);
var k: integer;
begin
  k := (t - 1) div 60; t := t - k * 60 - 1;
  if k < 10 then write(0, k) else write(k); write(':');
  if t < 10 then write(0, t) else write(t); write(' ');
end;

procedure main;
var u, v, ans, nowtime: integer;
begin
  ans := 0;
  fillchar(time, sizeof(time), 0);
  for nowtime := maxt downto 1 do begin
    len := 1; d[1] := 1; num[1] := 1;
    time[1] := nowtime; arrive[1] := nowtime;
    while len > 0 do begin
      u := d[1]; len := len - 1;
      if len > 0 then begin
        d[1] := d[len + 1];
        num[d[1]] := 1;
        keepdown(1);
      end;
      while (start[u] < last[u]) and (leave[last[u]] >= arrive[u]) do begin
        v := tow[last[u]];
        if time[v] <> nowtime then begin
          time[v] := nowtime;
          arrive[v] := reach[last[u]];
          len := len + 1;
          d[len] := v; num[v] := len;
          keepup(len);
        end else if reach[last[u]] < arrive[v] then begin
          arrive[v] := reach[last[u]];
          keepup(num[v]);
        end;
        last[u] := last[u] - 1;
      end;
    end;
    if time[n] = nowtime then begin
      ans := ans + 1;
      c[ans, 1] := nowtime;
      c[ans, 2] := arrive[n];
    end;
  end;
  if ans = 0 then writeln(0) else begin
    v := ans; ans := 1;
    for u := 2 to v do
    if c[u, 2] < c[ans, 2] then begin
      ans := ans + 1;
      c[ans] := c[u];
    end;
    writeln(ans);
    for u := ans downto 1 do begin
      print(c[u, 1]);
      print(c[u, 2]);
      writeln;
    end;
  end;
end;

begin
  assign(input, inf); assign(output, ouf);
  settextbuf(input, buf);
  reset(input); rewrite(output);
  updata;
  main;
  close(input); close(output);
end.