PureBasic Forums - English

Posted: **Thu Jun 28, 2007 9:57 pm**

Michael Vogel wrote:Hi Francis, you're completing the problems very fast!

Michael Vogel wrote:Hi Demivec, maybe you can try to solve problem 125 - it has to do also with palindromes and seems also not to be too complicate to solve...

That one was surprisingly easy to complete! I managed to get a working solution (although it could do with a bit of optimising) in less than 10 minutes!

Kind regards,

Francis.

Posted: **Fri Jun 29, 2007 7:24 am**

Dreamland Fantasy wrote: That one was surprisingly easy to complete! I managed to get a working solution (although it could do with a bit of optimising) in less than 10 minutes!

Cool

That's one still missing on my list

- will try that today

Posted: **Fri Jun 29, 2007 9:10 am**

I'm still trying to optimise problem 125 as it currently takes just over a minute to complete on my laptop.

Kind regards,

Francis.

Posted: **Fri Jun 29, 2007 4:58 pm**

Michael Vogel wrote:Hi Demivec, maybe you can try to solve problem 125 - it has to do also with palindromes and seems also not to be too complicate to solve...

Ok, I bit the bullet, stepped into Eulerville, registered and solved problem 125.

Dreamland Fantasy wrote:That one was surprisingly easy to complete! I managed to get a working solution (although it could do with a bit of optimising) in less than 10 minutes! Smile

Dreamland Fantasy wrote:I'm still trying to optimise problem 125 as it currently takes just over a minute to complete on my laptop

My version ran in 8.063 seconds.

Posted: **Fri Jun 29, 2007 8:30 pm**

Demivec wrote:
Dreamland Fantasy wrote:I'm still trying to optimise problem 125 as it currently takes just over a minute to complete on my laptop
My version ran in 8.063 seconds.

I've managed to get mine down from 63 seconds to under 35 seconds.

The reason mine is so slow is probably due to the way I approached the problem which was to go through all the numbers under 10^8, check if they were a palindrome (which is where my algorithm spends about 95% of its time) and then check if it has a valid consecutive number sequence. On the plus side doing it this way means that you don't need to bother about checking for duplicates they way most of the guys on the Project Euler forum have.

To get mine as fast as yours I would need to rewrite the algorithm so that I'm not going through all of the potential numbers.

Incidentally, I found a marginally faster way (from my original) of checking for palindromes.

Code: Select all

Procedure IsPalindrome(A$)
  
  Protected i, length = Len(A$) - 1

  For i = 0 To length
    If PeekB(@A$ + i) = PeekB(@A$ + length - i)
    Else
      ProcedureReturn 0
    EndIf
  Next
  
  ProcedureReturn 1
  
EndProcedure

The only change I made was to use '=' instead of '<>' in the if statement and then do a procedure return on the else statement.

I suspect that doing it this way might be faster because you are not doing two checks (the '<' and '>') and are thus reducing the overheads.

Kind regards,

Francis.

Posted: **Fri Jun 29, 2007 8:55 pm**

Dreamland Fantasy wrote:To get mine as fast as yours I would need to rewrite the algorithm so that I'm not going through all of the potential numbers

I generated the legal palindromes and then checked which ones had valid sums. The sums I checked with pre-computed squares.
By only checking the palindromes for sums, I narrowed the possibilities to only 0.02% of the range of numbers and saved the time of actually verifying if a number was a palindrome.

Posted: **Fri Jun 29, 2007 10:07 pm**

Demivec wrote:
Dreamland Fantasy wrote:To get mine as fast as yours I would need to rewrite the algorithm so that I'm not going through all of the potential numbers
I generated the legal palindromes and then checked which ones had valid sums. The sums I checked with pre-computed squares.
By only checking the palindromes for sums, I narrowed the possibilities to only 0.02% of the range of numbers and saved the time of actually verifying if a number was a palindrome.

Ah, so you've more-or-less done it the same way I did except you've pre-computed the valid palindromes.

How long does it take you to pre-compute the valid palindromes?

Kind regards,

Francis.

Posted: **Fri Jun 29, 2007 10:38 pm**

I've just redone the program using precomputed palindromes.

It completed in just 1.3 seconds!

Kind regards,

Francis.

Posted: **Fri Jun 29, 2007 11:11 pm**

Quite fast!

As my first version took to long - I take a different approach just calculating squares and checking if the sum is a palindrome - that takes now around 3 1/2 second

(but my notebook is very slow

)

Michael

So what's about 110 and 118 these two are too hard for me (for problem 118 I got after a very long calculation time the result 21192 which is... wrong

)

Posted: **Fri Jun 29, 2007 11:26 pm**

Well, here is my code. To be honest I think precalculating the palindromes and squares (and not including them in the time taken) is cheating slightly.

Code: Select all

#TITLE = "Project Euler - Problem 125"

Procedure PrecalculateSquares()

  Protected n = 10000, i
  Global Dim Square.q(n)

  For i = 1 To n
    Square(i) = i * i
  Next

EndProcedure

Procedure IsPalindrome(A$)
  
  Protected i, length = Len(A$) - 1
  
  For i = 0 To length
    If PeekB(@A$ + i) = PeekB(@A$ + length - i)
    Else
      ProcedureReturn 0
    EndIf
  Next
  
  ProcedureReturn 1
  
EndProcedure

Procedure IsConsecutiveSum(n.q)
  
  Protected Sum.q, HighNumber = n >> 1
  HighNumber = Sqr(HighNumber) + 1
  Protected LowNumber = HighNumber
  
  While Sum < n And LowNumber
    Sum + Square(LowNumber)
    If Sum > n
      Sum - Square(HighNumber)
      HighNumber - 1
    EndIf
    LowNumber - 1
  Wend
  
  If Sum = n
    If HighNumber <> LowNumber + 1
      ProcedureReturn 1
    EndIf
  EndIf
  
EndProcedure

Procedure PrecalculatePalindromes(n.q)
  
  Protected i, j=0
  Global Dim PalindromeList.q(20000)
  
  For i = 1 To n
    If IsPalindrome(Str(i))
      PalindromeList(j) = i
      j + 1
    EndIf
  Next
  
  ProcedureReturn j
  
EndProcedure

MaxNumber.q = Pow(10, 8) - 1
Result.q = 0

PrecalculateSquares()
NoofPalindromes = PrecalculatePalindromes(MaxNumber)

TimeStarted = GetTickCount_()

For i = 0 To NoofPalindromes
  If IsConsecutiveSum(PalindromeList(i))
    Result + PalindromeList(i)
  EndIf
Next

TimeElapsed = GetTickCount_() - TimeStarted

MessageText$ = "Result = " + StrQ(Result) + Chr(10) + Chr(10)
MessageText$ + "Average time taken: " + Str(TimeElapsed)+"ms"

MessageRequester(#TITLE, MessageText$)

I would love to hear any suggestions that you have to improve it speedwise.

Kind regards,

Francis

Posted: **Fri Jun 29, 2007 11:33 pm**

Michael Vogel wrote:So what's about 110 and 118 these two are too hard for me (for problem 118 I got after a very long calculation time the result 21192 which is... wrong )

I don't think I'm ready to tackle 110 yet, but 118 looks easy enough (although looks can be very deceiving sometimes!).

I'll give 118 a try and see what I come up with.

Kind regards,

Francis.

Posted: **Sat Jun 30, 2007 4:21 pm**

Dreamland Fantasy wrote:Well, here is my code. To be honest I think precalculating the palindromes and squares (and not including them in the time taken) is cheating slightly.

Note I didn't say "I precalculated the palindromes," I said "I generated the legal palindromes." I also included all steps in the solution (precalculated or otherwise) in the timing. Here's my solution:

Code: Select all

; Project Euler - Problem 125
;
;Find the sum of all the numbers less than 10^8 that are both
;palindromic And can be written As the sum of consecutive squares.

;range of possible factors(2 or more that are consecutive): 1-7072

#Title="Euler Problem 125"

#MaxFactor=7072 ;maximum factor possible
#MinFactor=1 ;minimum factor possible

StartTime=ElapsedMilliseconds()

;-setup pre-calculated squares of possible factors
Global Dim square.l(#MaxFactor)

For a = #MinFactor To #MaxFactor
  square(a) = Pow(a,2)
Next

;-procedures
Procedure.l validateSum(target.l) ;returns 0 if not valid, or target if valid
  Protected sum.l=square(1),factor.l=1, highFactor.l
  
  Repeat ;look for a sum of 1 to factor
    factor+1
    sum+square(factor)
    If sum>target
      Break
    EndIf
    If sum=target
      ProcedureReturn target
    EndIf
  ForEver
  
  highFactor=factor
  Repeat ;look for sums of factor to highFactor
    sum=square(highFactor)
    If (sum>target) Or (sum+square(highFactor-1)>target)
      ProcedureReturn 0
    EndIf
    factor=highFactor
    Repeat
      factor-1
      sum+square(factor)
      If sum>target
        Break
      EndIf
      If sum=target
        ProcedureReturn target
      EndIf
    ForEver
    highFactor+1  
  ForEver
EndProcedure

Procedure.l CreatePalindrome(a,Odd.l) ;Odd=1 if palindrome will have an odd# of digits
  If Odd<>1
    Odd=0 
  EndIf
  
  Protected A$=Str(a),length.l=Len(A$),*A=@A$
  Protected palindrome$=A$+Left(A$,length-Odd),*P=@palindrome$+Len(palindrome$)-1,I.l

  For I=0 To length-1-Odd
    PokeB(*P-I,PeekB(*A+I))
  Next
  ProcedureReturn Val(palindrome$)
EndProcedure

;-Solution search
result.q=0
;check each possible palindrome, instead of each possible value

;search multiple digit palindromes up to 10^8
For a=0 To 3 ;used to calculate range for generation of palindromes
  lowRange=Pow(10,a)
  highRange=Pow(10,a+1)-1
  For b=1 To 0 Step -1 ;odd/even indicator
    For c=lowRange To highRange
      result+validateSum(CreatePalindrome(c,b))
    Next 
  Next 
Next 
 
timeElapsed=ElapsedMilliseconds()-StartTime  

text$= "Time to find solution: "+StrF(timeElapsed, 3)+"ms (Result: " + StrQ(result) + ")"
MessageRequester(#Title, text$)

This finishes in 8.032 seconds.

Posted: **Sat Jun 30, 2007 4:44 pm**

Demivec wrote:
Dreamland Fantasy wrote:Well, here is my code. To be honest I think precalculating the palindromes and squares (and not including them in the time taken) is cheating slightly.
Note I didn't say "I precalculated the palindromes," I said "I generated the legal palindromes." I also included all steps in the solution (precalculated or otherwise) in the timing.

Ah, I've misunderstood what you meant. Very ingenious solution!

Kind regards,

Francis.

Posted: **Sat Jun 30, 2007 5:08 pm**

Hi Demivec,

I've just substituted my IsConsecutiveSum() routine into your program. It now completes in 1.3 seconds instead of 7.9 seconds on my laptop!

Code: Select all

; Project Euler - Problem 125 
; 
;Find the sum of all the numbers less than 10^8 that are both 
;palindromic And can be written As the sum of consecutive squares. 

;range of possible factors(2 or more that are consecutive): 1-7072 

#Title="Euler Problem 125" 

#MaxFactor=7072 ;maximum factor possible 
#MinFactor=1 ;minimum factor possible 

StartTime=ElapsedMilliseconds() 

;-setup pre-calculated squares of possible factors 
Global Dim square.l(#MaxFactor) 

For a = #MinFactor To #MaxFactor 
  square(a) = Pow(a,2) 
Next 

;-procedures 
Procedure.q IsConsecutiveSum(n.l)
  
  Protected sum.q, HighNumber = n >> 1
  HighNumber = Sqr(HighNumber) + 1
  Protected LowNumber = HighNumber
  
  While sum < n And LowNumber
    sum + square(LowNumber)
    If sum > n
      sum - square(HighNumber)
      HighNumber - 1
    EndIf
    LowNumber - 1
  Wend
  
  If sum = n
    If HighNumber <> LowNumber + 1
      ProcedureReturn n
    EndIf
  EndIf
  
EndProcedure

Procedure.l CreatePalindrome(a,Odd.l) ;Odd=1 if palindrome will have an odd# of digits 
  If Odd<>1 
    Odd=0 
  EndIf 
  
  Protected A$=Str(a),length.l=Len(A$),*A=@A$ 
  Protected palindrome$=A$+Left(A$,length-Odd),*P=@palindrome$+Len(palindrome$)-1,I.l 
  
  For I=0 To length-1-Odd 
    PokeB(*P-I,PeekB(*A+I)) 
  Next 
  
  ProcedureReturn Val(palindrome$) 
EndProcedure 

;-Solution search 
result.q=0 
;check each possible palindrome, instead of each possible value 

;search multiple digit palindromes up to 10^8 
For a=0 To 3 ;used to calculate range for generation of palindromes 
  lowRange=Pow(10,a) 
  highRange=Pow(10,a+1)-1 
  For b=1 To 0 Step -1 ;odd/even indicator 
    For c=lowRange To highRange 
      result+IsConsecutiveSum(CreatePalindrome(c,b)) 
    Next 
  Next 
Next 
  
timeElapsed=ElapsedMilliseconds()-StartTime  

text$= "Time to find solution: "+StrF(timeElapsed, 3)+"ms (Result: " + StrQ(result) + ")" 
MessageRequester(#Title, text$)

Kind regards,

Francis.

Posted: **Sat Jun 30, 2007 7:28 pm**

Hi,
my notebook seems to be very lazy (takes 6 seconds to finish Francis' code), so maybe my solution could be fast on your machines:

Code: Select all

	Procedure Stopuhr(n)
		Global Timer=GetTickCount_()
		Global Problemcode=n
	EndProcedure
	Procedure ShowString(x.s)
		MessageRequester("Calc time "+Str(GetTickCount_()-Timer)+"ms","Problem "+Str(Problemcode)+#CR$+"= "+x)
		SetClipboardText(x)
	EndProcedure
	Procedure ShowResult(x.q)
		ShowString(StrQ(x))
	EndProcedure
Procedure.l Palindrom(x.s)
		Protected l=Len(x)-1
		Protected i=l>>1
		While i>=0
			If PeekB(@x+i)<>PeekB(@x+l-i)
				ProcedureReturn #False
			EndIf
			i-1
		Wend
		ProcedureReturn #True
	EndProcedure
	
Procedure Problem_125()

	; The palindromic number 595 is interesting because it can be written as the sum
	; of consecutive squares: 6^2 + 7^2 + 8^2 + 9^2 + 10^2 + 11^2 + 12^2.

	; There are exactly eleven palindromes below one-thousand that can be written as
	; consecutive square sums, and the sum of these palindromes is 4164. Note that
	; 1 = 0^2 + 1^2 has not been included as this problem is concerned with the squares
	; of positive integers.

	; Find the sum of all the numbers less than 10^8 that are both palindromic and can
	; be written as the sum of consecutive squares.

	Stopuhr(125)

	#Grenze=100000000

	#maxA=4999
	#maxB=5000

	NewList zahlen.q()
	AddElement(zahlen())
	zahlen()=0; bleibt am Listenende...

	found=0

	s.q=0
	a.q
	b.q

	a=0
	While a<#maxA
		a+1
		b=a
		s=a*a
		While b<#maxB
			b+1
			s+b*b
			If s<#Grenze
				If Palindrom(StrQ(s))
					FirstElement(zahlen())
					While (zahlen()<s) And (zahlen()>0)
						NextElement(zahlen())
					Wend
					If zahlen()<>s
						InsertElement(zahlen())
						zahlen()=s
					EndIf
				EndIf
			EndIf
		Wend
	Wend

	s=0
	If FirstElement(zahlen())
		Repeat
			a=zahlen()
			If (a>0) And (a<#Grenze)
				Debug a
				s+a
			EndIf
			NextElement(zahlen())
		Until a=0
	EndIf

	ShowResult(s)

EndProcedure

Problem_125()

I think, its quite interesting how many different approaches are possible - we are "only" three programmer and everyone found a (totaly) personal way to implement the thing

And btw I agree also, that precalculation (of squares etc) is not cheating, it's part of a strategy (and part of the total calculation time;)

Michael

PureBasic Forums - English

Project Euler...