Devise an efficient method of finding consecutive squares which have the same digits.
Find such pairs up to 1000000.
Feel free to go further.
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
t = Timer
For n = 1 To 100000
psq = sq: psqs$ = sqs$
sq = n * n: sqs$ = LTrim(Str(sq))
If Len(psqs) = Len(sqs) Then good = 1 Else good = 0
For i = 1 To Len(sqs)
ix = InStr(psqs$, Mid(sqs, i, 1))
If ix = 0 Then
good = 0: Exit For
Else
psqs = Left(psqs, ix - 1) + Mid(psqs, ix + 1)
End If
Next
If good = 1 Then Text1.Text = Text1.Text & psq & " " & sqs & crlf: DoEvents
Next
Text1.Text = Text1.Text & Timer - t & crlf
t = Timer
n = 1: sq = 1
For diff = 3 To 199999 Step 2
psq = sq: psqs$ = sqs$
sq = sq + diff: n = n + 1: sqs$ = LTrim(Str(sq))
If Len(psqs) = Len(sqs) Then good = 1 Else good = 0
For i = 1 To Len(sqs)
ix = InStr(psqs$, Mid(sqs, i, 1))
If ix = 0 Then
good = 0: Exit For
Else
psqs = Left(psqs, ix - 1) + Mid(psqs, ix + 1)
End If
Next
If good = 1 Then Text1.Text = Text1.Text & psq & " " & sqs & crlf: DoEvents
Next
Text1.Text = Text1.Text & Timer - t & crlf
Text1.Text = Text1.Text & "done"
DoEvents
End Sub
Uses two methods, with not much difference in timing, to get the successive squares: actually multiplying the number by itself; or adding successively larger increments to the previous square, as the successive differences between successive pairs form a linear sequence. It was .433 seconds vs .521 seconds finding squares up to ten billion. I had thought the addition method would beat out the multiplication method, but that didn't happen.
The part about checking that the two numbers use the same digits is accomplished by converting each to a string, which must be of the same length, and then searching for each digit in one, in the other and removing it there. The one for the previous square is destroyed as it is no longer needed, as the larger square is copied to the previous, the next time around. A possible attempt at a time improvement might be by replacing the found digit by a space rather than removing (by concatenation) the found digit altogether. I'd think this would be language dependent.
169 196
24649 24964
833569 835396
20367169 20376196
214534609 214563904
368678401 368716804
372142681 372181264
392554969 392594596
407676481 407716864
771617284 771672841
1013021584 1013085241
1212780625 1212850276
1404075841 1404150784
1567051396 1567130569
1623848209 1623928804
2538748996 2538849769
2866103296 2866210369
2898960964 2899068649
3015437569 3015547396
3967236196 3967362169
4098688441 4098816484
4937451289 4937591824
5854239169 5854392196
6121654081 6121810564
6822264409 6822429604
7984494736 7984673449
9672132409 9672329104
0.433000000000291
169 196
24649 24964
833569 835396
20367169 20376196
214534609 214563904
368678401 368716804
372142681 372181264
392554969 392594596
407676481 407716864
771617284 771672841
1013021584 1013085241
1212780625 1212850276
1404075841 1404150784
1567051396 1567130569
1623848209 1623928804
2538748996 2538849769
2866103296 2866210369
2898960964 2899068649
3015437569 3015547396
3967236196 3967362169
4098688441 4098816484
4937451289 4937591824
5854239169 5854392196
6121654081 6121810564
6822264409 6822429604
7984494736 7984673449
9672132409 9672329104
0.521000000003028
done
|
|
Posted by Charlie
on 2015-02-10 19:26:46 |
some thoughts
