Summe als Quersumme auf 6 Ziffern zerlegen

[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.

[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

[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

[gnasen]

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

[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

[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?

[Ractur]

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

[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

[NicTheQuick]

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.

[7x7]

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