Form a series, starting from 1,
Add to the last number the sum of its own digits, and then repeat.
Example: 1, 2, 4, 8, 16, 23, 28, 38 . . .
The 595th term is 10001, both of which are numerical palindromes.
How many such palindromic pairs does the series contain?
I had to make the starting number, 1, the 0th term of the series in order for 10001 to be the 595th term. The palindrome pairs found, up through the thousandth term are:
0 1
1 2
2 4
3 8
11 77
151 1991
191 2552
595 10001
747 12221
These are the nine such palindromic pairs found by the program, which goes up to term number 1000, as mentioned:
DefDbl A-Z
Dim crlf$
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
termno = 0: member = 1: pals = 1
Text1.Text = Text1.Text & termno & Str(member) & crlf
ct = 1
For termno = 1 To 1000
member = member + sod(member)
' Text1.Text = Text1.Text & termno & Str(member) & crlf
' If termno < 11 Or termno = 595 Then
' Text1.Text = Text1.Text & termno & Str(member) & crlf
' End If
If isPalin(termno) Then
If isPalin(member) Then
Text1.Text = Text1.Text & termno & Str(member) & crlf
DoEvents
pals = pals + 1
End If
End If
Next termno
Text1.Text = Text1.Text & pals & " done"
End Sub
Function isPalin(x)
xs$ = LTrim(Str(x))
good = 1
For i = 1 To Len(xs) / 2
If Mid(xs, i, 1) <> Mid(xs, Len(xs) + 1 - i, 1) Then good = 0: Exit For
Next
isPalin = good
End Function
Function sod(x)
tot = 0
xs = LTrim(Str(x))
For i = 1 To Len(xs)
tot = tot + Val(Mid(xs, i, 1))
Next
sod = tot
End Function
However, there are more, if we look farther:
22522 521125
50305 1254521
62726 1583851
1339331 42288224
(checked through the hundred millionth term)
I don't imagine there's any limit, but none were found after the 1,339,331th element through the 100,000,000th.
|
Posted by Charlie
on 2015-02-03 14:31:41 |