Project Euler...

Michael Vogel · Post by **Michael Vogel** » Wed May 09, 2007 2:11 pm

Hi,

one of my student has shown the web site http://projecteuler.net to me, there are nice math puzzles to solve...

I just started and did some codes (of course with Purebasic), most of them finishing in less a second...

But it gets more tricky now, maybe some other programmers like to solve the puzzles to and we can try to optimize the codes...

Have fun!

Michael

Derek · Post by **Derek** » Wed May 09, 2007 2:13 pm

Post some of your code and I'm sure others will jump in and start optimising.

JCV · Post by **JCV** » Wed May 09, 2007 2:29 pm

Thats interesting.
Now I have something to do while resting.

Rook Zimbabwe · Post by **Rook Zimbabwe** » Wed May 09, 2007 4:29 pm

I user Euler Angles to figure the stopping position of the wheels in my 3D slot machine... Too bad I have to wait for better 3D controls to recode it in PB. I have hopes for the leadwerks Lib. Irrlicht has a problem withthe textures for the wheels as they are not even but one LONG rectangle.

Come to think of it nVidia has problems with it too... ATi no probs. Which is WHY I wanted to recode it on PB...

Michael Vogel · Post by **Michael Vogel** » Wed May 09, 2007 8:39 pm

Here's my actual state - Problems 1 to 10...

*** reduced the examples to the first ten problems - everyone should try to find own solutions ***
Please only study the procedures of problems you have solved by your own! :roll:

And post your own solutions - new problems, faster and smart procedures are welcome!

Michael

Code: Select all

; --------------------------
; http://projecteuler.net
; --------------------------

; 156 math problems are listed there... I've done 50% for now ;)

; Please don't look at my solution until you've done you're own!
; As soon you solve a problem, post it - I'm quite sure a lot of you find better solutions!

; Have fun, Michael Vogel

; Define

	#Debugging=#False

	#MaxPrimeCache=5000
	Global Dim PrimeCache.q(#MaxPrimeCache)
	Global PrimeCacheCount

	Procedure IsPrime(n.q)
		Protected i=1
		Protected d=2
		Protected Root=Sqr(n)
		While d<=Root
			If n%d=0
				ProcedureReturn #False
			EndIf
			If i<PrimeCacheCount
				i+1
				d=PrimeCache(i)
			Else
				d+2
			EndIf
		Wend
		ProcedureReturn #True
	EndProcedure
	Procedure InitPrimeCache()
		Protected p.q
		PrimeCache(1)=2
		PrimeCacheCount=1

		p=1
		Repeat
			p+2
			If IsPrime(p)
				PrimeCacheCount+1
				PrimeCache(PrimeCacheCount)=p
			EndIf
		Until PrimeCacheCount=#MaxPrimeCache
	EndProcedure

	InitPrimeCache()

	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.s Normalize(zahl.s)
		If FindString(zahl,".",1)=0
			zahl+"."
		EndIf
		ProcedureReturn zahl
	EndProcedure
	Procedure.s AddLeadingZeros(zahl.s,n)
		ProcedureReturn LSet("",n,"0")+zahl
	EndProcedure
	Procedure.s AddTrailingZeros(zahl.s,n)
		ProcedureReturn zahl+LSet("",n,"0")
	EndProcedure
	Procedure.s StripZeros(zahl.s)
		Protected i=0
		Protected komma=FindString(zahl,".",1)

		If komma>2
			While (i<komma-2) And (PeekB(@zahl+i)='0')
				i+1
			Wend
			If i>0
				zahl=Mid(zahl,i+1,#MAXSHORT)
				komma-i
			EndIf
		EndIf
		i=Len(zahl)-1
		While (i>komma) And (PeekB(@zahl+i)='0')
			i-1
		Wend
		zahl=Left(zahl,i+1)
		ProcedureReturn zahl
	EndProcedure
	Procedure.s Add(a.s,b.s)

		Protected i
		Protected k
		Protected s
		Protected sum.s

		a=Normalize(a)
		b=Normalize(b)
		Protected komm_a=FindString(a,".",1)
		Protected komm_b=FindString(b,".",1)

		If komm_a>komm_b : Swap a,b : Swap komm_a,komm_b :EndIf

		a=AddLeadingZeros(a,komm_b-komm_a+1)
		b=AddLeadingZeros(b,1)

		Protected len_a=Len(a)
		Protected len_b=Len(b)

		If len_a<len_b
			a=AddTrailingZeros(a,len_b-len_a)
		Else
			b=AddTrailingZeros(b,len_a-len_b)
		EndIf

		i=Len(a)
		k=FindString(a,".",1)-1
		s=0
		sum=Space(i)

		While i
			i-1
			If i=k
				PokeB(@sum+i,'.')
			Else
				s+PeekB(@a+i)+PeekB(@b+i)-96
				PokeB(@sum+i,s%10+48)
				s=s/10
			EndIf
		Wend

		ProcedureReturn StripZeros(sum)
	EndProcedure

	Procedure.q Fact(n.q)
		Protected i=n
		While i>2
			i-1
			n*i
		Wend
		ProcedureReturn n
	EndProcedure

	Global Dim Chain(1000000)
	Procedure.l NoChain(i.q)
		If i>1000000
			ProcedureReturn #True
		ElseIf Chain(i)
			ProcedureReturn #False
		Else
			ProcedureReturn #True
		EndIf
	EndProcedure

	Procedure Stopuhr(n)
		Global Timer=GetTickCount_()
		Global Problemcode=n
	EndProcedure
	Procedure ShowString(x.s)
		If #Debugging
			Debug "Problem "+Str(Problemcode)+" = "+x
		Else
			MessageRequester("Calc time "+Str(GetTickCount_()-Timer)+"ms","Problem "+Str(Problemcode)+#CR$+"= "+x)
			SetClipboardText(x)
		EndIf
	EndProcedure
	Procedure ShowResult(x.q)
		If #Debugging
			Debug "Problem "+Str(Problemcode)+" = "+StrQ(x)
		Else
			MessageRequester("Calc time "+Str(GetTickCount_()-Timer)+"ms","Problem "+Str(Problemcode)+#CR$+"= "+StrQ(x))
			SetClipboardText(StrQ(x))
		EndIf
	EndProcedure

; EndDefine

Procedure Problem_1()
	; If we list all the natural numbers below 10 that are multiples of 3 Or 5, we get 3, 5, 6 And 9. The sum of these multiples is 23.
	; Find the sum of all the multiples of 3 Or 5 below 1000.

	Stopuhr(1)
	s=0
	For i=1 To 999
		If (i%3=0) Or (i%5=0)
			s+i
		EndIf
	Next i
	ShowResult(s); 233168

EndProcedure
Procedure Problem_2()
	; Each new term in the Fibonacci sequence is generated by adding the previous two terms. By starting With 1 And 2, the first 10 terms will be:
	; 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
	; Find the sum of all the even-valued terms in the sequence which do Not exceed one million.

	Stopuhr(2)
	s=2
	a=1
	b=1
	c=0
	Repeat
		a+b+b
		b=-b
		b+a<<1
		c=a+b
		If c<1000000
			s+c
		Else
			Break
		EndIf
	ForEver
	ShowResult(s); 1089154

EndProcedure
Procedure Problem_3()
	; The prime factors of 13195 are 5, 7, 13 And 29.
	; What is the largest prime factor of the number 317584931803?

	Stopuhr(3)

	zahl.q=317584931803
	teiler.q=2
	maxteiler.q=0

	While zahl>1
		If zahl%teiler=0
			zahl/teiler
			maxteiler=teiler
		Else
			teiler+1
		EndIf
	Wend
	ShowResult(maxteiler); 3919

EndProcedure
Procedure Problem_4()
	; A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91  99.
	; Find the largest palindrome made from the product of two 3-digit numbers.


	Stopuhr(4)

	t.s=""
	max=0

	For i=1 To 999
		For j=1 To 999
			n=i*j
			If n>max
				If Palindrom(Str(n))
					maxi=i
					maxj=j
					max=n
				EndIf
			EndIf
		Next j
	Next i
	ShowResult(max); 906609

EndProcedure
Procedure Problem_5()
	; 2520 is the smallest number that can be divided by each of the numbers from 1 To 10 without any remainder.
	; What is the smallest number that is evenly divisible by all of the numbers from 1 To 20?

	Stopuhr(5)
	ShowResult(19*17*16*13*11*9*7*5); 232792560

EndProcedure
Procedure Problem_6()
	; The sum of the squares of the first ten natural numbers is,
	; 1² + 2² + ... + 10² = 385

	; The square of the sum of the first ten natural numbers is,
	; (1 + 2 + ... + 10)² = 55² = 3025

	; Hence the difference between the sum of the squares of the first ten natural numbers And the square of the sum is 3025  385 = 2640.
	; Find the difference between the sum of the squares of the first one hundred natural numbers And the square of the sum.

	Stopuhr(6)

	For i=1 To 100
		s+i*i
		t+i
	Next i

	ShowResult(t*t-s); 25164150

EndProcedure
Procedure Problem_7()
	; By listing the first six prime numbers: 2, 3, 5, 7, 11, And 13, we can see that the 6th prime is 13.
	; What is the 10001st prime number?

	Stopuhr(7)

	c=0
	p.q=1

	While c<10001
		p+1
		If IsPrime(p)
			c+1
		EndIf

	Wend
	ShowResult(p); 104743

EndProcedure
Procedure Problem_8()
	; Find the greatest product of five consecutive digits in the 1000-digit number.
	; 73167176531330624919225119674426574742355349194934
	; 96983520312774506326239578318016984801869478851843
	; 85861560789112949495459501737958331952853208805511
	; 12540698747158523863050715693290963295227443043557
	; 66896648950445244523161731856403098711121722383113
	; 62229893423380308135336276614282806444486645238749
	; 30358907296290491560440772390713810515859307960866
	; 70172427121883998797908792274921901699720888093776
	; 65727333001053367881220235421809751254540594752243
	; 52584907711670556013604839586446706324415722155397
	; 53697817977846174064955149290862569321978468622482
	; 83972241375657056057490261407972968652414535100474
	; 82166370484403199890008895243450658541227588666881
	; 16427171479924442928230863465674813919123162824586
	; 17866458359124566529476545682848912883142607690042
	; 24219022671055626321111109370544217506941658960408
	; 07198403850962455444362981230987879927244284909188
	; 84580156166097919133875499200524063689912560717606
	; 05886116467109405077541002256983155200055935729725
	; 71636269561882670428252483600823257530420752963450

	Stopuhr(8)

; ATTENTION - you have to put the following lines together:

	t.s="731671765313306249192251196744265747423553491...
949349698352031277450632623957831801698480186947885184385861...
560789112949495459501737958331952853208805511125406987471585...
238630507156932909632952274430435576689664895044524452316173...
185640309871112172238311362229893423380308135336276614282806...
444486645238749303589072962904915604407723907138105158593079...
608667017242712188399879790879227492190169972088809377665727...
333001053367881220235421809751254540594752243525849077116705...
560136048395864467063244157221553975369781797784617406495514...
929086256932197846862248283972241375657056057490261407972968...
652414535100474821663704844031998900088952434506585412275886...
668811642717147992444292823086346567481391912316282458617866...
458359124566529476545682848912883142607690042242190226710556...
263211111093705442175069416589604080719840385096245544436298...
123098787992724428490918884580156166097919133875499200524063...
689912560717606058861164671094050775410022569831552000559357...
2972571636269561882670428252483600823257530420752963450"

	max=0
	For i=0 To 994
		m=(PeekB(@t+i)-48)*(PeekB(@t+i+1)-48)*(PeekB(@t+i+2)-48)*(PeekB(@t+i+3)-48)*(PeekB(@t+i+4)-48)
		If m>max
			max=m
			;Debug i
			;Debug PeekB(@t+i)-48
			;Debug PeekB(@t+i+1)-48
			;Debug PeekB(@t+i+2)-48
			;Debug PeekB(@t+i+3)-48
			;Debug PeekB(@t+i+4)-48
			;Debug "---------"
		EndIf
	Next i
	ShowResult(max); 40824

EndProcedure
Procedure Problem_9()
	; A Pythagorean triplet is a set of three natural numbers, abc, For which a² + b² = c²
	; For example, 3² + 4² = 9 + 16 = 25 = 5².

	; There exists exactly one Pythagorean triplet For which a + b + c = 1000.
	; Find the product abc.

	Stopuhr(9)

	For a=1 To 997
		For b=a+1 To 999-a
			c=1000-a-b
			If a*a+b*b=c*c
				;Debug Str(a)+"² + "+Str(b)+"² = "+Str(c)+"²"
				ShowResult(a*b*c); 31875000
			EndIf
		Next b
	Next a

EndProcedure
Procedure Problem_10()
	; The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
	; Find the sum of all the primes below one million.

	Stopuhr(10)

	s.q=2
	p.q=3
	Repeat
		If IsPrime(p)
			s+p
		EndIf
		p+2
	Until p>=1000000

	ShowResult(s); 37550402023

EndProcedure

Trond · Post by **Trond** » Wed May 09, 2007 9:08 pm

Nice site, thanks for posting it!

More than 7 times faster than yours for problem 1:

Code: Select all

; Problem 1
Z = 0
For I = 3 To 999 Step 3
  Z + I
Next
For I = 5 To 999 Step 5
  If i%3 <> 0
    Z + I
  EndIf
Next
Debug Z

; Problem 2 (I can't get it as fast as yours)
z.l = 0
a.l = 0
b.l = 1
c.l = 0
Repeat
  a = b + c
  c = b
  b = a
  If (a & 1) = 0
    z + a
  EndIf
Until a > 1000000
Debug Z

Edit: Your very long string is stretching the tables, can you split it for the post?

Rook Zimbabwe · Post by **Rook Zimbabwe** » Thu May 10, 2007 2:51 am

Simply... WOW!

Great work!!!

Derek · Post by **Derek** » Thu May 10, 2007 9:50 am

Problem one

Michael Vogel=1562
Trond=578 (only 3 times faster!)
Mine=469

Code: Select all

l=10000
t=ElapsedMilliseconds()
For m=1 To l
  s=0
  For i=1 To 999
    If (i%3=0) Or (i%5=0)
      s+i
    EndIf
  Next i
Next
Debug s
Debug ElapsedMilliseconds()-t
Debug ""
t=ElapsedMilliseconds()
For m=1 To l
  Z = 0
  For I = 3 To 999 Step 3
    Z + I
  Next
  For I = 5 To 999 Step 5
    If i%3 <> 0
      Z + I
    EndIf
  Next
Next
Debug z
Debug ElapsedMilliseconds()-t
Debug ""

t=ElapsedMilliseconds()
For m=1 To l
  z=0
  For I = 3 To 999 Step 3
    Z + I
  Next
  For I = 5 To 999 Step 5
    Z + I
  Next
  For i=15 To 999 Step 15
    z-i
  Next
Next
Debug z
Debug ElapsedMilliseconds()-t

Derek · Post by **Derek** » Thu May 10, 2007 10:41 am

Problems 2 and 3, cant get anywhere close.

Problem 4
Michael Vogel=2329
Mine=46 (50 times quicker!!)

Code: Select all

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

l=10
ti=ElapsedMilliseconds()
For m=1 To l
  t.s=""
  max=0
  For i=1 To 999
    For j=1 To 999
      n=i*j
      If n>max
        If Palindrom(Str(n))
          maxi=i
          maxj=j
          max=n
        EndIf
      EndIf
    Next j
  Next i

Next
ti=ElapsedMilliseconds()-ti
Debug max
Debug ti
Debug ""

l=10
ti=ElapsedMilliseconds()
For m=1 To l
  h=0
  For q=999 To 1 Step -1
    For w=999 To 1 Step-1
      e=q*w
      If e>h
        p$=Str(e)
        l=Len(p$)
        l2=l/2
        f=0
        For b=1 To l2
          If Mid(p$,b,1)<>Mid(p$,l-b+1,1)
            f=1
            Break
          EndIf
        Next
        If f=0
          h=e
          Break
        EndIf
      Else
        Break
      EndIf
    Next
  Next

Next
ti=ElapsedMilliseconds()-ti
Debug h
Debug ti

Trond · Post by **Trond** » Thu May 10, 2007 3:11 pm

Derek, don't do speed testing with the debugger enabled.

Michael Vogel · Post by **Michael Vogel** » Thu May 10, 2007 8:44 pm

Hey - cool!

Nice to see that you also like these type of puzzles

The slowest procedure (for now) is my "Add" function, maybe someone is able to tune it?

@Trond: sorry 'bout the long text lines, I just did a copy and paste from the original web pages (only modified unreadable chars)... Will do a word wrap in the future!

@All - have you already solved some problems I didn't? - hopefully I'll have some time next weekend to solve also some more

Michael

Derek · Post by **Derek** » Fri May 11, 2007 12:10 am

I figured that the speed testing with the debugger on was ok seeing as all the routines were being tested at the same time. I know it makes a difference but in theory they will all increase at the same percentage so it shouldn't matter.

Michael Vogel · Post by **Michael Vogel** » Fri May 11, 2007 7:15 am

Theory and practical experience have not to be exact the same

These can be easily checked comparing the timing results (especially on short time running code) and therefore I am also using the MessageRequester in the ShowResult procedure...

...but even then a lot of different results can be seen depending which process (of windows) takes some more percent of the cpu load (and maybe also the moon phase is important how long it takes until a program will finsh

)

Trond · Post by **Trond** » Fri May 11, 2007 8:54 am

Derek wrote:I figured that the speed testing with the debugger on was ok seeing as all the routines were being tested at the same time. I know it makes a difference but in theory they will all increase at the same percentage so it shouldn't matter.

Your theory is wrong. If I use a native PB function then it's not compiled with the debugger because it's precompiled. If I write my own function to do the same thing but slightly faster it will be much slower with the debugger enabled since it will be checked by the debugger.

Derek · Post by **Derek** » Fri May 11, 2007 9:12 am

Ok, fair enough. I ran it again with messagerequestor() and a loop of 100000 (I think it was, whatever) and the results are

MV 25016
Trond 3750
me 1791

So, yes Trond you were right and I do apologise most sincerely for doubting your stated speed increase.

Edit. Running problem 4 without debugger, 1000 times MV's time is 20171 and mine is 15 so now it is 1344 times as fast!!