Rare numbers

Rare numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Definitions and restrictions

Rare   numbers are positive integers   n   where:

•   n   is expressed in base ten
•   r   is the reverse of   n     (decimal digits)
•   n   must be non-palindromic   (n ≠ r)
•   (n+r)   is the   sum
•   (n-r)   is the   difference   and must be positive
•   the   sum   and the   difference   must be perfect squares

Task

•   find and show the first   5   rare   numbers
•   find and show the first   8   rare   numbers       (optional)
•   find and show more   rare   numbers                (stretch goal)

Show all output here, on this page.

References

•   an   OEIS   entry:   A035519          rare numbers.
•   an   OEIS   entry:   A059755   odd rare numbers.
•   planetmath entry:   rare numbers.     (some hints)
•   author's  website:   rare numbers   by Shyam Sunder Gupta.     (lots of hints and some observations).

Go

As in the case of the REXX entry, this takes into account all the hints within Shyam Sunder Gupta's webpage. It also makes use of his observation that no rare number below 10^20 ends in 3 and uses a bit arithmetic trick to further filter out numbers that cannot be perfect squares and thereby avoid the expensive math.Sqrt operation.

Despite all this, it's still pretty slow polishing off the first five rare numbers in about 1.1 seconds but taking almost 19 minutes to find the next three. Timings are for an Intel Core i7-8565U machine. <lang go>package main

import (

   "fmt"
   "math"
   "time"

)

const (

   maxCount  = 8
   maxDigits = 12
   qi        = maxDigits - 1 // index of last digit

)

func toUint64(digits []int, ai int, reverse bool) uint64 {

   sum := uint64(0)
   if !reverse {
       for i := ai; i < maxDigits; i++ {
           sum = sum*10 + uint64(digits[i])
       }
   } else {
       for i := qi; i >= ai; i-- {
           sum = sum*10 + uint64(digits[i])
       }
   }
   return sum

}

func sumDigits(n uint64) uint64 {

   var sum uint64
   for n > 0 {
       d := n % 10
       sum += d
       n /= 10
   }
   return sum

}

func sumDigitSlice(digits []int, ai int) uint64 {

   sum := 0
   for i := ai; i < maxDigits; i++ {
       sum += digits[i]
   }
   return uint64(sum)

}

func digRoot(n uint64) int {

   for n > 9 {
       n = sumDigits(n)
   }
   return int(n)

}

// 'inc' assumed to be <= 10 func add(digits []int, ai, inc int) int {

   for i := qi; i >= ai-1; i-- {
       q := digits[i]
       q += inc
       if q < 10 {
           digits[i] = q
           if i < ai {
               return i
           } else {
               return ai
           }
       } else {
           digits[i] = q - 10
           inc = 1
       }
   }
   return ai

}

func possibleSquare(n uint64) bool {

   if 0x202021202030213&(1<<(n&63)) != 0 {
       return true
   }
   return false

}

func commatize(n uint64) string {

   s := fmt.Sprintf("%d", n)
   le := len(s)
   for i := le - 3; i >= 1; i -= 3 {
       s = s[0:i] + "," + s[i:]
   }
   return s

}

func main() {

   start := time.Now()
   digits := make([]int, maxDigits)
   ai := maxDigits - 2 // index of first non-zero digit in slice
   digits[ai] = 2      // start from 20 say
   count := 0
   fmt.Printf("The first %d rare numbers are:\n", maxCount)

outer:

   for {
       a := digits[ai]
       switch a {
       case 2, 4:
           ai = add(digits, ai, 10)
       case 6:
           ai = add(digits, ai, 5)
       case 8:
           switch digits[qi] {
           case 2:
               ai = add(digits, ai, 5)
           case 7:
               ai = add(digits, ai, 1)
           case 8:
               ai = add(digits, ai, 4)
           }
       }
       a = digits[ai]
       if a%2 == 1 {
           for i := qi - 1; i > ai; i-- {
               digits[i] = 0
           }
           switch a {
           case 1:
               digits[ai], digits[qi] = 2, 2
           case 3:
               digits[ai], digits[qi] = 4, 0
           case 5:
               digits[ai], digits[qi] = 6, 0
           case 7:
               digits[ai], digits[qi] = 8, 2
           case 9:
               digits[ai], digits[qi] = 0, 2
               ai--
               digits[ai] = 2
               a = 2
           }
       }
       b, p := digits[ai+1], digits[qi-1]
       switch a {
       case 2:
           if b != p {
               continue
           }
       case 4:
           if (b-p)%2 != 0 {
               continue
           }
       case 6:
           if (b-p)%2 == 0 {
               continue
           }
       case 8:
           switch digits[qi] {
           case 2:
               if b+p != 9 {
                   continue
               }
           case 3:
               if b == p || (b > p && (b-p) != 7) || (b < p && (b-p) != -3) {
                   continue
               }
           case 7:
               if (b > 1 && (b+p) != 11) || (b < 1 && (b+p) != 1) {
                   continue
               }
           case 8:
               if b != p {
                   continue
               }
           }
       }
       s := sumDigitSlice(digits, ai)
       dr := digRoot(s)
       if dr != 2 && dr != 5 && dr != 8 && dr != 9 {
           continue
       }
       n := toUint64(digits, ai, false)
       r := toUint64(digits, ai, true)
       if n <= r || !possibleSquare(n+r) || !possibleSquare(n-r) {
           continue
       }
       for _, x := range [2]uint64{n + r, n - r} {
           z := x % 10
           if z == 2 || z == 3 || z == 7 || z == 8 {
               continue outer
           }
           y := (x / 10) % 10
           switch z {
           case 0:
               if y != 0 {
                   continue outer
               }
           case 5:
               if y != 2 {
                   continue outer
               }
           case 6:
               if y%2 == 0 {
                   continue outer
               }
           case 1, 4, 9:
               if y%2 == 1 {
                   continue outer
               }
           }
           dr = digRoot(x)
           if dr != 1 && dr != 4 && dr != 7 && dr != 9 {
               continue outer
           }
       }
       fn, fr := float64(n), float64(r)
       sr := uint64(math.Sqrt(fn + fr))
       if sr*sr != n+r {
           continue
       }
       sr = uint64(math.Sqrt(fn - fr))
       if sr*sr != n-r {
           continue
       }
       count++
       fmt.Printf("  %d:  %15s\n", count, commatize(n))
       if count == maxCount {
           break
       }
   }
   fmt.Printf("\nTook %s\n", time.Since(start))

}</lang>

Output:

The first 8 rare numbers are:
  1:               65
  2:          621,770
  3:      281,089,082
  4:    2,022,652,202
  5:    2,042,832,002
  6:  868,591,084,757
  7:  872,546,974,178
  8:  872,568,754,178

Took 18m53.611055816s

REXX

Most of the hints (properties of rare numbers) within Shyam Sunder Gupta's   webpage   have been incorporated in this
REXX program and the logic is now expressed within the list of   AB...PQ   (abutted numbers within the   @g   list). <lang rexx>/*REXX program to calculate and display an specified amount of rare numbers. */ numeric digits 20; w= digits() + digits() % 3 /*ensure enough decimal digs for calcs.*/ parse arg many start . /*obtain optional argument from the CL.*/ if many== | many=="," then many= 5 /*Not specified? Then use the default.*/ @g= 2002 2112 2222 2332 2442 2552 2662 2772 2882 2992 4010 4030 4050 4070 4090 4100 4120 ,

   4140 4160 4180 4210 4230 4250 4270 4290 4300 4320 4340 4360 4380 4410 4430 4450 4470 ,
   4490 4500 4520 4540 4560 4580 4610 4630 4650 4670 4690 4700 4720 4740 4760 4780 4810 ,
   4830 4850 4870 4890 4900 4920 4940 4960 4980 6010 6015 6030 6035 6050 6055 6070 6075 ,
   6090 6095 6100 6105 6120 6125 6140 6145 6160 6165 6180 6185 6210 6215 6230 6235 6250 ,
   6255 6270 6275 6290 6295 6300 6305 6320 6325 6340 6345 6360 6365 6380 6385 6410 6415 ,
   6430 6435 6450 6455 6470 6475 6490 6495 6500 6505 6520 6525 6540 6545 6560 6565 6580 ,
   6585 6610 6615 6630 6635 6650 6655 6670 6675 6690 6695 6700 6705 6720 6725 6740 6745 ,
   6760 6765 6780 6785 6810 6815 6830 6835 6850 6855 6870 6875 6890 6895 6900 6905 6920 ,
   6925 6940 6945 6960 6965 6980 6985 8007 8008 8017 8027 8037 8047 8057 8067 8077 8087 ,
   8092 8097 8107 8117 8118 8127 8137 8147 8157 8167 8177 8182 8187 8197 8228 8272 8297 ,
   8338 8362 8387 8448 8452 8477 8542 8558 8567 8632 8657 8668 8722 8747 8778 8812 8837 ,
   8888 8902 8927 8998
        /* [↓]─────────────────boolean arrays are used for checking for digit presence.*/

@dr.=0; @dr.2= 1; @dr.5=1 ; @dr.8= 1; @dr.9= 1 /*rare # must have these digital roots.*/ @ps.=0; @ps.2= 1; @ps.3= 1; @ps.7= 1; @ps.8= 1 /*perfect squares must end in these.*/ @149.=0; @149.1=1; @149.4=1; @149.9=1 /*values for Z that need a even Y. */

1. = 0 /*the number of rare numbers (so far)*/

@odd.=0; do i=-9 by 2 to 9; @odd.i=1; end /* " odd " " " " */ @gen.=0; do i=1 for words(@g); parse value word(@g, i) with a 2 b 3 p 4 q

           @gen.a.b.p.q= 1                      /*# AB···PQ  could be a good rare value*/
           end   /*i*/                          /* '↑'  other values can't be rare #'s.*/
                                                /*N>10, because 1 dig #s ≡ palindromic.*/
   do n=10;   parse var n  a 2 b 3  -2 p +1 q /*get 1st\2nd\penultimate\last digits. */
   if @odd.a  then do;  n=n+10**(length(n)-1)-1 /*bump N so next N starts with even dig*/
                        iterate                 /*let REXX do its thing with  DO  loop.*/
                   end                          /* {it's allowed to modify a DO index} */
   if \@gen.a.b.p.q  then iterate               /*can  N  not be a rare AB···PQ number?*/
   r= reverse(n)                                /*obtain the reverse of the number  N. */
   if r>n   then iterate                        /*Difference will be negative?  Skip it*/
   if n==r  then iterate                        /*Palindromic?   Then it can't be rare.*/
                            /* ┌──────────────────<── the  double quote   ()   means to
                               ↓                      parse at the end─of─value (for D)*/
   d= n-r;   parse var  d       -2  y  +1  z  /*obtain the last 2 digs of difference.*/
   if @ps.z  then iterate                       /*Not 0, 1, 4, 5, 6, 9? Not perfect sq.*/

      select
      when z==0   then if y\==0    then iterate /*Does Z = 0?   Then  Y  must be zero. */
      when z==5   then if y\==2    then iterate /*Does Z = 5?   Then  Y  must be two.  */
      when z==6   then if y//2==0  then iterate /*Does Z = 6?   Then  Y  must be odd.  */
      otherwise        if @149.z   then if y//2  then iterate /*Z=1,4,9? Y must be even*/
      end   /*select*/

   s= n+r;   parse var  s    -2  y  +1  z     /*obtain the last two digits of the sum*/
   if @ps.z  then iterate                       /*Not 0, 2, 5, 8, or 9? Not perfect sq.*/

      select
      when z==0   then if y\==0    then iterate /*Does Z = 0?   Then  Y  must be zero. */
      when z==5   then if y\==2    then iterate /*Does Z = 5?   Then  Y  must be two.  */
      when z==6   then if y//2==0  then iterate /*Does Z = 6?   Then  Y  must be odd.  */
      otherwise        if @149.z   then if y//2  then iterate /*Z=1,4,9? Y must be even*/
      end   /*select*/

   $= a + b                                     /*a head start on figuring digital root*/
              do k=3  for length(n) - 2         /*now, process the rest of the digits. */
              $= $ + substr(n, k, 1)            /*add the remainder of the digits in N.*/
              end   /*k*/
                                                /*This REXX pgm uses 20 decimal digits.*/
      do while $>9                              /* [◄]  Algorithm is good for 111 digs.*/
      if $>9  then $= left($,1) + substr($,2,1) + substr($,3,1,0)     /*>9?  Reduce it.*/
      end   /*while*/

   if \@dr.$             then iterate           /*Doesn't have good digital root?  Skip*/
   if iSqrt(s)**2 \== s  then iterate           /*Not a perfect square?  Then skip it. */
   if iSqrt(d)**2 \== d  then iterate           /* "  "    "       "       "    "   "  */
   #= # + 1                                     /*bump the counter of  rare  numbers.  */
   say right( th(#), length(#) + 9)       ' rare number is:  '       right( commas(n), w)
   if #>=many  then leave                       /* [↑]  W:  the width of # with commas.*/
   end   /*n*/

exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ commas: parse arg _; do jc=length(_)-3 to 1 by -3; _=insert(',', _, jc); end; return _ th: parse arg th;return th||word('th st nd rd',1+(th//10)*(th//100%10\==1)*(th//10<4)) /*──────────────────────────────────────────────────────────────────────────────────────*/ iSqrt: parse arg x; $= 0; q= 1; do while q<=x; q=q*4; end

         do while q>1; q=q%4; _= x-$-q;  $= $%2;  if _>=0  then do;      x=_;  $=$+q; end
         end   /*while q>1*/;                     return $</lang>

output   when using the input of:     8

       1st  rare number is:                           65
       2nd  rare number is:                      621,770
       3rd  rare number is:                  281,089,082
       4th  rare number is:                2,022,652,202
       5th  rare number is:                2,042,832,002
       6th  rare number is:              868,591,084,757
       7th  rare number is:              872,546,974,178
       8th  rare number is:              872,568,754,178