Project Euler - Aufgabe 586 (Wettbewerb)

Für allgemeine Fragen zur Programmierung mit PureBasic.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von GPI »

bei den Prozessoren tut sich ja nichts weiter :)

Aber mein Code ist schlicht immer noch viel zu langsam für 10^15. Aktuell 0.00% und 200 Minuten laufen gelassen. Und die Zeit nimmt ja eher zu als ab. der müsste 3 wochen durchrechnen....

Irgendwo muss es einen Trick geben, wie man das ganze beschleunigen kann. Ich hab aber keine Ahnung wie wo was.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von GPI »

ich hab jetzt nics code auf Speichereffizenz umgeschrieben

Code: Alles auswählen

Macro func(a, b)
  ((a) * (a) + 3 * (a) * (b) + (b) * (b))
EndMacro

OpenConsole()
PrintN(#PB_Compiler_Filename)

n = Pow(10,6)
r = 6

; Zeit
time = ElapsedMilliseconds()

; Obergrenze für a
maxA = (Sqr(4 * n + 5) - 3) / 2
PrintN("N="+n)
PrintN("MaxA="+maxA)


; Häufigkeit von k
Structure count
  value.q
  count.i
EndStructure

NewList counts.count()
AddElement(counts())
counts()\value=n
counts()\count=0

; Alle Kombinationen von a > b > 0 durchgehen
result=0


kA = 1     ; 1² + 3 * 1 * 0 + 0²
For a = 2 To maxA
  If a%100=0
    PrintN(" "+a+" "+StrF(a/maxa*100,2)+"%  "+Str(ListSize(counts()))+" Speicher Result:"+result)
  EndIf
  
  kA + a + a - 1
  a3 = 3 * a
  k = kA
  
  ;Einträge unter ka können nicht mehr dazu kommen, können ausgewertet und gelöscht werden.
  ResetList(counts())
  limit=ka+1+1+a3-1
  While NextElement(counts()) And counts()\value<limit
    If counts()\count=r
      result+1
    EndIf
    DeleteElement(counts())
  Wend
  
  
  For b = 1 To a - 1
    k + b + b + a3 - 1
    If k > n   ;maxA reicht nicht aus um sicherzugehen, dass k <= n bleibt
      Break
    EndIf
    
    ;Liste hochhangeln
    While counts()\value<k And NextElement(counts());zweite Bedingung wird nur überprüft, wenn erste gültig ist.
    Wend
    
    ;neues Element?
    If counts()\value>k
      InsertElement(counts())
      counts()\value=k
    EndIf
        
    ;Debug "try: " + k + "  correct: " + Str(func(a, b)) + "  a:" + a + " b:" + b
    counts()\count + 1
  Next
Next

; Filtern nach Häufigkeit (r) und Zählen
ForEach counts()
  If counts()\count = r
    result + 1
  EndIf
Next
Debug ListSize(counts())

time = ElapsedMilliseconds() - time

MessageRequester("Ergebnis", "n = " + n + #LF$ + "r = " + r + #LF$ + "f(n, r) = " + result + #LF$ + #LF$ + "Zeit: " + time + " ms")
;Debug result
Der Trick hier ist, das alle Zwischenergebnisse rausgeschmissen werden, die nicht mehr hochgezählt werden, weil a^2 das untere Limit darstellt.
Problem: Würde immer noch zu viel Speicher brauchen und zu langsam....
man müsste die Reihenfolge irgendwie ändern, das nicht stumpf a und b hochgezählt werden, sondern so, das als erstes die niedrigsten berechnet werden - damit möglichst wenig zwischenergebnise rauskommen...
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
helpy
Beiträge: 636
Registriert: 29.08.2004 13:29

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von helpy »

My solution, but too slow :-( ... it takes about 280 ms for f(10^5,4) on my PC

Code: Alles auswählen

Procedure Euler_586(n,r)
	Protected solution
	Protected a, b, k, a2
	Protected a_max
	Protected rk
	Protected kMod2

	; a = 2, b = 1 ==> k = 11
	For k = 11 To n
		kMod2 = Bool( Not k % 2 )
		rk = 0
		a_max = Int( -1.5 + Sqr(1.25 + k) )
		For a = a_max To 2 Step - 1
			; if k is even, a and b also has to be even
			If kMod2 And a % 2 : Continue : EndIf
			a2 = a*a
			b = Int( -1.5*a + Sqr(1.25*a2 + k) )
			If b >= a : Break : EndIf
			If k = a2 + (3*a + b)*b
				rk + 1
				If rk > r : Break : EndIf
			EndIf
		Next a
		If rk = r :  solution + 1 : EndIf
	Next k

	ProcedureReturn solution
EndProcedure
Windows 10
PB Last Final / (Sometimes testing Beta versions)
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von GPI »

Ich glaub ich hab eine brauchbare Lösung:

Code: Alles auswählen

n=Pow(10,15)
r=6


OpenConsole()
PrintN(#PB_Compiler_File)

Structure limits
  currentValue.q
  b.i
EndStructure

maxa=IntQ((-1.5 + Sqr(1.25+n))) 

PrintN("maxA:"+maxa)
PrintN("r:"+r)


Dim limits.limits(maxa)
NewMap count(maxa/2);wir brauchen nicht mal die hälfte

amin=2

Debug maxa

timer=ElapsedMilliseconds()
timerx=ElapsedMilliseconds()+5000

result=0

For aup=2 To 19
  limits(aup)\currentValue=aup*aup+3*aup*1+1*1
  limits(aup)\b=1
Next

For aup=20 To maxa+1;obere filtergrenze a definieren
  If ElapsedMilliseconds()>timerx
    timerx=ElapsedMilliseconds()+5000
    speed.d=aup/((ElapsedMilliseconds()-timer)/1000)
    eta.d=(maxa+1-aup)/speed+((ElapsedMilliseconds()-timer)/1000)
    PrintN( ""+aup+" ("+StrF(aup/maxa*100,2)+"%) "+StrF((ElapsedMilliseconds()-timer)/60000,2) +" Min result:"+result+" amin:"+amin+" delta:"+Str(aup-amin)+" maxcount:"+maxcount+" speed:"+StrF(speed,2)+" a pro sek rest:"+StrF(eta/60/60,2)+" Stunden")
  EndIf
   
  alimit=aup*aup+3*aup*1+1*1 ;unter diesen wert müssen wir bleiben
  limits(aup)\currentValue=alimit
  limits(aup)\b=1
  
  
  
  For a=amin To aup-1 
    If a=amin And limits(a)\currentValue=-1
      amin+1;wir können zukünftig dieses a ignorieren, weil es komplett überprüft wurde.
      
    ElseIf limits(a)\currentValue<alimit
      count(Str(limits(a)\currentValue))+1
      limits(a)\currentValue=-1;wir setzen einfach ein "erledigt" flag
      
      ka=a*a
      
      For b=limits(a)\b+1 To a-1
        k=ka+3*a*b+B*B
        
        ;Wert überhaupt gültig? nein -> abbruch
        If k>n
          Break
          
          ;wert kleiner als unser gewähltes Limit?  
        ElseIf k<alimit
          count(Str(k))+1
          
          ;wert zu groß -> wert merken und aufhören  
        Else
          limits(a)\b=b
          limits(a)\currentValue=k
          Break
        EndIf        
      Next
    EndIf   
  Next
  
  ForEach count()
    If count()=r
      result+1
    EndIf
  Next
  If MapSize(count())>maxcount 
    maxcount=MapSize(count())
  EndIf
  
  
  ;Debug MapSize(count())
  
  
  ClearMap(count())
  
  
  
Next

PrintN("maxcount:"+maxcount)
PrintN( "Ergebnis:"+result+"  "+StrF((ElapsedMilliseconds()-timer)/60000)+"m")
Input()

End
Mein Trick ist, das ich nicht den kompletten Block durchrechne, sondern ich setze Grenzen und berechne berechne quasi abschnittsweise.
10^15 hab ich noch nicht durchgerechnet, das dürfte trotz allen laaaaange dauern (schätzung grob 300 Stunden!). Werd ich mal morgen früh starten, wenn ich zur Arbeit gehe. Eventuell gibts noch ein Wunder :)
Ich würde ja gerne eine Thread-Lösung einbauen, leider nicht so ganz einfach.... Besonders wenn die Verwaltung nicht mehr Resourcen kosten sollen als nutzen :)

Speicher wird so grob 600mb gebraucht - eventuell ein bischen mehr. Sollten also auch ältere Rechner damit klar kommen. 64Bit ist allerdings Pflicht.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8820
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von NicTheQuick »

Hab grad erst gemerkt, dass ich deinen ersten Code noch im Hintergrund in einem einsamen Konsolenfenster laufen hatte. Er hat bei mir 100,77 Minuten gebraucht. Das Standby zwischendurch hab ich raus gerechnet.

Ansonsten muss ich mal schauen, dass ich da auch mal weiter bastle. Hab schon Lust drauf. Muss nur Zeit finden.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von GPI »

Ich habe Feuer gemacht :)
primär hab ich das Array durch einen eigenen Speicherblock ersetzt und die Map durch eigene Routinen. Map sind bei den Größenordnungen einfach zu langsam, besonders weil mit strings gearbeitet wird. weiterer Vorteil ist, das der Speicher nicht immer freigegeben und neu belegt werden muss.

Aktuell gönnt sich das Programm über 2 GB für die Berechnung, kann aber in der Zeile

Code: Alles auswählen

buffersize=maxa*5+10000
geändert werden, bspw. auf buffersize=maxa+10000 . ich wähle den Speicher nur so groß, damit sich Kollisionen leichter vermeiden lassen.

Eine Lösung mit Threads hab ich leider nicht gefunden. Alle Experimente schlugen schlicht fehl. Es war einfach langsamer anstatt schneller...

Aktuell braucht das Ding bei mir grob 15% Prozessorauslastung und hat nach 10 Minuten bereits 0.75% durchgerechnet.

Hat wer einen Rechner, der 24/7 läuft und könnte das Programm laufen lassen? <liebguck> ;)

Code: Alles auswählen

EnableExplicit
Structure limits
  currentValue.q
  b.i
  a3.i
EndStructure
Structure counts
  value.q
  count.i
EndStructure
Structure index
  *count.counts
EndStructure
Define amin,maxa,aup,oldaup,alimit,aoldlimit
Define timer,oldtimer
Define result,i
Define a,b,k
Define speed.d,eta.d
Define maxcount
Define *limits.limits,*alimit.limits,*aminlimit.limits,*lim.limits
Define buffersize
Define *counts.counts,*currentcount.counts
Define *index.index,*writeindex.index

;   123456789012345
#n=1000000000000000
#r=6

;Ergebnis:124880  0.1599833369m
;Ergebnis:124880  0.1577833295m
;Ergebnis:124881  0.0234500002m
;Ergebnis:124880  0.0248333327m



#setdone=9223372036854775807

OpenConsole()
PrintN(#PB_Compiler_File)

maxa=IntQ((-1.5 + Sqr(1.25+#n))) 


buffersize=maxa*5+10000;eigentlich wurde maxa/2+10000 reichen, aber um Kollisionen zu vermeiden größer
*counts=AllocateMemory(SizeOf(counts)*(buffersize+1))
If *counts=0
  PrintN("Speicherfehler counts")
  Input()
  End
EndIf

*index=AllocateMemory(SizeOf(index)*(buffersize+1))
If *index=0
  PrintN("Speicherfehler index")
  Input()
  End
EndIf

*currentcount=*counts+SizeOf(counts)*buffersize
*currentcount\value=#setdone ;endmarkierung

Macro addcount(i)
  *currentcount=*counts+((i)%buffersize)*SizeOf(counts)
  Repeat
    If *currentcount\value=i
      *currentcount\count+1
      Break
    ElseIf *currentcount\value<aoldlimit
      *currentcount\value=i
      *currentcount\count=1
      *writeindex\count=*currentcount
      *writeindex+SizeOf(index)
      Break
    Else
      ;PrintN("Collision")
      *currentcount+SizeOf(counts)
      If *currentcount\value=#setdone
        *currentcount=*counts
      EndIf
    EndIf
  ForEver
EndMacro

PrintN("maxA:"+maxa)
PrintN("r:"+#r)

*limits=AllocateMemory(SizeOf(limits)*(maxa+1))
If *limits=0
  PrintN("Speicherfehler limits")
  Input()
  End
EndIf


Debug maxa

timer=ElapsedMilliseconds()
oldtimer=ElapsedMilliseconds()

result=0

*lim=*limits
For i=0 To 33
  *lim\currentValue=i*i+3*i*1+1*1
  *lim\b=1
  *lim\a3=i*3
  *lim+SizeOf(limits)
Next

amin=2
*aminlimit=*limits+SizeOf(limits)*amin

aup=33-1
*alimit=*limits+SizeOf(limits)*aup

alimit=aup*aup+3*aup-1

*writeindex=*index

While aup<maxa+1
  If ElapsedMilliseconds()>oldtimer+5000
    If oldaup
      speed.d=(aup-oldaup)/(ElapsedMilliseconds()-oldtimer)
      eta.d=(maxa+1.0-aup)/speed+((ElapsedMilliseconds()-timer))
    EndIf
    oldtimer=ElapsedMilliseconds()
    oldaup=aup
    PrintN( ""+aup+" ("+StrF(aup/maxa*100,2)+"%) "+StrF((ElapsedMilliseconds()-timer)/60000,2) +" Min res:"+result+" maxc:"+maxcount+" spd:"+StrF(speed*1000,2)+" a/sek eta:"+StrF(eta/60000,2)+" Min = "+StrF(eta/60000/60,2)+" Std")
  EndIf
  
  aoldlimit=alimit;altes Limit, um alte Einträge zu identifizieren
  aup+1
  alimit=aup*aup+3*aup*1+1*1 ;unter diesen wert müssen wir bleiben
  *alimit+SizeOf(limits)
  *alimit\currentValue=alimit
  *alimit\b=1
  *alimit\a3=aup*3
 
  
  *lim.limits=*aminlimit
  For a=amin To aup-1 
    If *lim\currentValue<alimit
      k=*lim\currentValue
      addcount(k)
      *lim\currentValue=#setdone;wir setzen einfach ein "erledigt" flag
      
      ;ka=a*a
      For b=*lim\b+1 To a-1
        k+*lim\a3+B+b-1
        ;check
        ;If k<>a*a+3*a*b+b*b
        ;  PrintN("Falscher wert")
        ;EndIf
        
        
        ;Wert überhaupt gültig? nein -> abbruch
        If k>#n
          Break
          
          ;wert kleiner als unser gewähltes Limit?  
        ElseIf k<alimit
          addcount(k)
          
          ;wert zu groß -> wert merken und aufhören  
        Else
          *lim\b=b
          *lim\currentValue=k
          Break
        EndIf        
      Next
    EndIf
    *lim+SizeOf(limits)
  Next
  
  i=(*writeindex-*index)/SizeOf(index)
  If i>maxcount 
    maxcount=i
  EndIf
    
  While *writeindex>*index
    *writeindex-SizeOf(index)
    If *writeindex\count\count=#r
      result+1
    EndIf
    ;*writeindex\count\value=0
    ;*writeindex\count\count=0
  Wend
  
  While *aminlimit\currentValue=#setdone
    amin+1
    *aminlimit+SizeOf(limits)
  Wend
  
  
Wend

PrintN("maxcount:"+maxcount+"  "+StrF(maxcount/maxa,2))
PrintN( "Ergebnis:"+result+"  "+StrF((ElapsedMilliseconds()-timer)/60000)+"m")
Input()

End
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8820
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von NicTheQuick »

Ich hab mal maxa*10+10000 gemacht und es laufen gelassen auf meinem Laptop. Ich brauche für 0,75% 12 Minuten.

Wegen zu weniger Kommentare in deinem Code steige ich aber noch nicht dahinter, wo ich bei dir ansetzen könnte, wenn ich was ändern wollte. :-D

Ich hab das trotzdem mal auf meinem Server gestartet. Das Log schreibe ich in eine txt-Datei, die hier abrufbar ist: euler.txt
Komischerweise sind alle 6 Kerne ausgelastet, obwohl das Programm ja nicht multithreaded ist. Das irritiert mich etwas, könnte aber auch am Scheduling des VServers liegen. Wer weiß. Der Load Average ist jedenfalls noch optimal.
True29
Beiträge: 283
Registriert: 18.08.2012 19:18
Computerausstattung: Windows 8 64bit .Profan x2,Purebasic 5.5
Wohnort: Worms
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von True29 »

heyhey,
ich lass mal deinen code laufen.
hab eine i7 und ca 12gb ram mit windows 10.
die auslastung ist leider etwas schwach zwischen 10 und 20% ;)

aktuelle zeile :
65652 (0.21%) 0.84Min res: 2964114 maxc: 14453 spd: 672,45 a/sek eta 782.98 min = 13.05 std

grüße.
i7,12gb ram , Windows 10 ,Purebasic 5.50
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von GPI »

Ich hab es jetzt doch geschafft Threads einzubinden. Leider nicht optimal, aber bei 7 Thread erreiche ich jetzt die 0.75% in 3.59 Minuten. Also eine deutliche Steigerung.
Leider stehen sich die Threads etwas selbst in weg. Die Berechnungen erfolgen leider so, das der Thread die Zwischenergebnisse von "Vorgängerthread" braucht. Zumindest die Auswertung der Counts-Tabelle (sind ja auch mehrere Tausend Einträge, tendens steigend.) kann dann parallel erfolgen.

Und ich hab eine Menge Kommentare hinzugefügt. Die Thread-Verwaltung kann man sicher noch optimieren, bspw. das Dim durch einen Speicherblock ersetzen. Aber ich bin jetzt Müde :)

edit: Irgendein Trick muss es geben, den ich nicht kenne. ich würde ja gerne in Project Euler-Forum spicken, aber völlig unsinnigerweise kann man erst darauf zugreifen, wenn man die Aufgabe gelöst hat. Würde mich nicht wundern, wenn es eine Formel gibt, um die Anzahl der Nullstellen auszurechnen oder sowas.

Code: Alles auswählen

EnableExplicit

;in Counts werden die Werte und wieoft sie vorkommen gezählt
Structure counts
  value.q
  count.i
EndStructure
;Da die Werte in Counts "verteilt" sind, brauch ich einen Index, damit ich gezielt auf die Werte zugreifen kann.
Structure index
  *count.counts
EndStructure

;Hier der Trick, ich berechne nicht für jedes A alle B zusammen, sondern nur solange, wie ich unter einen Limit bleibe. So erstelle ich Blöcke, wo ich die Zwischenergebnis in Counts halten und auswerten kann.
Structure limits
  currentValue.q
  b.i
  a3.i
EndStructure

;Struktur für Threadübergabe
Structure th
  aoldlimit.i
  alimit.i
  aup.i
  amin.i
  *aminlimit.limits
  *prethreadA.integer
  a.i
  *index.index
  *counts.counts
  result.i
  threadid.i
EndStructure

Define amin,maxa,aup,oldaup,alimit,aoldlimit
Define timer,oldtimer
Define result,i,a
;Define a,b,k
Define speed.d,eta.d
;Define maxcount
Define *limits.limits,*alimit.limits,*aminlimit.limits,*lim.limits
Global buffersize
;Define *counts.counts
Define *currentcount.counts
;Define *index.index,*writeindex.index

;Die Startbedingungen als Konstanten. 
;   123456789012345
#n=1000000000000000
#r=6

;Wieviele Threads erstellt werden sollen. Ich hab ein 4Kern+Hyperthread. 7 gab beim Test die besten Ergebnisse.
#pro=7

;Hilfswert - größte mögliche wert
#setdone=9223372036854775807

OpenConsole()
PrintN(#PB_Compiler_File)


;Es werden hier die Maximale A berechnet, wenn k=N und b=1. Das ist sozusagen das absolute maximum
maxa=IntQ((-1.5 + Sqr(1.25+#n))) 

;Buffergröße - für jeden Thread werden 2xBuffersize erstellt. Schlamping programmiert, bspw. braucht der Index bei weiten nicht so viel
buffersize=maxa+10000

;die Threaddaten vorstellen
Dim th.th(#pro)
th(0)\a=#setdone  ;Thread Null gibt es nicht, aber da der Thread auf den Vorgänger immer warten muss, simuliere ich hier einen fiktiven Thread 0 der immer fertig ist.

For i=1 To #pro
  th(i)\prethreadA=@th(i-1)\a; Den Thread zugriff auf das a des Vorgängerthreads gewähren. Wird wichtig, weil die Berechnungen immer von Vorgänger abhängig sind!
  
  ;Hier wird der Counts-Speicher reserviert
  th(i)\counts=AllocateMemory(SizeOf(counts)*(buffersize+1))
  If th(i)\counts=0
    PrintN("Speicherfehler counts "+i)
    Input()
    End
  EndIf
  ;Wir setzen eine "Endmarkierung", falls bei der Suche nach einen freien Platz man am limit kommt.
  *currentcount=th(i)\counts+SizeOf(counts)*buffersize
  *currentcount\value=#setdone ;endmarkierung
  
  ;wir reservieren Indexspeicher
  th(i)\index=AllocateMemory(SizeOf(index)*(buffersize+1))
  If th(i)\index=0
    PrintN("Speicherfehler index")
    Input()
    End
  EndIf
Next


; Das Ding hier ersetzt die Map. man könnte auch eine Prozedur machen, aber ich geh lieber auf Geschwindigkeit
Macro addcount(i)
  ;Wir errechnen ein Position. Ich nutze als Hash-Funktion einfach %.
  *currentcount=*counts+((i)%buffersize)*SizeOf(counts)
  Repeat
    ; Position ist mit genau unseren Wert besetzt - damit zählen wir ihn einfach hoch.
    If *currentcount\value=i
      *currentcount\count+1
      Break
      
    ; an der Position ist ein wert <aoldlimit (das ist die alte Grenze für k). Der Bereich ist also leer und wir füllen ihn mit standard-werten.  
    ElseIf *currentcount\value<aoldlimit
      *currentcount\value=i
      *currentcount\count=1
      ;in Index wird die Counts-Position eingetragen. Wird zum Ergebnis-Feststellung benötigt.
      *writeindex\count=*currentcount
      *writeindex+SizeOf(index)
      Break
    Else
      
      ;blöderweise gabs eine Kollision, die Stelle ist besetzt. Wir schauen einfach auf die nächste Stelle. Falls wir das Ende des Speichers erreichen, springen wir zum anfang.
      *currentcount+SizeOf(counts)
      If *currentcount\value=#setdone
        *currentcount=*counts
      EndIf
    EndIf
  ForEver
EndMacro

;Hier wird eine Reihe runtergerechnet. Blöderweise können wir ein A nur berechnen, wenn er schon in der Vorinstanz berechnet wurde. 
Procedure mythread(*th.th)
  Protected a,b,k
  Protected *lim.limits                     ; enthält das aktuelle Limits-element
  Protected aoldlimit=*th\aoldlimit         ; die Alte Grenze, wird zum erkennen einer leeren Stelle benötigt
  Protected alimit=*th\alimit               ; die aktuellen werte. K muss kleiner sein als dieser Wert, ansonsten wird er zwischengespeichert.
  Protected aup=*th\aup                     ; die aktuelle obere Grenze von A. quasi das aMax für n.
  Protected amin=*th\amin                   ; amin ist das minimum a - die a kleiner als der wert wurden schon vollständig berechnet.
  Protected *aminlimit.limits=*th\aminlimit ; das Limits-Element für den amin-wert. 
  
  Protected *index.index=*th\index          ; Indextabelle
  Protected *counts.counts=*th\counts       ; counts-ge-hashte-tabelle
  Protected *currentcount.counts            ; hilfsvariable - ein Element in der Counts-Tabelle
  Protected *writeindex.index=*index        ; Schreibposition in der Indextabelle.
  
  
  *lim.limits=*aminlimit
  For a=amin To aup-1 
    
    ;wir erlauben den Thread nach uns, werte kleiner a zu berechnen
    *th\a=a
    ;und warten bis der Thread vor uns fertig mit seiner Berechnung des aktuellen a ist
    While a>=*th\prethreadA\i
      Delay(0)
    Wend
    
    ;Wenn der Grenzwert des bereits berechneten B kleiner als das limit ist, können wir weiterrechnen.
    k=*lim\currentValue
    If k<alimit
      
      ;in der Hashtabelle den wert k eintragen, bzw den zähler erhöhen (siehe macro)
      addcount(k)
      ;wir markieren das aktuelle a als "berechnet in der limits-tabelle. Falls es doch nicht berechnet werden kann, setzen wir es einfach zurück.
      *lim\currentValue=#setdone
      
      ;alle Bs durchgehen - sofern es unter den alimit bleibt
      For b=*lim\b+1 To a-1
        k+*lim\a3+B+b-1
        
        ;check, um sicher zu stellen, das kein Mist gebaut wurde :) sollte auskommentiert werden, wenn man scharf rechnet.
        ;If k<>a*a+3*a*b+b*b
        ;  PrintN("Falscher wert")
        ;EndIf
        
        
        ;Wert überhaupt gültig? nein -> abbruch
        If k>#n
          Break
          
          ;wert kleiner als unser gewähltes Limit? -> in tabelle eintragen 
        ElseIf k<alimit
          addcount(k)
          
          ;wert zu groß -> wert merken und aufhören  
        Else
          *lim\b=b
          *lim\currentValue=k
          Break
        EndIf        
      Next
    EndIf
    
    ;a erhöht sich automatisch, wir erhöhen die Hilfsvariable *lim auf das nächste element.
    *lim+SizeOf(limits)
  Next
  
  ;wir sind jetzt fertig. Da der folgende Thread immer einen höheres a berechnet als wir, setzen wir ihn einfach aufs maximum.
  *th\a=#setdone
  
  ;wir gehen die Index-tabelle rückwärts durch und berechnen somit das Ergebnis.
  While *writeindex>*index
    *writeindex-SizeOf(index)
    If *writeindex\count\count=#r
      *th\result+1
    EndIf
  Wend
  
EndProcedure


PrintN("n:"+#n)
PrintN("r:"+#r)
PrintN("maxA:"+maxa)
PrintN("Threads:"+#pro)

*limits=AllocateMemory(SizeOf(limits)*(maxa+1))
If *limits=0
  PrintN("Speicherfehler limits")
  Input()
  End
EndIf


timer=ElapsedMilliseconds()
oldtimer=ElapsedMilliseconds()

result=0

;wir setzen einige Grenzwerte
*lim=*limits
For i=0 To 33
  *lim\currentValue=i*i+3*i*1+1*1
  *lim\b=1
  *lim\a3=i*3
  *lim+SizeOf(limits)
Next

;kleinst mögliches a und der limiteintrag für dieses a
amin=2
*aminlimit=*limits+SizeOf(limits)*amin

;aktuelle obere grenze - an Anfang ist ja alles noch klein, deshalb starten wir mit willkürlich 33
aup=33-1
;der passende limits-eintrag dafür
*alimit=*limits+SizeOf(limits)*aup
;der Grenzwert
alimit=aup*aup+3*aup-1


;das +1 ist wichtig!
While aup<maxa+1
  
  ;alle 5 sekunden eine Anzeige, wie lange schon berechnet wurde, wieviel % abgeschlossen wurde (stimmt nicht, weil je größer das a es mehr b gibt, aber egal) und die geschätze Gesamtdauer.
  If ElapsedMilliseconds()>oldtimer+5000
    If oldaup
      speed.d=(aup-oldaup)/(ElapsedMilliseconds()-oldtimer)
      eta.d=(maxa+1.0-aup)/speed+((ElapsedMilliseconds()-timer))
    EndIf
    oldtimer=ElapsedMilliseconds()
    oldaup=aup
    PrintN( ""+aup+" ("+StrF(aup/maxa*100,2)+"%) "+StrF((ElapsedMilliseconds()-timer)/60000,2) +" Min res:"+result+" spd:"+StrF(speed*1000,2)+" a/sek eta:"+StrF(eta/60000,2)+" Min = "+StrF(eta/60000/60,2)+" Std")
  EndIf
  
  
  ;wir erstellen die threads
  For i=1 To #pro
    th(i)\result=0;wichtig :)
            
    If aup<maxa+1; wir können theoretisch über das maximum kommen!
      aoldlimit=alimit;altes Limit, um alte Einträge zu identifizieren
      aup+1
      alimit=aup*aup+3*aup*1+1*1 ;unter diesen wert müssen wir bleiben
      *alimit+SizeOf(limits)
      *alimit\currentValue=alimit
      *alimit\b=1
      *alimit\a3=aup*3
      
      th(i)\aoldlimit=aoldlimit
      th(i)\alimit=alimit
      th(i)\aup=aup
      th(i)\amin=amin
      th(i)\aminlimit=*aminlimit
      
      th(i)\a=0
      th(i)\threadid=CreateThread(@mythread(),@th(i))
    Else
      th(i)\threadid=0
    EndIf
  Next
  
  ;wir warten bis alle Threads durch sind
  For i=1 To #pro
    If th(i)\threadid
      WaitThread(th(i)\threadid)
    EndIf
    ;und zählen die ergebnisse durch
    result+th(i)\result
  Next
  
  ;es ist möglich, das sich das minimum verschoben hat
  While *aminlimit\currentValue=#setdone
    amin+1
    *aminlimit+SizeOf(limits)
  Wend
  
  
Wend

;PrintN("maxcount:"+maxcount+"  "+StrF(maxcount/maxa,2))
PrintN( "Ergebnis:"+result+"  "+StrF((ElapsedMilliseconds()-timer)/60000)+"m")
Input()

End
Zuletzt geändert von GPI am 06.02.2017 22:12, insgesamt 1-mal geändert.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
Helle
Beiträge: 566
Registriert: 11.11.2004 16:13
Wohnort: Magdeburg

Re: Project Euler - Aufgabe 586 (Wettbewerb)

Beitrag von Helle »

r auf 40 setzen!
Ich hatte übrigens Probleme mit den Konstanten. Habe sie jetzt als "normale" Variablen gesetzt.
Antworten