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

Код:
program PKU1186;
{$i-, s-, q-, r-}

const maxn = 3;
  modes = 4012301;
  more = maxlongint - maxlongint mod modes;

type integer = longint;

var h, c, num, next: array[0 .. modes] of integer;
    a, b: array[1 .. maxn] of integer;
    n, l, tot: integer;

procedure add(k: integer);
var r, tmp: integer;
begin
  if k < 0 then r := (k + more) mod modes else r := k mod modes;
  tmp := h[r];
  while tmp <> 0 do begin
    if num[tmp] = k then begin
      inc(c[tmp]);
      exit;
    end;
    tmp := next[tmp];
  end;
  tot := tot + 1;
  num[tot] := k; c[tot] := 1;
  next[tot] := h[r]; h[r] := tot;
end;

function find(k: integer): integer;
var tmp: integer;
begin
  if k < 0 then tmp := h[(k + more) mod modes] else tmp := h[k mod modes];
  while tmp <> 0 do begin
    if num[tmp] = k then exit(c[tmp]);
    tmp := next[tmp];
  end;
  find := 0;
end;

function calc(p, q: integer): integer;
begin
  if q = 1 then calc := p else
  if q and 1 = 0 then calc := sqr(calc(p, q shr 1))
  else calc := sqr(calc(p, q shr 1)) * p;
end;

var m: integer;

procedure prepare;
var i, j, k, now: integer;
begin
  fillchar(h, sizeof(h), 0);
  readln(n); readln(l);
  if n > 3 then m := 3 else m := n;
  for i := 1 to m do read(a[i], b[i]);
  tot := 0; now := 0;
  for i := 1 to l do begin
    now := now + a[1] * calc(i, b[1]);
    if m > 1 then
      for j := 1 to l do begin
        now := now + a[2] * calc(j, b[2]);
        if m > 2 then
          for k := 1 to l do add(now + a[3] * calc(k, b[3]))
        else add(now);
        now := now - a[2] * calc(j, b[2]);
      end
    else add(now);
    now := now - a[1] * calc(i, b[1]);
  end;
end;

var ans: integer;

procedure main;
var i, j, k, now: integer;
begin
  ans := 0;
  if n > 3 then begin
    m := n - 3;
    for i := 1 to m do read(a[i], b[i]);
    now := 0;
    for i := 1 to l do begin
      now := now - a[1] * calc(i, b[1]);
      if m > 1 then
        for j := 1 to l do begin
          now := now - a[2] * calc(j, b[2]);
          if m > 2 then
            for k := 1 to l do ans := ans + find(now - a[3] * calc(k, b[3]))
          else ans := ans + find(now);
          now := now + a[2] * calc(j, b[2]);
        end
      else ans := ans + find(now);
      now := now + a[1] * calc(i, b[1]);
    end;
  end else ans := find(0);
  writeln(ans);
end;

begin
  prepare;
  main;
end.