Project Euler...

Michael Vogel · Post by **Michael Vogel** » Wed May 23, 2007 10:05 am

Trond wrote:Problem 60 looks fun, I will take a shot at it when I get home.

Have it now - but no chance to optimize the program for beeing fast enough to solve it in less a minute! Even when I made a limit to search only the solutions below 99999

Trond · Post by **Trond** » Wed May 23, 2007 11:06 am

I searched for solutions under 5000, but there weren't any. But there's not way it's going to take less than a minute.

Michael Vogel · Post by **Michael Vogel** » Thu May 24, 2007 8:12 am

Trond wrote:I searched for solutions under 5000, but there weren't any. But there's not way it's going to take less than a minute.

Oops - searching below 50000 (even 40000

) should be enough

the solution is definitely below that value!

But problem 60 is the last one I was able to solve for now: tried 61, 62 and 66, but both with wrong answers

, and I've no idea how to solve 64, 65 and 70

Trond · Post by **Trond** » Thu May 24, 2007 11:53 am

Michael Vogel wrote:
Trond wrote:I searched for solutions under 5000, but there weren't any. But there's not way it's going to take less than a minute.
Oops - searching below 50000 (even 40000 ) should be enough the solution is definitely below that value!

Did you mistake my 5000 for 50000?

Michael Vogel · Post by **Michael Vogel** » Thu May 24, 2007 2:26 pm

Trond wrote:Did you mistake my 5000 for 50000?

Sorry, didn't catch all zeros!

So I'll try it without "0" now: your program should have to go about 5 times further...

Michael Vogel · Post by **Michael Vogel** » Tue Jun 12, 2007 11:40 am

Where's the best math proggy?

I'm thinking about problem 88 and have already a solution...

...but it's wrong!

So who is able to code that

http://projecteuler.net/index.php?secti ... lems&id=88

mike74 · Post by **mike74** » Tue Jun 12, 2007 7:10 pm

Hi Michael,

I probably won't code a solution in real code but I think the way I would solve problem 88 is:

1.) Start at the lowest value that could possibly be a minimal product-sum number for the given k.
2.) Factor that value in every way possible.
3.) If for any of the factorizations the value is equal to the sum of the factors plus k minus the number of factors, you have found the minimal product-sum number for the given k.

Is it possible you have miscalculated the sum of the minimal product-sum numbers by not removing duplicates? In the problem statement it says "...note that 8 is only counted once in the sum."

By the way, I think http://projecteuler.net/index.php?section=view&id=88 might work better for link to the problem description.

Mike

Michael Vogel · Post by **Michael Vogel** » Wed Jun 13, 2007 12:27 pm

mike74 wrote:Hi Michael,

I probably won't code a solution in real code but I think the way I would solve problem 88 is:

1.) Start at the lowest value that could possibly be a minimal product-sum number for the given k.
2.) Factor that value in every way possible.
3.) If for any of the factorizations the value is equal to the sum of the factors plus k minus the number of factors, you have found the minimal product-sum number for the given k.

Is it possible you have miscalculated the sum of the minimal product-sum numbers by not removing duplicates? In the problem statement it says "...note that 8 is only counted once in the sum."

By the way, I think http://projecteuler.net/index.php?section=view&id=88 might work better for link to the problem description.

Mike

Hi Mike,
thanks for your ideas (and also for the link), I think, I did all right, but somewhere must be a bug inside the code...

The first part i just creating primes to do factorizing...

Code: Select all

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

	Procedure IsPrime(n.q)
		Protected i=1
		Protected d=2
		Protected Root=Sqr(n)

		If n=1
			ProcedureReturn #False
		Else
			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
		EndIf
	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()

Then the functions for building the factors (48=2*2*2*2*3) and building groups of factors (48=2*24, 3*16, 2*2*12, 4*12, 6*8,...)

Code: Select all

#MaxSumProds=12000
	Global NotFound=#MaxSumProds
	Global Dim Best(#MaxSumProds)

	#MaxNumber=25000
	#MaxFacts=15
	Global Dim Factor(#MaxNumber,#MaxFacts)
	Global Dim Group(#MaxFacts)
	Global Dim Solution.b(#MaxNumber)

	Global Product
	Global Result.q

	Procedure Factors()

		Protected n,m
		Protected p
		Protected i,j

		Factor(1,0)=1
		Factor(1,1)=1

		For m=2 To #MaxNumber

			n=m

			If IsPrime(n)
				Factor(n,0)=1
				Factor(n,1)=n
			Else

				i=1
				j=0
				Repeat
					p=PrimeCache(i)
					If n%p=0
						n/p
						j+1
						Factor(m,j)=p
						;If j>Overflow
						;	Overflow=j
						;	Debug -j
						;EndIf
					Else
						i+1
					EndIf
				Until n=1

				Factor(m,0)=j

			EndIf

		Next m
	EndProcedure
	Procedure GroupIt(n,g,s,z)

		Protected i
		Protected d.s
		Protected sg,ss,st

		If n

			If Group(n)=0

				Group(n)=g
				s+1

				If s=Factor(z,0)
					s=Factor(z,0)

					If Group(s)>1; mindestens zwei Faktoren...
						d=#TAB$
						For i=1 To s
							;d+Str(Factor(z,i))+":"+Str(Group(i))+"  "
							If Group(i)<>sg
								sg=Group(i)
								ss+st
								If st : d+Str(St)+#TAB$ : EndIf
								st=Factor(z,i)
							Else
								st*Factor(z,i)
							EndIf
						Next i
						ss+st
						If st : d+Str(St)+#TAB$ : EndIf

						If ss<=Product
							ss=Product-ss+Group(s)
							If ss<=#MaxSumProds
								If Best(ss)=0
									NotFound-1
									Best(ss)=z
									Debug Str(z)+#TAB$+Str(ss)+d
									If Solution(z)=#False
										Solution(z)=#True
										Result+z
									EndIf
								EndIf
							EndIf

						EndIf
					EndIf

				ElseIf n<Factor(z,0)

					GroupIt(n+1,g,s,z)
					Group(n+1)=0
					GroupIt(n+1,g+1,s,z)
					Group(n+1)=0

				EndIf
			EndIf

		Else

			For i=1 To Factor(z,0)
				Group(i)=0
			Next i
			For i=1 To Factor(z,0)
				GroupIt(i,1,0,z)
			Next i

		EndIf
	EndProcedure

And the main code...

Code: Select all

	Factors()

	Result=0

	n=1
	Repeat
		n+1

		f=Factor(n,0)
		If f>1

			Product=1
			For i=1 To f
				Product*Factor(n,i)
			Next i

			GroupIt(0,0,0,n)

		EndIf

	Until NotFound=1;		2,3,4,...n (keine Lösung für 1)

	debug Result

mike74 · Post by **mike74** » Sat Jun 16, 2007 11:38 pm

Michael,

I haven't really tried to understand your factoring code, but it seemed to be working properly so I tried to build a solution based on it (and loosely based on the rest of your work). However, the answer I came up with is wrong according to the website and I'm suspicious that the problem is in the factoring or the way the program loops through the groups of factors. Here is what I came up with:

Code: Select all

#MaxPrimeCache=100000
Global prevRes = 0
Global Dim PrimeCache.q(#MaxPrimeCache)
   Global PrimeCacheCount

   Procedure IsPrime(n.q)
      Protected i=1
      Protected d=2
      Protected Root=Sqr(n)

      If n=1
         ProcedureReturn #FALSE
      Else
         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
      EndIf
   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() 
   
   #MaxSumProds=12000
   Global NotFound=#MaxSumProds
   Global lastnf
   #MaxNumber=100000
   #MaxFacts=30
   Global Dim Factor(#MaxNumber,#MaxFacts)
   Global Dim Done(#MaxNumber, #MaxFacts)
   Global Dim Group(#MaxFacts)
   Global Dim Solution.b(#MaxNumber)

   Global Product
   Global Result.q

   Procedure Factors()

      Protected n,m
      Protected p
      Protected i,j

      Factor(1,0)=1
      Factor(1,1)=1

      For m=2 To 100000

         n=m

         If IsPrime(n)
            Factor(n,0)=1
            Factor(n,1)=n
         Else

            i=1
            j=0
            Repeat
               p=PrimeCache(i)
               If n%p=0
                  n/p
                  j+1
                  Factor(m,j)=p
                  ;If j>Overflow
                  ;   Overflow=j
                  ;   Debug -j
                  ;EndIf
               Else
                  i+1
               EndIf
            Until n=1

            Factor(m,0)=j

         EndIf

      Next m
   EndProcedure
   Procedure GroupIt(n,g,s,z)

      Protected i
      Protected d.s
      Protected sg,ss,st

      If n

         If Group(n)=0

            Group(n)=g
            s+1
            factCount = 0
            If s=Factor(z,0)
               If lastnf = NotFound
                  d=#TAB$
                  For i=1 To s
                     If Group(i)<>sg
                        sg=Group(i)
                        ss+st
                        If st : d+Str(St)+#TAB$  : factCount + 1
                        EndIf
                        st=Factor(z,i)
                     Else
                        st*Factor(z,i)
                     EndIf
                  Next i
                  ss+st
                  If st : d+Str(St)+#TAB$ : factCount + 1
                  EndIf

                  If Product=ss+prevRes-factCount
                           NotFound-1
                           If Solution(z)=#FALSE
                              Solution(z)=#TRUE
                           Debug Str(prevRes)+","+Str(z)+","+d
                               Result+z
                               Debug Result

                           EndIf
                      EndIf
                  EndIf

            ElseIf n<Factor(z,0)

               GroupIt(n+1,g,s,z)
               Group(n+1)=0
               GroupIt(n+1,g+1,s,z)
               Group(n+1)=0

            EndIf
         EndIf

      Else

         For i=1 To Factor(z,0)
            Group(i)=0
         Next i
         For i=1 To Factor(z,0)
            GroupIt(i,1,0,z)
         Next i

      EndIf
   EndProcedure 
   
   
   Factors()

   Result=0
   n=1
   Repeat
   lastnf = notFound
      n+1 : I = n
      prevRes = n
     Repeat
         I + 1
      f=Factor(I,0)
      If f>1 Or I < 5
         Product = I
         GroupIt(0,0,0,I)
      Else
            Product = I
      EndIf
     Until lastnf > notFound 

   Until n = 12000

   MessageRequester("answer", Str(Result))

mike74 · Post by **mike74** » Sun Jun 17, 2007 3:22 pm

Ok, I reviewed the factoring results in further depth and I don't see anything wrong with them. I edited the listing in my previous post -- added a few lines to reduce the number of computations (making lastnf global and checking it with an If statement). Still don't understand why the result is wrong...

Dreamland Fantasy · Post by **Dreamland Fantasy** » Mon Jun 18, 2007 12:36 pm

I've just stumbled across this thread. Looks really cool!

I guess I'll need to have a bash at some of those problems!

Kind regards,

Francis

Michael Vogel · Post by **Michael Vogel** » Tue Jun 19, 2007 10:00 am

I got it now

(88 was really the hardest problem for me...)

@mike74 factorizing worked, but the error has been in the procedure groupit()...

I've solved the first 100, some of them are really tricky (even more trickier than handling quad arrays in purebasic

) -- so everyone who needs a (very small) hint for a problem up to number 100 is welcome and lets start doing the next 100 problems...

Michael

Dreamland Fantasy · Post by **Dreamland Fantasy** » Fri Jun 22, 2007 12:25 am

Does anyone have any tips on how to (easily? :roll: ) use massive numbers in PureBasic?

I've written my own add, multiply and power routines (using strings), but they are painfully slow with the more complex problems and to be honest a little crude.

I read elsewhere in the forum that there was a big number library being produced, but that may have just been for 64-bit arithmetic before it was added natively to PureBasic.

It's quite frustrating to see some of the other people's code in the Project Euler forums using software that can do this natively.

Still, it's been quite a learning experience trying to solve some of the problems and optimise my algorithms so it only takes seconds rather than hours to solve!

I'm currently at 11% genius!

Kind regards,

Francis

Michael Vogel · Post by **Michael Vogel** » Fri Jun 22, 2007 10:22 pm

Dreamland Fantasy wrote:Does anyone have any tips on how to (easily? :roll: ) use massive numbers in PureBasic?

I've written my own add, multiply and power routines (using strings), but they are painfully slow with the more complex problems and to be honest a little crude.

I read elsewhere in the forum that there was a big number library being produced, but that may have just been for 64-bit arithmetic before it was added natively to PureBasic.

Hi Francis,

there's a Library (search for LibGmp-3.lib) for handling bignums, for the ProjectEuler for most of the problems it seems to be possible to solve them without using that library... but you have to work with quads very often!

I programmed also (some few) string functions: Add Sub Mul (and for one single problem) Sqrt - they are definitely slow (if you have faster routines, just show them

) - anyway most of the problems are done in some moments or some few seconds (when debugging is off :roll: ), I would say only about 5% of the problems need CPU time of 30 seconds or more.

Michael

Dreamland Fantasy · Post by **Dreamland Fantasy** » Sun Jun 24, 2007 1:11 am

Hi Michael,

Thanks for that. I have been trying to use quads where I can.

Sometimes it takes me a bit of thinking to figure out how to optimise the maths a little bit so that I can use quads and don't have to resort to working with strings. I've just optimised one of my solutions that was taking over an hour to complete down to under 20ms on my computer!

Kind regards,

Francis.