Seite 3 von 4

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 12.04.2012 12:21
von NicTheQuick
Huch, tatsächlich. Das String-zusammenbauen dauert so lange. Ohne braucht meine Routine gerade mal 14 ms.

Und wenn wir schon am Optimieren sind.
Hier meine Routine mit einer Laufzeit von ca. 13 ms (Durchschnitt von 100 Durchläufen) und Stringgenerieren. :wink:

Code: Alles auswählen

startTime = ElapsedMilliseconds()

Define.i digits = 100000
Define.i checksum = 500000
Dim digit.i(digits - 1)

Define.i i, sum = 0
For i = 0 To digits - 1
   digit(i) = Random(1000)
   sum + digit(i)
Next
Define.f scale = checksum / sum
sum = 0
For i = 0 To digits - 1
   digit(i) = Int(Round(digit(i) * scale, #PB_Round_Nearest)) % 10
   sum + digit(i)
Next
While (checksum <> sum)
   i = Random(digits - 1)
   If (digit(i) < 9 And sum < checksum)
      digit(i) + 1
      sum + 1
   ElseIf (digit(i) > 0 And sum > checksum)
      digit(i) - 1
      sum - 1
   EndIf
Wend

Define.s result.s = Space(digits)
Define.Character *c = @result
For i = 0 To digits - 1
   *c\c = digit(i) + '0'
   *c + SizeOf(Character)
Next

time = ElapsedMilliseconds() - startTime
MessageRequester("Quersumme", "Zeit: " + Str(time) + #CRLF$ + Left(result, 100) + "...")

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 14.04.2012 21:14
von Nino
captain_hesse hat geschrieben:man könnte aber auch einfach alle möglichen Varianten erzeugen, diese dann speichern und dann eine davon per Zufall auswählen
Das war/ist auch meine Idee. Vor allem wenn es wichtig ist, dass alle möglichen Varianten die gleichen Chancen haben sollen gewählt zu werden, dann sollte es so gemacht werden -- zumindest so lange, bis die anderen hier geposteten Codes diesbezüglich mathematisch analysiert sind. ( :-) )
captain_hesse hat geschrieben:etwa so z.B.
Sorry, aber wirklich nur "etwa". :-)

Wenn man am Ende Deines Codes folgendes einfügt:

Code: Alles auswählen

Debug menge
dann erfährt man, dass Dein Code 25212 Varianten erzeugt hat. Es sollten aber 25927 sein. Ganze 715 Varianten werden von Deinem Code nicht gefunden, z.B.
1,9,9,9,8,0
2,8,9,8,9,0
3,7,8,9,9,0
...
Außerdem kann man es bei solchen Dingen schnell mit ziemlich großen Zahlen zu tun bekommen, daher ist Geschwindigkeit bei sowas immer wichtig. Dein Code ist viel zu langsam -- ohne das jetzt im Detail untersucht zu haben würde ich sagen, z.B. durch das dauernde ReDim() innerhalb der Schleife.

Einfacher, ohne Rekursion und schneller als mit Deinem Code geht es z.B., indem man gleich zu Beginn ein ausreichend großes Array dimensioniert (oder eine Linked List benutzt), die Zahlen in einer Schleife von 0 bis 999999 hochzählt und diejenigen mit der gewünschten Quersumme im Array (bzw. in der Liste) speichert.

Grüße, Nino

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 15.04.2012 22:36
von captain_hesse
Hallo Nino
Du hast Recht, das Programm ist fehlerhaft habs halt auf die Schnelle gemacht und nicht genauer geprüft. Ich habe den Code jetzt angepasst und es sollte nun fehlerfrei sein. Dann habe ich noch versucht eine Routine zu schreiben die das selbe macht aber nicht rekusiv ist wie du vorgeschlagen hast, allerdings ist es mir bisher nicht gelungen diese schneller zu bekommen als die rekursive Routine. Vieleicht kannst Du ja mal was Posten wie eine Routine, die von 0 bis 999999 zählt deiner Meinung nacht aussehen soll und dabei aber auch schneller ist als das rekursive Programm.

Code: Alles auswählen


Global Dim var$(26000)
Global Dim index(6)
Global ti=0
Global menge=0
Global quer_summe=36
summe=0

Procedure suche(summe)
  ti+1
  For x=0 To 9
    summe+x
    index(ti)=x
    If summe=quer_summe
        menge+1
        var$(menge)=""
        For i=1 To 6
        var$(menge)+Str(index(i))+" | "
        Next
      index(ti)=0
      ti-1
      ProcedureReturn
    EndIf
    If ti<6
      suche(summe)
    EndIf 
    summe-x
  Next
  index(ti)=0
  ti-1
EndProcedure  


time=ElapsedMilliseconds()
suche(summe)
Debug menge
z=Random(menge)+1
Debug var$(z)
Debug ElapsedMilliseconds()-time
Viele Grüße Armin

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 01:24
von darius676
und was haltet ihr davon:

Code: Alles auswählen


Procedure __FEHLER(_val,text$)
If _val=0
MessageRequester("Fehler",text$,#PB_MessageRequester_Ok)
End
EndIf
EndProcedure
;concept by deutschmann walter
;quersummenbeispiel
;quersumme = 36 zahl = 6 stellig
;ermittlung zufaelliger zahlenkolonen = 36
;neu:16042012:
;beliebige kolonnen, es erfolgt jedoch keine prüfung ob die eingabe sinnvoll ist...
EnableExplicit

__FEHLER(InitKeyboard(),"Keyboard konnte nicht  initialisiert werden")

Global _stelle.b=0  ;position der  6 stelligen zahl (1-6)
Global _zahlString$=""
Global _max.l=36
Global _my_start_time.l=0

Structure _quer
zahl.l[100]
summe.l
EndStructure

Global _quersumme._quer

Procedure __ERFOLG(_str$)
Define _but.l=0

_but.l=MessageRequester("Ergebnis:","Quersumme "+_zahlString$+" = "+Str(_quersumme\summe)+Chr(13)+"benoetigte Zeit:"+Str(ElapsedMilliseconds()-_my_start_time)+"ms",#PB_MessageRequester_YesNoCancel )
If _but.l=#PB_MessageRequester_Cancel
End
EndIf

EndProcedure


Procedure __GET_QUER(_i_max.l,_digits.l)
_stelle.b=1
_max.l=_i_max.l
_zahlString$=""

 _quersumme\summe=0 ;init...
 
Repeat 

              
              _quersumme\zahl[_stelle.b]=Random(9)
              _quersumme\summe+_quersumme\zahl[_stelle.b]
             
            
      
              If _quersumme\summe>_max.l 
              _stelle.b=1
              _zahlString$=""
              _quersumme\summe=0 ;init...
              EndIf
              
              If _quersumme\summe<=_max.l
              _zahlString$+Str(_quersumme\zahl[_stelle.b])+"|"
              _stelle.b+1
              EndIf
              
              If _stelle.b>_digits.l+1
              _stelle.b=1
              _zahlString$=""
              _quersumme\summe=0 ;init...
              EndIf
                          


Until _quersumme\summe=_max.l And _stelle.b>_digits.l

__ERFOLG(_zahlString$)

EndProcedure


Repeat


;zahl aus der die quersumme gebilded wird, anzahl der stellen für die quersumme
_my_start_time=ElapsedMilliseconds()
__GET_QUER(36,6)
ForEver

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 02:50
von STARGÅTE
[Leicht offtopic]
@darius676:
Hat es einen Grund, warum du hier und da für Variablen ein _-Präfix und Prozeduren zogar __ als Präfix nutzt?
[/Leicht offtopic]

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 07:31
von RSBasic
@STARGÅTE
Vielleicht sieht es einfach nur "cool" aus?

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 08:27
von Nino
Hallo Armin!
captain_hesse hat geschrieben:[...] es sollte nun fehlerfrei sein.
Ja, das denke ich auch.
captain_hesse hat geschrieben:Dann habe ich noch versucht eine Routine zu schreiben die das selbe macht aber nicht rekusiv ist wie du vorgeschlagen hast, allerdings ist es mir bisher nicht gelungen diese schneller zu bekommen als die rekursive Routine. Vieleicht kannst Du ja mal was Posten wie eine Routine, die von 0 bis 999999 zählt deiner Meinung nacht aussehen soll und dabei aber auch schneller ist als das rekursive Programm.
Ich meinte vor allem: schneller als Dein erster Code. :-)
Dein erster Code benötigte hier bei mir 2600 ms(!), während Dein neuer Code nur noch 78 ms braucht. :allright:
( Du hast übrigens ein bisschen geschummelt, weil Du in der 1. Zeile des Programms eigentlich noch gar nicht wissen kannst, dass das Array var$() mit 26000 Elementen ausreichend groß dimensioniert ist. :-) )
Wichtig: Bei Zeitmessungen immer den Debugger ausschalten (dann natürlich auch keine Meldungen mit Debug ausgeben!
Na, mal sehen wie weit ich komme. :-)

Hier erst mal Code von mir, der vor allem einfach ist:

Code: Alles auswählen

EnableExplicit

Procedure.i QuerSumme (n.i)
   ; in: n: >= 0
   Protected temp.i, ziffer.i, ret.i=0

   temp = n
   While temp
      ziffer = temp % 10
      ret + ziffer
      temp/10
   Wend

   ProcedureReturn ret
EndProcedure


Define.i stellen, summe, last, x, count, t, i
Define msg$

stellen = 6
summe = 36

t = ElapsedMilliseconds()
NewList zahl.i()
last = Pow(10, stellen) - 1
count = 0
For x = 0 To last
   If QuerSumme(x) = summe
      count + 1
      AddElement(zahl())
      zahl() = x
   EndIf
Next

i = Random(count-1)            ; Das erste Element der Liste ist an Position 0.
SelectElement(zahl(), i)
t = ElapsedMilliseconds() - t

msg$ = Str(count) + " Kombinationen mit Summe " + Str(summe) + " gefunden." + #LF$
msg$ + "Zufällig ausgewählt: " + #DQUOTE$ + Str(zahl()) + #DQUOTE$ + "  (Kombination #" + Str(i) + ")" + #LF$
msg$ + "Dauer: " + Str(t) + " ms"
MessageRequester("Ergebnis", msg$)
Dauer hier: 190 ms

Man kann das noch deutlich beschleunigen, indem man einen passenden Startwert berechnet, und dann in 9er-Schritten hochzählt. Dabei werden keine gültigen Ergebnisse ausgelassen. Man erhält allerdings immer noch einige ungültige Zahen, so dass es weiterhin nötig ist, die Quersumme jeder Zahl zu prüfen:

Code: Alles auswählen

EnableExplicit

Procedure.i QuerSumme (n.i)
   ; in: n: >= 0
   Protected temp.i, ziffer.i, ret.i=0

   temp = n
   While temp
      ziffer = temp % 10
      ret + ziffer
      temp/10
   Wend

   ProcedureReturn ret
EndProcedure


Define.i stellen, summe, rest, start, last, i, x, count, t
Define msg$

stellen = 6
summe = 36

t = ElapsedMilliseconds()
NewList zahl.i()

; -- kleinste gesuchte Zahl ermitteln
rest = summe
start = 0
For i = 1 To stellen
   If rest > 9
      start*10 + 9
      rest - 9
   Else
      start*10 + rest
      Break
   EndIf
Next

; -- alle gesuchten Zahlen ermitteln und speichern
last = Pow(10, stellen) - 1
count = 0
For x = start To last Step 9
   If QuerSumme(x) = summe
      count + 1
      AddElement(zahl())
      zahl() = x
   EndIf
Next

i = Random(count-1)            ; Das erste Element der Liste ist an Position 0.
SelectElement(zahl(), i)
t = ElapsedMilliseconds() - t

msg$ = Str(count) + " Kombinationen mit Summe " + Str(summe) + " gefunden." + #LF$
msg$ + "Zufällig ausgewählt: " + #DQUOTE$ + Str(zahl()) + #DQUOTE$ + "  (Kombination #" + Str(i) + ")" + #LF$
msg$ + "Dauer: " + Str(t) + " ms"
MessageRequester("Ergebnis", msg$)
Dauer hier: 20 ms 8)

Etwas in der Art lässt sich natürlich statt mit Integer-Zahlen auch mit einem Ziffern-Array machen.

Grüße, Nino

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 08:51
von 7x7

Code: Alles auswählen

t = ElapsedMilliseconds()
Global Dim k(25927,6)

;für Zeitmessung 1000x durchrödeln lassen
For count=1 To 1000
	
	index=0
	For z1=0 To 9
		For z2=0 To 9
			For z3=0 To 9
				For z4=0 To 9
					For z5=0 To 9
						For z6=0 To 9
							
							If z1+z2+z3+z4+z5+z6=36
								
								index+1
								k(index,1)=z1
								k(index,2)=z2
								k(index,3)=z3
								k(index,4)=z4
								k(index,5)=z5
								k(index,6)=z6
								
							EndIf
							
						Next z6
					Next z5
				Next z4
			Next z3
		Next z2
	Next z1
	
Next count

MessageRequester("Ergebnis", Str((ElapsedMilliseconds() - t)/(count-1))+" ms")
End
5,6 ms 8) (@nino: zum Vergleich wegen unterschiedlicher Rechner: Deine 20ms laufen bei mir mit 12,4 ms)

Bei solch kleinen Schleifen lohnen sich nicht einmal Schleifenoptimierungen.

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 11:17
von darius676
STARGÅTE hat geschrieben:[Leicht offtopic]
@darius676:
Hat es einen Grund, warum du hier und da für Variablen ein _-Präfix und Prozeduren zogar __ als Präfix nutzt?
[/Leicht offtopic]

Ja :-)

(einen davon hast Du erkannt ....) , hab den Code ausgebessert: jetzt haben alle variablen einen _xxxx :-)










warum:
_ oder __ unterstützen die Lesbarkeit. verwende ich insbesondere für große Projekte wie meine GameEngine/Spiel (Parasite2:FleshEaters)
Variablen beginnen bei mir mit _
Proceduren mit __
weiters gibt es noch folgende "Vorgaben":
variable: _hauptname_zusatz.typ
Structur: _hauptname_zusatz\var oder _hauptname_zusatz\_var : _3DGFXOBJECT(_counter.l)\energie_extrem=_GGFX(_index.l)\_energie_extrem
proceduren: __HAUPTNAME_ZUSATZ()

vorteile:
mit Autovervollständigen werden so "nur" die variablen/prozeduren usw aufgelistet, welche von mir sind. und "coole" namen kann ich auch verwenden *g*

Re: Summe als Quersumme auf 6 Ziffern zerlegen

Verfasst: 16.04.2012 15:24
von Ractur
Hallo,

was ich an der Sache ziemlich Merkwürdig find ist, das ich vorher dachte es gäbe mehr Möglichkeiten am Ergebnis vorbei zu "rechnen", also das sich die Laufzeit zur Stellenanzahl vervielfacht.

Mich hat stark gewundert das im Schnitt gerade mal 50-100 Schleifendurchläufe (wenn überhaupt) benötigt werden um das Ergebnis zu erreichen.

Code: Alles auswählen

t = ElapsedMilliseconds()

Repeat
    zahl1 = Random(9)
    zahl2 = Random(9)
    zahl3 = Random(9)
    zahl4 = Random(9)
    zahl5 = Random(9)
    zahl6 = Random(9)
   
    summe = zahl1+zahl2+zahl3+zahl4+zahl5+zahl6
   
    zaehler = zaehler+1
   
    If summe = 36
      MessageRequester("Ergebnis", Str((ElapsedMilliseconds() - t))+" ms"+" Count: "+Str(zaehler))
    EndIf
   
  Until summe = 36

Gut, nun könnte man sagen, die Summe 36 ist nun auch nicht so groß, also hab ich das Beispiel etwas abgeändert:

Code: Alles auswählen

t = ElapsedMilliseconds()

Repeat
    zahl1 = Random(8)+1
    zahl2 = Random(8)+1
    zahl3 = Random(8)+1
    zahl4 = Random(8)+1
    zahl5 = Random(8)+1
    zahl6 = Random(8)+1
   
    summe = zahl1*zahl2*zahl3*zahl4*zahl5*zahl6
   Debug summe
    zaehler = zaehler+1
   
    If summe = 36 ;131712
      MessageRequester("Ergebnis", Str((ElapsedMilliseconds() - t))+" ms"+" Count: "+Str(zaehler))
    EndIf
   
  Until summe = 36 ;131712
Bei der Summe 36 braucht das ganze rund 3 Sekunden (inkl. Debugger) um zur Summe zu kommen. Bei der Summe 131712 braucht er um die 20 Sekunden um zur Summe zu kommen (inkl. Debugger). Mich wundert es wieso eine niedrige Zahl offensichtlich "öfter" und schnellter fällt als eine größere Zahl. Wie kann das sein? Es sind doch alle Zahlen per Random ermittelt?

Auch wenn der Debugger aus ist, neigt er dazu wesentlich mehr Schleifendurchläufe bei 131712 zu benötigen, als bei 36.

Grüsse Ractur