Project Euler...

Everything else that doesn't fall into one of the other PB categories.
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Re: And now #154...

Post by Dreamland Fantasy »

Michael Vogel wrote:But also here I've some problems as well:

1) the modulo function return negative numbers (to check that, just remove the semicolon before the %#modulo statements)
2) the dim does not allow to build up such a huge array needed to calc the results
You may be able to use Lists instead of Dims. Here is some code I very quickly knocked up as an example:

Code: Select all

#TestListWidth = 10

Global NewList TestList()

Procedure TestListPosition(x, y)
  SelectElement(TestList(), x + y * #TestListWidth)
  ProcedureReturn TestList()
EndProcedure

For i = 0 To 10 * #TestListWidth - 1
  AddElement(TestList())
  TestList() = i
Next

Debug TestListPosition(2, 3)
Kind regards,

Francis.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: And now #154...

Post by Michael Vogel »

Dreamland Fantasy wrote:You may be able to use Lists instead of Dims. Here is some code I very quickly knocked up as an example:
[...]
Thanks, Francis

maybe the word "lists" is the right hint, I think, the problem has to be reduced from two to one dimension. Otherwise I need (at least) one array (or list) of 4.000.000 quad elements, this means 12GB! My method would need even three times more :(

So I am searching for a way to summarize the values around each triangle to a single one on a single vector (output at the and of my procedure), this would reduce the whole story to some thousand values --
but for now I've not found a simple function doing that...

Michael
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Post by Dreamland Fantasy »

I was wondering if there was a faster way of working out Euler's Totient (Phi) than what I am currently using.

Here is the code that I came up with:

Code: Select all

Procedure Phi(n.q)
  
  Protected i, j, coprime, count = 1
  
  If IsPrime(n)
    ProcedureReturn n - 1
  EndIf

  For i = 2 To n >> 1
    If n % i
      coprime = 1
      For j = 2 To i >> 1
        If i % j = 0
          If n % j = 0
            coprime = 0
            Break
          EndIf
        EndIf
      Next
      If coprime
        count + 1
      EndIf
    EndIf
  Next
  
  ProcedureReturn count << 1
  
EndProcedure
I did have a version that took the square root of i for the 'For j =' loop, but this ended up introducing some erroneous co-primes.

Kind regards,

Francis
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Post by Dreamland Fantasy »

In case anyone is interested I've redone my Permutation() function which gives a slight performance increase:

Code: Select all

Procedure.s Permutation(String$, n)
  
  Protected i, Factorial = 1, Temp
  
  For i = 2 To Len(String$)
    Factorial * (i - 1)
    *n1.Byte = @String$ + (i - ((n / Factorial) % i) - 1)
    *n2.Byte = @String$ + i - 1
    Temp = *n1\b
    *n1\b = *n2\b
    *n2\b = Temp
  Next
  
  ProcedureReturn String$
  
EndProcedure
Kind regards,

Francis.
User avatar
pdwyer
Addict
Addict
Posts: 2813
Joined: Tue May 08, 2007 1:27 pm
Location: Chiba, Japan

Post by pdwyer »

thanks :)
Paul Dwyer

“In nature, it’s not the strongest nor the most intelligent who survives. It’s the most adaptable to change” - Charles Darwin
“If you can't explain it to a six-year old you really don't understand it yourself.” - Albert Einstein
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Post by Dreamland Fantasy »

pdwyer wrote:thanks :)
No probs. :wink:

Kind regards,

Francis.
User avatar
Demivec
Addict
Addict
Posts: 4260
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Post by Demivec »

I finally worked around the bugs in PureBasic Quads to finish #143, Hoorah! :D
That's the number of the problem and not my place number. :wink:

It's been a while in the making. The solution was found using only integers and quads kept returning incorrect results until I broke up equations that used quad-return values from procedures into separate parts and then combined the parts back together. What a pain, when the math is right and the result is wrong. :shock:
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Post by Dreamland Fantasy »

Demivec wrote:I finally worked around the bugs in PureBasic Quads to finish #143, Hoorah! :D
That's the number of the problem and not my place number. :wink:

It's been a while in the making. The solution was found using only integers and quads kept returning incorrect results until I broke up equations that used quad-return values from procedures into separate parts and then combined the parts back together. What a pain, when the math is right and the result is wrong. :shock:
Congrats on completing that one. I've only looked at it briefly, but have made no attempt to try it yet.

I agree with you that it is annoying when your theory is correct, but the results are wrong due to the numerical limitations of the software. There have been a few problems where I was sure that my theory was correct, but started doubting myself because I was constantly getting incorrect results until realising that I was the victim of numerical overflow!

Kind regards,

Francis.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Hi Demivec, great job :!:

Will have a look at this one, hopefully I'm able to get also the right solution.

BTW how long was the calculation time (and how long your brain work :wink:) for solving this puzzle?

Michael
User avatar
Dreamland Fantasy
Enthusiast
Enthusiast
Posts: 335
Joined: Fri Jun 11, 2004 9:35 pm
Location: Glasgow, UK
Contact:

Post by Dreamland Fantasy »

I've stumbled upon a faster way of pre-calculating primes than Michael's routine:

Code: Select all

#MaxPrimeCache=664580 ; Does upto 10 million
Global Dim PrimeCache.q(#MaxPrimeCache)
Global PrimeCacheCount

; Michael's original routine

Procedure IsPrime(n.q)
  Protected i=1
  Protected d=2
  Protected Root
  
  If n=1
    ProcedureReturn #False
  ElseIf n&1=0
    ProcedureReturn #False
  Else
    Root=Sqr(n)
    While d<=Root
      If n%d=0
        ProcedureReturn #False
      EndIf
      If i<PrimeCacheCount
        i+1
        d=PrimeCache(i)
      Else
        d+(9-d%6)>>1; (c) by me!
      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

; New routine

Procedure InitPrimeCache2(n.q = 10000000)
    
    Protected Dim P.q(n), i.q, j.q
    
    While i <= n
      P(i) = 1
      i + 1
    Wend

    i = 2
    While i <= n
      If P(i)
        PrimeCache(PrimeCacheCount) = i
        PrimeCacheCount + 1
        j = i << 1
        While j <= n
          P(j) = 0
          j + i
        Wend
      EndIf
      i + 1
    Wend
    
EndProcedure

StartTime = GetTickCount_()
InitPrimeCache()
TimeElapsed1 = GetTickCount_()-StartTime  

PrimeCacheCount = 0

StartTime = GetTickCount_()
InitPrimeCache2()
TimeElapsed2 = GetTickCount_()-StartTime  

text$ = "Michael's routine: " + Str(TimeElapsed1) + "ms" + Chr(10)
text$ + "New routine: " + Str(TimeElapsed2) + "ms"  + Chr(10) + Chr(10)
text$ + "Speed up: " + StrF(TimeElapsed1 / TimeElapsed2, 3) + "x"

MessageRequester("", text$)
One thing with the new routine is you need to specify a maximum (I've used 10 million as a default). This could be handy if you are only wanting to cache primes up to a certain value.

Kind regards,

Francis.

EDIT: Revised the code a bit.
Last edited by Dreamland Fantasy on Sun Sep 16, 2007 6:25 pm, edited 4 times in total.
User avatar
Demivec
Addict
Addict
Posts: 4260
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Post by Demivec »

Michael Vogel wrote:BTW how long was the calculation time (and how long your brain work Wink) for solving this puzzle?
My brain worked a long time as I tried several different methods to solve it. I even made a program to visuasize a partial triangle. Most of of the methods failed due to limitations such as overflow-of-variables. My solution used only integers. It ran for less than a millisecond.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Demivec wrote:My brain worked a long time as I tried several different methods to solve it. I even made a program to visuasize a partial triangle. Most of of the methods failed due to limitations such as overflow-of-variables. My solution used only integers. It ran for less than a millisecond.
Seems that both of you did a good job :lol:

PS I just did a print out of the drawing so maybe I'll find a clue how to start with (integers? only integers??)
Bonne_den_kule
Addict
Addict
Posts: 841
Joined: Mon Jun 07, 2004 7:10 pm

Post by Bonne_den_kule »

Here is my solution of problem 10:

Code: Select all

EnableExplicit
Dim PrimeNumbers.l(100000)
Define Sum.q=5, Number.l=5, Prime.l, Index.l=2, i.l, StartTime.l=ElapsedMilliseconds()
PrimeNumbers(0)=2
PrimeNumbers(1)=3

While Number.l<1000000
  i=0
  Repeat
    If Number%PrimeNumbers(i)=0
      Break 1
    ElseIf PrimeNumbers(i+1)>Int(Sqr(number))
      PrimeNumbers(Index)=Number
      Sum+Number
      Index+1
      Prime.l=Number
      Break 1
    EndIf 
    i+1
  ForEver
  Number+2  
Wend

MessageRequester("Result", "Prime: "+Str(Prime)+", Sum: "+StrQ(Sum)+", time elapsed: "+Str(ElapsedMilliseconds()-StartTime))  
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Hi Bonne_den_kule,

welcome to the show :wink:

Michael
michaeled314
Enthusiast
Enthusiast
Posts: 340
Joined: Tue Apr 24, 2007 11:14 pm

Post by michaeled314 »

Code: Select all

Procedure.s Permutation(String$, n)
 
  Protected i, Factorial = 1, Temp
 
  For i = 2 To Len(String$)
    Factorial * (i - 1)
    Temp = PeekB(@String$ + (i - ((n / Factorial) % i) - 1))
    PokeB(@String$ + (i - ((n / Factorial) % i) - 1), PeekB(@String$ + i - 1))
    PokeB(@String$ + i - 1, Temp)
  Next
 
  ProcedureReturn String$
 
EndProcedure

Dim Permu.q(1000000)

For i = 1 To 1000000
 Permu.q(i) = Val(Permutation("0123456789",i))
Next

SortArray(Permu.q(),0)
Debug Permu.q(1000000)
Problem 24 what am I doing wrong
Post Reply