Seite 2 von 4
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 18:20
von NicTheQuick
Na der Wert am Schluss ist deine Zahl mit der gewünschten Quersumme als String. In der letzten Vorschleife kannst du auch statt eines Strings eine echte Zahl erstellen.
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 18:29
von gnasen
ich finde das Problem ganz interessant, hier ist ein Algo der unabhängig vom Zufall immer zügig terminiert. Ausgabe hab ich mal als String gemacht wegen führenden Nullen. Anzahl Stellen und größe der Zahl ist zudem Variabel:
Code: Alles auswählen
Procedure.s randomNumber(value.i,digits.i)
Protected Dim number.i(digits-1)
Protected a.i, b.i, current.i
Protected overflowCount.i, overflowNumber.i
If value/9.0 > digits
Debug "too high value for too less digits"
ProcedureReturn "0"
EndIf
overflowCount = value
overflowNumber = 0
While overflowCount <> 0
For a=1 To overflowCount
current = Random(digits-overflowNumber-1)
For b=0 To digits-1
If number(b) > 9
Continue
EndIf
If current = 0
number(b) + 1
Break
Else
current - 1
EndIf
Next
Next
overflowCount = 0
For a=0 To digits-1
If number(a) > 9
overflowCount + (number(a) - 9)
overflowNumber + 1
number(a) = 9
EndIf
Next
Wend
Protected result.s
For a=0 To digits-1
result + Str(number(a))
Next
ProcedureReturn result
EndProcedure
Define a.i
For a=1 To 10
Debug randomNumber(30,6)
Next
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 19:11
von 7x7
Wie wär's damit?
Code: Alles auswählen
Global Dim Ziffer(6)
QuersummeSoll=36
For Index=1 To 6
Rest=QuersummeSoll-(Quersumme+(6-Index)*9)
If Rest<0: Min=0: Else: Min=QuersummeSoll-Quersumme-(6-Index)*9: EndIf
Max=QuersummeSoll-Quersumme: If Max>9: Max=9: EndIf
Ziffer(Index)=Random(Max-Min)+Min
Quersumme+Ziffer(Index)
Debug Ziffer(index)
Next index
Kurze Erklärung:
Vor jeder neuen Ziffer stecke ich die Grenzen für den maximalen und minimalen Bereich der benötigten
Zufallszahl ab. Es ist z.B. klar, dass wenn am Ende noch 1 Zahl zu belegen ist und die Quersumme den
Wert 28 (von 36) hat, dass dann min=8 und max=8 sein muss.
Sorry, kann's nicht besser erklären

Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 19:20
von gnasen
7x7 hat geschrieben:Kurze Erklärung:
Vor jeder neuen Ziffer stecke ich die Grenzen für den maximalen und minimalen Bereich der benötigten
Zufallszahl ab. Es ist z.B. klar, dass wenn am Ende noch 1 Zahl zu belegen ist und die Quersumme den
Wert 28 (von 36) hat, dass dann min=8 und max=8 sein muss.
Sorry, kann's nicht besser erklären

Die Idee ist ganz gut, aber die Abhängigkeit des Zufalls unter den Ziffern (abhängig von den zuvor gewählten Ziffern) ist sehr groß. Das kann man ganz gut darin beobachten, dass bei den letzten beiden Ziffern fast nie niedrige Zahlen auftreten. Schon eine 4 ist selten, kleinere hab ich sogar noch nicht zu gesicht bekommen bei ca 20 versuchen.
Edit: Der zweite Punkt deiner Signatur trifft mich hart

Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 20:29
von Ractur
Hallo,
vielen herzlichen Dank erstmal an Sirius-2337, NicTheQuick, gnasen und 7x7! Mich hat die Funktion nun auch keine Ruhe gelassen heute Nachmittag. Vor allem interessierte mich was wohl die schnellste Funktion sein würde. Statt also weiter zu programmieren hab ich rum getestet
digits = 100000
checksum = 500000
Das hab ich mal bei allen probiert und die Lösung von "NicTheQuick" war mit 16 Sekunden die schnellste.
Nicht das es nur Ansatzweise wichtig für meine Anwendung wär, aber wenn ich schon mal beim "spielen" bin, dann aber richtig
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
Debug ""
For i = 0 To digits - 1
digit(i) = Int(Round(digit(i) * scale, #PB_Round_Nearest)) % 10
sum + digit(i)
Next
Debug checksum - sum
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 = ""
For i = 0 To digits - 1
result + Str(digit(i))
Next
time = ElapsedMilliseconds() - startTime
centiseconds = (time / 10) % 100
seconds = (time / 1000) % 60
minutes = (time / 60000) % 60
hours = (time / 3600000) % 60
Debug result
Debug seconds
Grüsse und Danke nochmal

Ractur
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 22:41
von NicTheQuick
Ich nehme an du hast das ganze mit Debugger getestet. Bei vielen Codes macht das jedenfalls einen enormen Unterschied. Bei deinen Testwerten und meinem Code macht es keinen besonders großen Unterschied. Mit Debugger dauert es bei mir 3,5 Sekunden und ohne 3,4 Sekunden.
Die andere habe ich jetzt nicht getestet.
Was für einen Rechner hast du, dass es bei dir 16 Sekunden dauert?

Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 11.04.2012 22:55
von Ractur
NicTheQuick hat geschrieben:Ich nehme an du hast das ganze mit Debugger getestet. Bei vielen Codes macht das jedenfalls einen enormen Unterschied. Bei deinen Testwerten und meinem Code macht es keinen besonders großen Unterschied. Mit Debugger dauert es bei mir 3,5 Sekunden und ohne 3,4 Sekunden.
Die andere habe ich jetzt nicht getestet.
Was für einen Rechner hast du, dass es bei dir 16 Sekunden dauert?


Hab ich was von 16 Sekunden gesagt ?
N Dualcore 2,5 GHZ, offensichtlich eine nicht sehr schnelle Kiste? Ja habs im Debuger laufen lassen, da dauerte das 16 Sekunden. Was hast Du für eine Maschine? Bei 3,5 Sekunden im Debugger, hmmm, da muß das mind. n QuadCore sein? ^^
Grüsse Ractur
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 12.04.2012 00:17
von captain_hesse
Hallo
man könnte aber auch einfach alle möglichen Varianten erzeugen, diese dann speichern und dann eine davon per Zufall auswählen
etwa so z.B.
Code: Alles auswählen
Global Dim var(6,1)
Global Dim summe(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
summe(ti)=x
If summe=quer_summe
If ti=6
;Debug Str(summe(1))+" | "+Str(summe(2))+" | "+Str(summe(3))+" | "+Str(summe(4))+" | "+Str(summe(5))+" | "+Str(summe(6))
menge+1
ReDim var(6,menge)
For i=1 To 6
var(i,menge)=summe(i)
Next
EndIf
ti-1
ProcedureReturn
EndIf
If ti<6
suche(summe)
EndIf
summe-x
Next
ti-1
EndProcedure
suche(summe)
z=Random(menge)+1
Debug Str(var(1,z))+" | "+Str(var(2,z))+" | "+Str(var(3,z))+" | "+Str(var(4,z))+" | "+Str(var(5,z))+" | "+Str(var(6,z))
viele Grüße Armin
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 12.04.2012 01:56
von NicTheQuick
Ractur hat geschrieben:N Dualcore 2,5 GHZ, offensichtlich eine nicht sehr schnelle Kiste? Ja habs im Debuger laufen lassen, da dauerte das 16 Sekunden. Was hast Du für eine Maschine? Bei 3,5 Sekunden im Debugger, hmmm, da muß das mind. n QuadCore sein? ^^
Das hat ja nichts damit zu tun wie viele Cores die CPU hat, wenn eh nur ein Thread läuft. Ich hab einen Core 2 Duo mit 2 GHz (steht übrigens auch in meinem Profil), deswegen wundert mich das jetzt schon.
Aber Hauptsache es funktioniert.
Re: Summe als Quersumme auf 6 Ziffern zerlegen
Verfasst: 12.04.2012 09:45
von 7x7
Ractur hat geschrieben:digits = 100000
checksum = 500000
...war mit 16 Sekunden...
Ist das ein Witz?
Die Zeit, die die BERECHNUNG braucht (habe nur meine Routine getestet, bei den anderen wird es aber
genauso sein) geht nahezu gegen NULL. Wo die Zeit verbraten wird ist das (unrelevante) Zusammenbacken
der Testausgabe:
Code: Alles auswählen
Define.s result.s = ""
For i = 0 To digits - 1
result + Str(digit(i))
Next
