Summe als Quersumme auf 6 Ziffern zerlegen

[Ractur]

Hallo,

mhhh, ich hab jetzt mal ein Problem von dem ich nicht weiß wie ich am besten heran gehen soll, vielleicht habt Ihr ne Idee?

Also, ich habe eine Summe gleich 54 oder darunter, z.B. nehmen wir mal 36. Diese Summe möchte ich nun per Zufall auf eine Quersumme mit 6 Ziffern aufteilen, jede einzelne Ziffer kann den Wert 0 bis 9 haben.

Zum Bleistift:

Code: Alles auswählen

36 in Quersumme per Zufall zerlegen:

z.B.

Ziffer 1|Ziffer 2|Ziffer 3|Ziffer 4|Ziffer 5|Ziffer 6|

|6|6|6|6|6|6| = 36

oder

|0|9|7|9|3|8| = 36

oder

5|6|3|9|8|5| = 36

oder...oder...oder....

Habt Ihr ne Idee wie ich das Programmiertechnisch umsetze?

Danke, Ractur

[Ractur]

Hallo,

mir ist da eben was eingefallen und ich hab die Sache "von hinten" angegangen:

Code: Alles auswählen

  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
    Debug zaehler
    
    If summe = 36
      Debug Str(zahl1)+Str(zahl2)+Str(zahl3)+Str(zahl4)+Str(zahl5)+Str(zahl6)
    EndIf
    
  Until summe = 36

Was mich wundert ist, das PB quasi sofort n Debugfenster öffnet ^^ Trotzdem find ich die Lösung irgendwie unsauber, rein theoretisch könnte der Rechner daran auch ewig rechnen oder?

Gibts ne bessere Lösung?

Danke, Ractur

[Sirius-2337]

Es gibt sicherlich noch bessere Lösungen als die folgende, aber es ist schon mal ein Anfang

Code: Alles auswählen

Summe = 36
Dim Quersumme(5)

If Summe > 6 * 9
  MessageRequester("Fehler", "Summe ist zu hoch um sie in 6 Ziffern zu zerlegen")
  End
EndIf

For x = 0 To 5
  Quersumme(x) = Random(9)
  Summe - Quersumme(x)
Next x

x = 0

While Summe > 0
  
  If Quersumme(x) < 9
    Quersumme(x) + 1
    Summe - 1
  EndIf
  
  x + 1
  
  If x > 5
    x = 0
  EndIf
  
Wend

Output$ = ""
Ueberpruefung = 0

For x = 0 To 5
  Output$ + Str(Quersumme(x)) + "|"
  Ueberpruefung + Quersumme(x)
Next x

Debug Output$
Debug Ueberpruefung

[Ractur]

Es gibt sicherlich noch bessere Lösungen als die folgende, aber es ist schon mal ein Anfang

Danke Dir, ich hab mal einen Zähler bei Dir eingbaut, Deine Schleife wird wesentlich weniger oft durchlaufen als meine. Allerdings, kommt da auch mal statt 36 z.B. 38 oder 42 raus

Siehe:

Code: Alles auswählen

http://www.bilderhoster.net/img.php?id=d519t6j4.jpg

Ractur

[Sirius-2337]

Hier ist noch mal eine bessere Version (Kommentare, variable Anzahl an Summanden, überprüfung)
Ich hatte bisher keine Falschen Ergebnisse.

Edit: Richtig jetzt hab ich den Fehler im alten Code. Ist hier schon Korrigiert. Ich hatte beim ersten zerteilen der Summe nicht geprüft ob sie schon <= 0 ist.

Edit2:
EnableExplicit hizugefügt.
Randomize Array hizugefügt, damit bei hoher Anzahl von Summanden nicht nur Nullen hinten Stehen.

Code: Alles auswählen

EnableExplicit

Define Summe     = 36 ;Summe die Zerlegt werden soll
Define Summanden = 6  ;Anzahl an Summanden, in die die Summe zerlegt werden soll

Define Summe_Copy = Summe
Dim Summand(Summanden - 1)
Define x

Define Output$
Define Probe

;Überprüfen ob die Summe nicht zu groß ist
If Summe > Summanden * 9
  MessageRequester("Fehler", "Summe ist zu hoch um sie in "+Str(Summanden)+" einziffrige Summanden zu zerlegen")
  End
EndIf

;Jedem Summanden einen Teil der Summe zuweisen und die Summe um diesen verringern (Aufhören wenn Summe <= 0)
For x = 0 To (Summanden - 1)
  
  Summand(x) = Random(9)
  Summe - Summand(x)
  
  If Summe <= 0
    Summand(x) + Summe
    Break
  EndIf
  
Next x

RandomizeArray(Summand())

;Den Rest (wenn vorhanden) der Summe auf die Summanden aufteilen
x = 0
While Summe > 0
  
  If Summand(x) < 9
    Summand(x) + 1
    Summe - 1
  EndIf
  
  x + 1
  
  If x > (Summanden - 1)
    x = 0
  EndIf
  
Wend

;Ausgabe-String zusammensetzen und zur Probe alle Summanden zusammenrechnen
Output$ = ""
Probe   = 0

For x = 0 To (Summanden - 1)
  Output$ + Str(Summand(x)) + "|"
  Probe   + Summand(x)
Next x

Debug Output$
Debug "Eingabe: " + Str(Summe_Copy) + ", Probe: " + Str(Probe)

[NicTheQuick]

Hab da auch mal was gebastelt, aber ich weiß nicht genau wie gut der Zufall ist.

Code: Alles auswählen

Define.i digits = 6
Define.i checksum = 38
Dim digit.i(digits - 1)

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

Define.s result.s = ""
For i = 0 To digits - 1
	result + Str(digit(i))
Next

Debug result

Wahrscheinlich ist es besser, wenn man in der ersten Schleife digit(i) = Random(100) macht oder eine noch höhere Zahl. Später wird ja sowieso wieder runter skaliert. So, aber jetzt muss ich aus dem Bus aussteigen, war ne kurze Fahrt.

[Sirius-2337]

Hab da auch mal was gebastelt...

Bei dir kommen aber auch digit's > 9 raus

[NicTheQuick]

Hab's auch eben gemerkt, als ich heim gekommen bin.

Aber jetzt erst mal was essen bevor ich das verbessere.

[NicTheQuick]

So, ich hab's mal schnell korrigiert. Besonders schön finde ich es auch nicht, aber es ist auf jeden Fall deterministisch.

Code: Alles auswählen

Define.i digits = 6
Define.i checksum = 3
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

Debug result

Kurzer Hintergrund:
Ich erstelle pro Ziffer zufällige Zahlen in einem beliebigen Bereich (hier 0-100), berechne deren Summe und skaliere dann jede Ziffer wieder so weit runter, dass ihre Summe gleich der Quersumme ist. Nach dem Runden kann das Ergebnis allerdings wieder abweichen, vor allem dann, wenn einzelne Ziffern größer als 9 sind. Diesen Bereich grenze ich dann ein und verteile anschließend noch zufällig die Differenz zur gewünschten Quersumme auf alle Ziffern.

Im Grunde kann man auch von Anfang an zufällige Zahlen zwischen 0 und 9 wählen und dann diese wieder zufällig anpassen. Mit meiner Version, die zuerst größere Zahlen erstellt, ist aber die Wahrscheinlichkeit höher, dass man am Schluss die Differenz zur gewünschten Quersumme nicht mehr so viel verteilen muss.

[Ractur]

So, ich hab's mal schnell korrigiert. Besonders schön finde ich es auch

Hi,

ähm also irgendwie kapier ich die Ausgabe nich?

http://www.myimg.de/?img=Quersumme35dc6.jpg

Grüsse und Danke, Ractur