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

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

const
  inf = '';
  ouf = '';
  maxn = 101;
  none = maxlongint shr 1;

type integer = longint;

var cost: array[1..maxn, 1..maxn] of integer;
    lev, dis: array[1..maxn] of integer;
    x: array[1..maxn] of boolean;
    s, n, m: integer;

function min(i, j: integer): integer;
begin
  if i < j then min := i else min := j;
end;

procedure prepare;
var i, j, u, p, k: integer;
begin
  read(m, n);
  s := n + 1;
  for i := 1 to s do
    for j := 1 to s do
      cost[i, j] := none;
  for i := 1 to n do begin
    read(p, lev[i], k);
    cost[s, i] := p;
    for j := 1 to k do begin
      read(u, p);
      cost[u, i] := p;
    end;
  end;
end;

function dij(low: integer): integer;
var u, i: integer;
begin
  for i := 1 to n do dis[i] := none; dis[s] := 0;
  for i := 1 to n do x[i] := (lev[i] >= low) and (lev[i] - low <= m);
  u := s;
  while x[1] do begin
    x[u] := false;
    for i := 1 to n do if x[i] then dis[i] := min(dis[i], dis[u] + cost[u, i]);
    u := 0;
    for i := 1 to n do if x[i] and ((u = 0) or (dis[i] < dis[u])) then u := i;
  end;
  dij := dis[1];
end;

procedure main;
var i, ans: integer;
begin
  ans := none;
  for i := 1 to n do ans := min(ans, dij(lev[i]));
  writeln(ans);
end;

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