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

Код:
program PKU1117;
{$I-, s-, q-, r-}

const maxn = 12;
  maxm = 200000;

type integer = longint;

var w, a, b: array[0..maxn] of integer;
    c: array[0..maxm] of integer;
    n, l, ans: integer;

procedure prepare;
var tmp: integer;
begin
  read(n);
  l := 0; tmp := n;
  while n > 0 do begin
    l := l + 1;
    w[l] := n mod 10;
    n := n div 10;
  end; n := tmp;
end;

var s1, st: string;

procedure addans;
var tmp, i: integer;
begin
  tmp := 0;
  for i := l downto 1 do tmp := tmp * 10 + a[i];
  str(tmp, st); str(n - tmp, s1);
  if length(s1) < length(st) then begin
    ans := ans + 1;
    c[ans] := tmp;
  end;
end;

procedure search(k, r, tmp: integer);
begin
  if k = 0 then begin
    if (r = 0) and (tmp = 0) then addans;
    exit;
  end;
  if r = 1 then begin
    tmp := tmp + w[k] - b[k];
    if tmp < 0 then exit;
    if (tmp > 0) and (tmp <= 10) then begin
      a[k] := tmp - 1; b[k - 1] := tmp - 1;
      search(k - 1, 1, 10);
      search(k - 1, 0, 10);
    end;
    if tmp < 10 then begin
      a[k] := tmp; b[k - 1] := tmp;
      search(k - 1, 1, 0);
      search(k - 1, 0, 0);
    end;
  end else begin
    tmp := tmp + w[k];
    a[k] := tmp shr 1; b[k] := a[k];
    search(k - 1, r, (tmp and 1) * 10);
  end;
end;

var temp: integer;

procedure sort(l, r: integer);
var i, j, mid: integer;
begin
  i := l; j := r; mid := c[(l + r) shr 1];
  while i <= j do begin
    while c[i] < mid do i := i + 1;
    while c[j] > mid do j := j - 1;
    if i <= j then begin
      temp := c[i]; c[i] := c[j]; c[j] := temp;
      i := i + 1; j := j - 1;
    end;
  end;
  if i < r then sort(i, r);
  if l < j then sort(l, j);
end;

procedure main;
var i, j: integer;
begin
  b[l] := 0; ans := 0;
  c[0] := -1;
  search(l, 1, 0);
  sort(1, ans);
  j := ans; ans := 0;
  for i := 1 to j do if c[i] > c[ans] then begin
    ans := ans + 1;
    c[ans] := c[i];
  end;
  writeln(ans);
  for i := 1 to ans do begin
    str(c[i], s1);
    str(n - c[i], st);
    while length(st) < length(s1) - 1 do st := '0' + st;
    writeln(s1, ' + ', st, ' = ', n);
  end;
end;

begin
  prepare;
  main;
end.