   Take an integer n, greater than zero.
   Form the next n of its series by reversing the digits of the current n and adding the result to the current n.
   Stop when n becomes palindromic - i.e. the digits of n in reverse order == n.


The above recurrence relation when applied to most starting numbers n = 1, 2, ... terminates in a palindrome quite quickly.



Example

If n0 = 12 we get

       12
       12 +  21 =  33,   a palindrome!

And if n0 = 55 we get

       55
       55 +  55 = 110
      110 + 011 = 121,   a palindrome!

Notice that the check for a palindrome happens   after   an addition.



Some starting numbers seem to go on forever; the recurrence relation for 196 has been calculated for millions of repetitions forming numbers with millions of digits, without forming a palindrome.

These numbers that do not end in a palindrome are called Lychrel numbers.

For the purposes of this task a Lychrel number is any starting number that does not form a palindrome within 500 (or more) iterations.



Seed and related Lychrel numbers

Any integer produced in the sequence of a Lychrel number is also a Lychrel number.

In general, any sequence from one Lychrel number might converge to join the sequence from a prior Lychrel number candidate; for example the sequences for the numbers 196 and then 689 begin:

        196
        196 +    691 =   887
        887 +    788 =  1675
       1675 +   5761 =  7436
       7436 +   6347 = 13783
      13783 +  38731 = 52514
      52514 +  41525 = 94039
       ...


        689
        689 +    986 =  1675
       1675 +   5761 =  7436
       ...

So we see that the sequence starting with 689 converges to, and continues with the same numbers as that for 196.

Because of this we can further split the Lychrel numbers into true Seed Lychrel number candidates, and Related numbers that produce no palindromes but have integers in their sequence seen as part of the sequence generated from a lower Lychrel number.



Task

   Find the number of seed Lychrel number candidates and related numbers for n in the range 1..10000 inclusive. (With that iteration limit of 500).
   Print the number of seed Lychrels found; the actual seed Lychrels; and just the number of relateds found.
   Print any seed Lychrel or related number that is itself a palindrome.


Show all output here.



References

   What's special about 196? Numberphile video.
   A023108 Positive integers which apparently never result in a palindrome under repeated applications of the function f(x) = x + (x with digits reversed).
   Status of the 196 conjecture? Mathoverflow.


 
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Lychrel Numbers V1.0                              '
'                                                   '
' Developed by A. David Garza Marín in QB64 for     '
' RosettaCode. December 2, 2016.                    '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
 
OPTION _EXPLICIT  ' Change to OPTION EXPLICIT in VB-DOS or PDS 7.1. Remove in QB and QBASIC
 
' SUBs and FUNCTIONs
DECLARE SUB doAddLychrel (WhichNumber AS LONG)
DECLARE SUB doAddRelated (WhichNumber AS LONG)
DECLARE SUB doFindLychrelPalyndromes ()
DECLARE FUNCTION CalculateMaxRes& (WhichNumber AS LONG)
DECLARE FUNCTION IsLychrel% (WhichNumber AS LONG)
DECLARE FUNCTION Reverse$ (WhatToReverse AS STRING)
DECLARE FUNCTION Sum$ (N1 AS STRING, N2 AS STRING)
 
' Var
DIM sN1 AS STRING, sN2 AS STRING, sLychrel AS STRING
DIM i AS LONG, iLychrel AS INTEGER, iCount AS INTEGER, l AS INTEGER
DIM c1 AS INTEGER, l1 AS INTEGER, c2 AS INTEGER, l2 AS INTEGER
DIM lMC AS LONG, lT AS LONG
DIM lLC AS LONG, lRL AS LONG, lPN AS LONG
CONST MaxNumbers = 10000, MaxIterations = 500, False = 0, True = NOT False
 
' Init
REDIM lLC(1, 0) AS LONG, lRL(0) AS LONG, lPN(0) AS LONG
lMC = CalculateMaxRes&(MaxNumbers)
lT = TIMER
 
' ------------------ Main program -----------------------------------------
CLS
PRINT "Lychrel Numbers 1.0"
PRINT
PRINT "Calculating numbers from 1 to"; MaxNumbers;
c1 = POS(1)
l1 = CSRLIN
COLOR 7 + 16: PRINT "...": PRINT
COLOR 7
c2 = POS(1)
l2 = CSRLIN
FOR i = 1 TO MaxNumbers
  sN1 = LTRIM$(STR$(i))
  sN2 = Reverse$(sN1)
  iCount = 0
  LOCATE l2, 1: PRINT "Analyzing number"; i;
  COLOR 7 + 16: PRINT "...": COLOR 7
  DO
    iCount = iCount + 1
    sN1 = Sum$(sN1, sN2)
    sN2 = Reverse$(sN1)
  LOOP UNTIL iCount >= MaxIterations OR sN1 = sN2
 
  IF sN1 <> sN2 THEN
    IF IsLychrel%(i) THEN
      doAddLychrel i
    ELSE
      doAddRelated i
    END IF
    PRINT "Potential Lychrel numbers:"; UBOUND(lLC, 2); "{";
    FOR l = 1 TO UBOUND(lLC, 2)
      PRINT lLC(1, l);
    NEXT
    PRINT "}"
 
    IF UBOUND(lRL) > 0 THEN
      PRINT "Kin Lychrel numbers found:"; UBOUND(lRL)
    END IF
  END IF
NEXT i
 
' Look for palyndromes
IF UBOUND(lLC, 2) > 0 THEN
  doFindLychrelPalyndromes
END IF
 
' Shows the results
CLS
PRINT "Lychrel numbers 1.0 in QB64"
PRINT
PRINT "Lychrel numbers found: "; UBOUND(lLC, 2)
PRINT "Lychrel numbers: {";
FOR i = 1 TO UBOUND(lLC, 2)
  PRINT lLC(1, i);
NEXT
PRINT "}"
PRINT
PRINT "Kin numbers found: "; UBOUND(lRL)
' You can uncomment the following lines if you want to see the
'   Kin or Related numbers found.
'PRINT "Kin numbers: {";
'FOR i = 1 TO UBOUND(lRL)
'  PRINT lRL(i);
'NEXT i
'PRINT "}"
PRINT
PRINT "Palyndrome Lychrel numbers found:"; UBOUND(lPN); "{";
FOR i = 1 TO UBOUND(lPN)
  PRINT lPN(i);
NEXT i
PRINT "}"
lT = TIMER - lT
PRINT
PRINT USING "Calculation took ##:## seconds."; FIX(lT / 60), (lT MOD 60)
PRINT "End of program."
' ------------------ End of Main program --------------------------------------
END
 
FUNCTION CalculateMaxRes& (WhichNumber AS LONG)
  ' Var
  IF (WhichNumber MOD 10) <> 0 THEN
    CalculateMaxRes& = WhichNumber + VAL(Reverse$(LTRIM$(STR$(WhichNumber))))
  ELSE
    CalculateMaxRes& = (WhichNumber - 1) + VAL(Reverse$(LTRIM$(STR$(WhichNumber - 1))))
  END IF
END FUNCTION
 
SUB doAddLychrel (WhichNumber AS LONG)
  ' Var
  DIM iMaxC AS INTEGER, iMaxR AS INTEGER
  DIM lRes AS LONG, iRow AS INTEGER
  DIM sN1 AS STRING, sN2 AS STRING
  DIM lNum(1 TO 10) AS LONG
  SHARED lLC() AS LONG, lMC AS LONG
 
  '
  lNum(1) = WhichNumber
  iRow = 1
  iMaxR = 10
  lRes = WhichNumber
  DO
    iRow = iRow + 1
    IF iRow > iMaxR THEN
      ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
	  REDIM _PRESERVE lNum(1 TO iMaxR + 10) AS LONG 
    END IF
    sN1 = LTRIM$(STR$(lRes))
    sN2 = Reverse$(sN1)
    lRes = VAL(Sum$(sN1, sN2))
    lNum(iRow) = lRes
  LOOP UNTIL lRes > lMC
 
  ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
  REDIM _PRESERVE lNum(1 TO iRow) AS LONG
 
  ' Now, Gathers the size of the lLC table
  iMaxC = UBOUND(lLC, 2) + 1
  IF iMaxC = 1 THEN
    ERASE lLC
    iMaxR = iRow
  ELSE
    iMaxR = UBOUND(lLC, 1)
  END IF
 
  IF iMaxC = 1 THEN
    REDIM lLC(1 TO iMaxR, 1 TO iMaxC) AS LONG
  ELSE
    ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
	REDIM _PRESERVE lLC(1 TO iMaxR, 1 TO iMaxC) AS LONG
  END IF
 
  ' Assigns the result to the table
  FOR lRes = 1 TO iRow
    lLC(lRes, iMaxC) = lNum(lRes)
  NEXT lRes
 
  ERASE lNum
END SUB
 
SUB doAddRelated (WhichNumber AS LONG)
  ' Var
  DIM iMax AS INTEGER
  SHARED lRL() AS LONG
 
  iMax = UBOUND(lRL) + 1
  IF iMax = 1 THEN
    ERASE lRL
  END IF
  ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
  REDIM _PRESERVE lRL(1 TO iMax) AS LONG
  lRL(iMax) = WhichNumber
END SUB
 
SUB doFindLychrelPalyndromes ()
  ' Var
  DIM iMaxC AS INTEGER, i AS INTEGER, iCount AS INTEGER
  DIM sN1 AS STRING, sN2 AS STRING
  SHARED lLC() AS LONG, lRL() AS LONG, lPN() AS LONG
 
  ' Verify seeds
  iMaxC = UBOUND(lLC, 2)
  FOR i = 1 TO iMaxC
    IF lLC(1, i) > 0 THEN
      sN1 = LTRIM$(STR$(lLC(1, i)))
      sN2 = Reverse$(sN1)
      IF sN1 = sN2 THEN
        iCount = iCount + 1
        GOSUB AddSpaceForItem
        lPN(iCount) = VAL(sN1)
      END IF
    END IF
  NEXT i
 
  ' Verify Kins
  iMaxC = UBOUND(lRL)
  FOR i = 1 TO iMaxC
    IF lRL(i) > 0 THEN
      sN1 = LTRIM$(STR$(lRL(i)))
      sN2 = Reverse$(sN1)
      IF sN1 = sN2 THEN
        iCount = iCount + 1
        GOSUB AddSpaceForItem
        lPN(iCount) = VAL(sN1)
      END IF
    END IF
  NEXT i
 
  ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
  REDIM _PRESERVE lPN(1 TO iCount) AS LONG
 
  EXIT SUB
 
  AddSpaceForItem:
  IF UBOUND(lPN) < iCount THEN
    IF UBOUND(lPN) = 0 THEN
      ERASE lPN
    END IF
    ' Change to REDIM PRESERVE for VB-DOS, QB, QBASIC and PDS 7.1
	REDIM _PRESERVE lPN(1 TO iCount + 9) AS LONG
  END IF
  RETURN
 
 
END SUB
 
FUNCTION IsLychrel% (WhichNumber AS LONG)
  ' Var
  DIM iMaxC AS INTEGER, iMaxR AS INTEGER
  DIM iCol AS INTEGER, iRow AS INTEGER
  DIM lToCompare AS LONG
  DIM YesItIs AS INTEGER
  DIM sN1 AS STRING, sN2 AS STRING
  SHARED lLC() AS LONG, lMC AS LONG
 
  iMaxC = UBOUND(lLC, 2)
  iMaxR = UBOUND(lLC, 1)
  lToCompare = WhichNumber
  IF iMaxC > 0 THEN
    DO
      sN1 = LTRIM$(STR$(lToCompare))
      sN2 = Reverse$(sN1)
      lToCompare = VAL(Sum$(sN1, sN2))
      iCol = 0
      DO
        iCol = iCol + 1
        iRow = 0
        DO
          iRow = iRow + 1
        LOOP UNTIL iRow = iMaxR OR lToCompare = lLC(iRow, iCol)
      LOOP UNTIL iCol = iMaxC OR lToCompare = lLC(iRow, iCol)
    LOOP UNTIL lToCompare >= lMC OR lToCompare = lLC(iRow, iCol)
    YesItIs = (lToCompare <> lLC(iRow, iCol))
  ELSE
    YesItIs = True
  END IF
 
  IsLychrel = YesItIs
 
END FUNCTION
 
FUNCTION Reverse$ (WhatToReverse AS STRING)
  ' Var
  DIM sChar AS STRING
  DIM sRes AS STRING
  DIM i AS INTEGER, l AS INTEGER
 
  l = LEN(WhatToReverse)
  sRes = ""
  FOR i = 1 TO l
    sRes = MID$(WhatToReverse, i, 1) + sRes
  NEXT i
 
  Reverse$ = sRes
END FUNCTION
 
FUNCTION Sum$ (N1 AS STRING, N2 AS STRING)
  ' Var
  DIM iN1 AS INTEGER, iN2 AS INTEGER, iSum AS INTEGER
  DIM i AS INTEGER, l AS INTEGER, iCarry AS INTEGER, lM AS LONG
  DIM sRes AS STRING
 
  IF LEN(N1) > LEN(N2) THEN
    l = LEN(N1)
  ELSE
    l = LEN(N2)
  END IF
  lM = 2147483647 / 2
 
  ' Add trailing zeroes (uncomment in case strings have not equal number of digits)
  ' N1 = STRING$(l - LEN(N1), 48) + N1
  ' N2 = STRING$(l - LEN(N2), 48) + N2
 
  ' Hace la suma
  IF VAL(N1) < lM THEN
    sRes = LTRIM$(STR$(VAL(N1) + VAL(N2)))
  ELSE
 
    FOR i = l TO 1 STEP -1
      iN1 = VAL(MID$(N1, i, 1))
      iN2 = VAL(MID$(N2, i, 1))
 
      iSum = iN1 + iN2 + iCarry
 
      iCarry = FIX(iSum / 10)
      iSum = iSum MOD 10
 
      sRes = LTRIM$(STR$(iSum)) + sRes
    NEXT i
    IF iCarry > 0 THEN sRes = LTRIM$(STR$(iCarry)) + sRes
  END IF
 
  Sum$ = sRes
 
END FUNCTION
 