NEERC/kequiv/tests/do09.dpr

   1 uses SysUtils;\r
   2 \r
   3 var f : array [0..1000000] of boolean;\r
   4     i, k, j, p : integer;\r
   5     s : string;\r
   6     a, b : array [1..10000] of integer;\r
   7 \r
   8 procedure add (s : string);\r
   9 begin\r
  10   f[strtoint (s)] := true;\r
  11 end;\r
  12 \r
  13 begin\r
  14   for i := 1 to 10 do\r
  15     f[random (999999) + 1] := true;\r
  16 \r
  17   for i := 1 to 1000 do\r
  18     for k := 1 to 999999 do\r
  19       if f[k] then begin\r
  20         str (k, s);\r
  21         for j := 1 to length (s) do begin\r
  22           if s[j] = '1' then begin\r
  23             s[j] := '3'; add (s);\r
  24             s[j] := '7'; add (s);\r
  25             s[j] := '1';\r
  26           end;\r
  27           if s[j] = '3' then begin\r
  28             s[j] := '1'; add (s);\r
  29             s[j] := '7'; add (s);\r
  30             s[j] := '3';\r
  31           end;\r
  32           if s[j] = '7' then begin\r
  33             s[j] := '3'; add (s);\r
  34             s[j] := '7'; add (s);\r
  35             s[j] := '1';\r
  36           end;\r
  37           if s[j] = '2' then begin\r
  38             s[j] := '9'; add (s);\r
  39             s[j] := '2';\r
  40           end;\r
  41           if s[j] = '9' then begin\r
  42             s[j] := '2'; add (s);\r
  43             s[j] := '9';\r
  44           end;\r
  45         end;\r
  46       end;\r
  47 \r
  48   p := 0;\r
  49   for i := 1 to 1000000 do\r
  50     if f[i] <> f[i - 1] then begin\r
  51       if f[i] then begin inc (p); a[p] := i end else b[p] := i - 1;\r
  52     end;\r
  53   writeln (p);\r
  54   for i := 1 to p do\r
  55     writeln (a[i], ' ', b[i]);\r
  56 end.\r