All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Algorithms
Shared by squares (Posted on 2015-02-10) Difficulty: 3 of 5
Devise an efficient method of finding consecutive squares which have the same digits.

Find such pairs up to 1000000.

Feel free to go further.

No Solution Yet Submitted by Jer    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
Some Thoughts some thoughts | Comment 2 of 3 |
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
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (6)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information