NEERC/kequiv/tests/do14.dpr

   1 uses SysUtils;\r
   2 \r
   3 var f : array [0..10000000] 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   randseed := 23478432;\r
  15   for i := 1 to 50 do begin\r
  16     j := random (9999909) + 1;\r
  17     for k := 1 to 50 do \r
  18       f[j + k] := true;\r
  19   end;\r
  20 \r
  21   for i := 1 to 10 do\r
  22     for k := 1 to 9999999 do\r
  23       if f[k] then begin\r
  24         str (k, s);\r
  25         for j := 1 to length (s) do begin\r
  26           if s[j] = '1' then begin\r
  27             s[j] := '3'; add (s);\r
  28             s[j] := '7'; add (s);\r
  29             s[j] := '1';\r
  30           end;\r
  31           if s[j] = '3' then begin\r
  32             s[j] := '1'; add (s);\r
  33             s[j] := '7'; add (s);\r
  34             s[j] := '3';\r
  35           end;\r
  36           if s[j] = '7' then begin\r
  37             s[j] := '3'; add (s);\r
  38             s[j] := '7'; add (s);\r
  39             s[j] := '1';\r
  40           end;\r
  41           if s[j] = '2' then begin\r
  42             s[j] := '9'; add (s);\r
  43             s[j] := '2';\r
  44           end;\r
  45           if s[j] = '9' then begin\r
  46             s[j] := '2'; add (s);\r
  47             s[j] := '9';\r
  48           end;\r
  49           if s[j] = '4' then begin\r
  50             s[j] := '5'; add (s);\r
  51             s[j] := '6'; add (s);\r
  52             s[j] := '4';\r
  53           end;\r
  54           if s[j] = '5' then begin\r
  55             s[j] := '4'; add (s);\r
  56             s[j] := '6'; add (s);\r
  57             s[j] := '5';\r
  58           end;\r
  59           if s[j] = '6' then begin\r
  60             s[j] := '4'; add (s);\r
  61             s[j] := '5'; add (s);\r
  62             s[j] := '6';\r
  63           end;\r
  64         end;\r
  65       end;\r
  66 \r
  67   p := 0;\r
  68   for i := 1 to 1000000 do\r
  69     if f[i] <> f[i - 1] then begin\r
  70       if f[i] then begin inc (p); a[p] := i end else b[p] := i - 1;\r
  71     end;\r
  72   writeln (p);\r
  73   for i := 1 to p do\r
  74     writeln (a[i], ' ', b[i]);\r
  75 end.\r