Iterated digits squaring - Rosetta Code

[bplus]

ref http://rosettacode.org/wiki/Iterated_digits_squaring

Who tried this recursively?

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring - Rosetta Code" ' b+ try 2021-09-04
3. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
4. start = Timer(.001)
5. For i& = 1 To 100000000 ' 100 million
6.     If i& Mod 1000000 = 0 Then Print i&, c& ' progress almost 8 minutes on my system
7.     c& = c& + sumSQRdigitsIs89%(i&)
8. Next
9. Print c&, Timer(.001) - start
10.  
11. Function sumSQRdigitsIs89% (number&)
12.     n$ = _Trim$(Str$(number&))
13.     For i = 1 To Len(n$)
14.         sum& = sum& + Val(Mid$(n$, i, 1)) ^ 2
15.     Next
16.     If sum& = 89 Then
17.         sumSQRdigitsIs89% = 1
18.     ElseIf sum& <> 1 Then
19.         sumSQRdigitsIs89% = sumSQRdigitsIs89%(sum&)
20.     End If
21. End Function
22.  

Of course there must be faster ways even for QB64 ;-))

Hint get rid of the string stuff :)

[bplus]

All afternoon to shave off 3.5 mins:

Code: QB64: [Select]

1. _Title "Iterated digits squaring v2 - Rosetta Code" ' b+ try 2021-09-04
2. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
3. $Checking:Off
4. DefLng A-Z
5. Dim Shared did(649), t(10), sq(10) '9*81 + 1 max sum number
6. start = Timer(.001)
7. For i = 1 To 100000000 ' 100 million   now a tad over 4.5 mins shaved off over 3 min.
8.     t(1) = t(1) + 1: sq(1) = t(1) * t(1)
9.     For j = 1 To 8
10.         If t(j) = 10 Then t(j) = 0: sq(j) = 0: t(j + 1) = t(j + 1) + 1: sq(j + 1) = t(j + 1) * t(j + 1)
11.     Next
12.     'check this 100 million times less
13.     'If t(10) = 10 Then Beep: Print "You've just exceeded the limit of the tabulator, goodbye.": End
14.     sum = sq(1) + sq(2) + sq(3) + sq(4) + sq(5) + sq(6) + sq(7) + sq(8) + sq(9)
15.     'check this 100 million times less
16.     'If i Mod 1000000 = 0 Then Print i, c   ' <<< progress
17.     If sumSQRdigits(sum) = 89 Then c = c + 1
18. Next
19. Print c, Timer(.001) - start
20.  
21. Function sumSQRdigits (number)
22.     If number = 89 Then sumSQRdigits = 89: Exit Function
23.     If number = 1 Then sumSQRdigits = 1: Exit Function
24.     Dim As Integer sum
25.     If number < 649 Then
26.         If did(number) Then
27.             sumSQRdigits = did(number)
28.         Else
29.             n$ = _Trim$(Str$(number))
30.             For i = 1 To Len(n$)
31.                 sum = sum + Val(Mid$(n$, i, 1)) ^ 2
32.             Next
33.             If sum = 89 Or sum = 1 Then
34.                 did(number) = sum
35.                 sumSQRdigits = sum: Exit Function
36.             Else
37.                 sumSQRdigits = sumSQRdigits(sum)
38.             End If
39.         End If
40.     Else
41.         Print " Error: number into sumSQRdigits is > 730."; " end"
42.     End If
43. End Function
44.  

Didn't make much difference to comment out progress.

[jack]

hi bplus
instead of val use asc($)-48
your first example modified

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring - Rosetta Code" ' b+ try 2021-09-04
3. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
4. start = Timer(.001)
5. For i& = 1 To 100000000 ' 100 million
6.     If i& Mod 1000000 = 0 Then Print i&, c& ' progress almost 8 minutes on my system
7.     c& = c& + sumSQRdigitsIs89%(i&)
8. Next
9. Print c&, Timer(.001) - start
10.  
11. Function sumSQRdigitsIs89% (number&)
12.     n$ = _Trim$(Str$(number&))
13.     For i = 1 To Len(n$)
14.         d& = Asc(Mid$(n$, i, 1)) - 48
15.         sum& = sum& + d& * d&
16.     Next
17.     If sum& = 89 Then
18.         sumSQRdigitsIs89% = 1
19.     ElseIf sum& <> 1 Then
20.         sumSQRdigitsIs89% = sumSQRdigitsIs89%(sum&)
21.     End If
22. End Function
23.  

[bplus]

Yes! nice one @jack  :)

Try this:

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring - Rosetta Code" ' b+ try 2021-09-04
3. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
4. start = Timer(.001)
5. For i& = 1 To 100000000 ' 100 million
6.     If i& Mod 1000000 = 0 Then Print i&, c& ' progress almost 8 minutes on my system
7.     c& = c& + sumSQRdigitsIs89%(i&)
8. Next
9. Print c&, Timer(.001) - start
10.  
11. Function sumSQRdigitsIs89% (number&)
12.     n$ = _Trim$(Str$(number&))
13.     For i = 1 To Len(n$)
14.         d& = Asc(n$, i) - 48
15.         sum& = sum& + d& * d&
16.     Next
17.     If sum& = 89 Then
18.         sumSQRdigitsIs89% = 1
19.     ElseIf sum& <> 1 Then
20.         sumSQRdigitsIs89% = sumSQRdigitsIs89%(sum&)
21.     End If
22. End Function
23.  

Man 3 mins!

[bplus]

OK now we're cooking with butter!

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring v4 - Rosetta Code" ' b+ try 2021-09-04
3. DefLng A-Z
4. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
5. start! = Timer(.001)
6. For i = 1 To 100000000 ' 100 million
7.     'If i Mod 1000000 = 0 Then Print i, c ' progress  36 secs on my system
8.     c = c + sumSQRdigitsIs89(i)
9. Next
10. Print c, Timer(.001) - start!
11.  
12. Function sumSQRdigitsIs89 (number)
13.     n = number
14.     While n > 0
15.         d = n Mod 10
16.         sum = sum + d * d
17.         n = n \ 10
18.     Wend
19.     If sum = 89 Then
20.         sumSQRdigitsIs89 = 1
21.     ElseIf sum <> 1 Then
22.         sumSQRdigitsIs89 = sumSQRdigitsIs89(sum)
23.     End If
24. End Function
25.  

[bplus]

Man that's the way to isolate the digits for these challenges, don't mess with string conversions.

[jack]

about 18% faster

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring - Rosetta Code" ' b+ try 2021-09-04
3. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
4. start = Timer(.001)
5. For i& = 1 To 100000000 ' 100 million
6.     If i& Mod 1000000 = 0 Then Print i&, c& ' progress almost 8 minutes on my system
7.     c& = c& + sumSQRdigitsIs89%(i&)
8. Next
9. Print c&, Timer(.001) - start
10.  
11. Function sumSQRdigitsIs89% (number&)
12.     n$ = _Trim$(Str$(number&))
13.     m% = Len(n$)
14.     For i% = 1 To m%
15.         d% = Asc(n$, i%) - 48
16.         sum& = sum& + d% * d%
17.     Next
18.     If sum& = 89 Then
19.         sumSQRdigitsIs89% = 1
20.     ElseIf sum& <> 1 Then
21.         sumSQRdigitsIs89% = sumSQRdigitsIs89%(sum&)
22.     End If
23. End Function
24.  

[bplus]

I started looking at FreeBASIC's, 2 millisecs!!!

For one thing they aren't using recursion but something like this for function:

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring v5 - Rosetta Code" ' b+ try 2021-09-04
3. DefLng A-Z
4. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
5. start! = Timer(.001)
6. For i = 1 To 100000000 ' 100 million
7.     If i Mod 1000000 = 0 Then Print i, c ' progress  18 secs on my system
8.     c = c + sumSQRdigitsIs89(i)
9. Next
10. Print c, Timer(.001) - start!
11.  
12. Function sumSQRdigitsIs89 (number)
13.     n = number
14.     Do
15.         While n > 0
16.             d = n Mod 10
17.             sum = sum + d * d
18.             n = n \ 10
19.         Wend
20.         If sum = 89 Then
21.             sumSQRdigitsIs89 = 1: Exit Function
22.         ElseIf sum = 1 Then
23.             sumSQRdigitsIs89 = 0: Exit Function
24.         Else
25.             n = sum
26.             sum = 0
27.         End If
28.     Loop
29. End Function

I am down from 36 secs v4 to 18 secs now v5 but no where near 2 millisecs. They do a bunch more though in main that I have to figure out.

[bplus]

OMG, Don't know what they did but it works in thousandths of a sec!

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring v6 - Rosetta Code" ' b+ try 2021-09-04
3. DefLng A-Z
4. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
5. start! = Timer(.001)
6.  
7. Dim sums(0 To 8 * 81) ' copied and translated to QB64 from FreeBASIC entry at Rosetta Code
8. sums(0) = 1
9. sums(1) = 0
10. For n = 1 To 8
11.     For i = n * 81 To 1 Step -1
12.         For j = 1 To 9
13.             s = j * j
14.             If s > i Then Exit For
15.             sums(i) = sums(i) + sums(i - s)
16.         Next j
17.     Next i
18.     If n = 8 Then
19.         count89 = 0
20.         For i = 1 To n * 81
21.             If sumSQRdigitsIs89(i) Then count89 = count89 + sums(i)
22.         Next i
23.         Print "There are"; count89; " numbers from 1 to 100 million ending with 89"
24.     End If
25. Next
26. Print Timer(.001) - start!
27.  
28. Function sumSQRdigitsIs89 (number)
29.     n = number
30.     Do
31.         While n > 0
32.             d = n Mod 10
33.             sum = sum + d * d
34.             n = n \ 10
35.         Wend
36.         If sum = 89 Then
37.             sumSQRdigitsIs89 = 1: Exit Function
38.         ElseIf sum = 1 Then
39.             sumSQRdigitsIs89 = 0: Exit Function
40.         Else
41.             n = sum
42.             sum = 0
43.         End If
44.     Loop
45. End Function
46.  

 

[bplus]

I remove the 2nd block For loop in main and move it outside to save a couple lines of code:

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring v7 - Rosetta Code" ' b+ try 2021-09-04
3. DefLng A-Z
4. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
5. start! = Timer(.001)
6. Dim sums(0 To 8 * 81) ' copied and translated to QB64 from FreeBASIC entry at Rosetta Code
7. sums(0) = 1
8. sums(1) = 0
9. For n = 1 To 8
10.     For i = n * 81 To 1 Step -1
11.         For j = 1 To 9
12.             s = j * j
13.             If s > i Then Exit For
14.             sums(i) = sums(i) + sums(i - s)
15.         Next j
16.     Next i
17. Next
18. For i = 1 To 8 * 81
19.     If sumSQRdigitsIs89(i) Then count89 = count89 + sums(i)
20. Next i
21. Print "There are"; count89; " numbers from 1 to 100 million ending with 89"
22. Print Timer(.001) - start!
23.  
24. Function sumSQRdigitsIs89 (number)
25.     n = number
26.     Do
27.         While n > 0
28.             d = n Mod 10
29.             sum = sum + d * d
30.             n = n \ 10
31.         Wend
32.         If sum = 89 Then
33.             sumSQRdigitsIs89 = 1: Exit Function
34.         ElseIf sum = 1 Then
35.             sumSQRdigitsIs89 = 0: Exit Function
36.         Else
37.             n = sum
38.             sum = 0
39.         End If
40.     Loop
41. End Function
42.  
43.  
44.  

[SMcNeill]

You could probably do some precalculation and save time too.  For example:

s = j * j


Instead:

FOR j = 1 TO 9
   s(j) = j * j
NEXT

Then use s(j) directly, rather than calculating the value each loop.

[bplus]

Thanks @SMcNeill that s=j*j looks like it is needed in line 14, but I don't know.

I definitely don't know what is going in the first For loops in the main block.

Can anyone explain it?

The 81's are the maximum square for a digit if you have n digits then the maximum sum of them is n * 81 which is  allot less than the numbers we run through for the 89 sums. I did start a table that recorded where the sums would go, the did() array (in V2) so we could avoid doing those calculation sequences over and over. But I don't think the FreeBASIC code is doing quite the same thing.

[david_uwi]

We can't let freebasic beat QB64 so here's my code. The timing is not accurate because of the small execution time.

Code: QB64: [Select]

1. nn = 8 'this is the number of digits 8 --> 100,000,000
2. pp = 81 * nn
3. DIM xa(pp) AS LONG
4. DIM xb(pp, nn) AS LONG
5. DIM qsq(12) AS INTEGER
6. DIM sum AS LONG
7. DEFLNG M
8. start! = TIMER(.001) 'this is not reliable for these short execution times
9. FOR i = 1 TO 9
10.     sq1 = i * i
11.     qsq(i + 1) = sq1
12.     xb(sq1, 1) = xb(sq1, 1) + 1
13. NEXT i
14. qsq(1) = 0
15. FOR jkl = 2 TO nn
16.     FOR j = 1 TO pp
17.         IF xb(j, jkl - 1) <> 0 THEN
18.             FOR k = 1 TO 10
19.                 ind = j + qsq(k)
20.                 xb(ind, jkl) = xb(ind, jkl) + xb(j, jkl - 1)
21.             NEXT k
22.         END IF
23.     NEXT j
24. NEXT jkl
25. FOR i = 1 TO pp
26.     FOR jkl = 1 TO nn
27.         xa(i) = xb(i, jkl) + xa(i)
28.     NEXT jkl
29. NEXT i
30. FOR i = 1 TO pp
31.     IF xa(i) <> 0 THEN
32.         sum = sum + xa(i)
33.     END IF
34. NEXT i
35. FOR i = 1 TO pp
36.     IF xa(i) <> 0 THEN
37.         z1 = i
38.         k = 0
39.         DO
40.             k = k + 1
41.             a = 0
42.             a = z1 \ 100
43.             z1 = z1 MOD 100
44.             b = z1 \ 10
45.             c = z1 MOD 10
46.             z1 = a * a + b * b + c * c
47.             IF z1 = 89 THEN m89 = m89 + xa(i): EXIT DO
48.             IF z1 = 1 THEN m1 = m1 + xa(i): EXIT DO
49.         LOOP
50.     END IF
51. NEXT i
52. PRINT "time taken= "; TIMER(.001) - start!
53. PRINT "number ending in 89 = "; m89; ""
54. PRINT "number ending in 1 = "; m1 + 1
55. PRINT "total numbers = "; m1 + m89 + 1

[bplus]

@david_uwi

I tried to give our codes more work to do so the times would be extended for comparing. I got the FB version timing number of digits 1 through 19 (after that even _Unsigned _Integer64 has overflow errors)

Code: QB64: [Select]

1. $Checking:Off
2. _Title "Iterated digits squaring v8 - Rosetta Code" ' b+ try 2021-09-04  v8 2021-09-06
3. ' ref http://rosettacode.org/wiki/Iterated_digits_squaring
4. ' add more chores to v7 so takes enough time to differentiate with david_uwi's version
5.  
6. _Define A-Z As _UNSIGNED _INTEGER64
7. start! = Timer(.001)
8. For nDigits = 1 To 19 ' it's wrong after 19
9.     ReDim sums(0 To nDigits * 81) ' copied and translated to QB64 from FreeBASIC entry at Rosetta Code
10.     sums(0) = 1
11.     sums(1) = 0
12.     For n = 1 To nDigits
13.         For i = n * 81 To 1 Step -1
14.             For j = 1 To 9
15.                 s = j * j
16.                 If s > i Then Exit For
17.                 sums(i) = sums(i) + sums(i - s)
18.             Next j
19.         Next i
20.     Next
21.     count89 = 0
22.     For i = 1 To nDigits * 81
23.         If sumSQRdigitsIs89(i) Then count89 = count89 + sums(i)
24.     Next i
25.     Print "For 10 ^"; nDigits; "there are"; count89; "numbers ending with 89."
26. Next
27. Print Timer(.001) - start!
28.  
29. Function sumSQRdigitsIs89 (number)
30.     n = number
31.     Do
32.         While n > 0
33.             d = n Mod 10
34.             sum = sum + d * d
35.             n = n \ 10
36.         Wend
37.         If sum = 89 Then
38.             sumSQRdigitsIs89 = 1: Exit Function
39.         ElseIf sum = 1 Then
40.             sumSQRdigitsIs89 = 0: Exit Function
41.         Else
42.             n = sum
43.             sum = 0
44.         End If
45.     Loop
46. End Function
47.  

Ha! still not enough work for one click of the clock!

I tried modifying your code but my attempts ran into wrong numbers after the number of digits hit 14?

[bplus]

@david_uwi maybe you can see what's happening:

My attempt to mod your code (I tried to do one time stuff outside main loop but kept getting errors so tried just redoing everything at start of new nn (number of Digits) set in main For loop, better but errors after 13 digits).

Code: QB64: [Select]

1. _Title "Iterated digits squaring - Rosetta Code david_uwi version mod b+"
2. ' from   https://www.qb64.org/forum/index.php?topic=4160.msg135168#msg135168
3. ' copied and modified by b+ for a timed test with FB version 2021-09-06
4. ' mod notes: change all to _Integer64 and Loop nDigits 1 to 19
5.  
6. _Define A-Z As _INTEGER64
7. nn = 8 'this is the number of digits 8 --> 100,000,000
8. start! = Timer(.001) 'this is not reliable for these short execution times
9. For nn = 1 To 19
10.     pp = 81 * nn
11.     ReDim xa(pp)
12.     ReDim xb(pp, nn)
13.     ReDim qsq(12)
14.     sum = 0
15.     For i = 1 To 9
16.         sq1 = i * i
17.         qsq(i + 1) = sq1
18.         xb(sq1, 1) = xb(sq1, 1) + 1
19.     Next i
20.     qsq(1) = 0
21.     m89 = 0
22.     For jkl = 2 To nn
23.         For j = 1 To pp
24.             If xb(j, jkl - 1) <> 0 Then
25.                 For k = 1 To 10
26.                     ind = j + qsq(k)
27.                     xb(ind, jkl) = xb(ind, jkl) + xb(j, jkl - 1)
28.                 Next k
29.             End If
30.         Next j
31.     Next jkl
32.     For i = 1 To pp
33.         For jkl = 1 To nn
34.             xa(i) = xb(i, jkl) + xa(i)
35.         Next jkl
36.     Next i
37.     For i = 1 To pp
38.         If xa(i) <> 0 Then
39.             sum = sum + xa(i)
40.         End If
41.     Next i
42.     For i = 1 To pp
43.         If xa(i) <> 0 Then
44.             z1 = i
45.             k = 0
46.             Do
47.                 k = k + 1
48.                 a = 0
49.                 a = z1 \ 100
50.                 z1 = z1 Mod 100
51.                 b = z1 \ 10
52.                 c = z1 Mod 10
53.                 z1 = a * a + b * b + c * c
54.                 If z1 = 89 Then m89 = m89 + xa(i): Exit Do
55.                 If z1 = 1 Then m1 = m1 + xa(i): Exit Do
56.             Loop
57.         End If
58.     Next i
59.  
60.     Print "For 10 ^"; nn; " the number ending in 89 ="; m89
61.     'Print "number ending in 1 = "; m1 + 1
62.     'Print "total numbers = "; m1 + m89 + 1
63. Next
64. Print "time taken= "; Timer(.001) - start!
65.