PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Zufall mit mehreren Variablen, aber gleichem Gesamtwert

https://www.purebasic.fr/german/viewtopic.php?t=17990

Seite 2 von 3

Verfasst: 22.10.2008 19:20
von Kaeru Gaman
nuja... das Beispiel ist schon klarer...
ist einfach umzusetzen, allerdings wirst du in dem meisten reihen viele leere Körbe bekommen, wenn du kein sinnvolles Maximum pro Korb setzt.

Code: Alles auswählen

EnableExplicit

; Startwerte, nimm was du willst

Define Koerbe = Random(20) + 4
Define Aepfel = Random(100) + Koerbe

Define AlleAepfel
Define DieserKorb

Define n, sum

Define out$

Dim Korb(Koerbe)

Debug Str(Aepfel) + " Äpfel in " + Str(Koerbe) + " Körben."
Debug "------------------------------"

For n=1 To Koerbe
  DieserKorb =  Random(Aepfel)
  If AlleAepfel + DieserKorb > Aepfel
    DieserKorb = Aepfel - AlleAepfel
  EndIf
  AlleAepfel + DieserKorb
  Korb(n) = DieserKorb
  Debug "In Korb " + Str(n) + " sind " + Str(DieserKorb) + " Äpfel."
Next

Debug "=================="
Debug "Probe:"
out$ = Str(Korb(1))
sum = Korb(1) 
For n=2 To Koerbe
  out$ + " + " + Str(Korb(n))
  sum + Korb(n)
Next
out$ + " = " + Str(sum)
Debug out$
zum beispiel:
Maximum pro Korb ist das Dreifache des Durchschnitts:

Code: Alles auswählen

EnableExplicit

; Startwerte, nimm was du willst

Define Koerbe = Random(20) + 4
Define Aepfel = Random(100) + Koerbe

Define MaxProKorb = Aepfel / Koerbe * 3

Define AlleAepfel
Define DieserKorb

Define n, sum

Define out$

Dim Korb(Koerbe)

Debug Str(Aepfel) + " Äpfel in " + Str(Koerbe) + " Körben."
Debug "------------------------------"

For n=1 To Koerbe
  DieserKorb =  Random(MaxProKorb)
  If AlleAepfel + DieserKorb > Aepfel
    DieserKorb = Aepfel - AlleAepfel
  EndIf
  AlleAepfel + DieserKorb
  Korb(n) = DieserKorb
  Debug "In Korb " + Str(n) + " sind " + Str(DieserKorb) + " Äpfel."
Next

Debug "=================="
Debug "Probe:"
out$ = Str(Korb(1))
sum = Korb(1) 
For n=2 To Koerbe
  out$ + " + " + Str(Korb(n))
  sum + Korb(n)
Next
out$ + " = " + Str(sum)
Debug out$

Verfasst: 22.10.2008 19:22
von Little John
Xaby hat geschrieben:Nun möchte ich diese 32 Äpfel wieder auf die 5 Körbe verteilen.
Aber zufällig.
Warum sagst Du das nicht gleich? :mrgreen:

Code: Alles auswählen

EnableExplicit

Define AnzahlAepfel, AnzahlKoerbe, MaxProKorb, LetzterKorb, i, k

;-- gegeben:
AnzahlAepfel = 32
AnzahlKoerbe = 5
MaxProKorb = 10


If AnzahlAepfel > AnzahlKoerbe*MaxProKorb
   Debug "Das geht nicht. -- Programm abgebrochen!"
   End
EndIf

LetzterKorb = AnzahlKoerbe - 1
Dim Korb(LetzterKorb)

;-- zufällig verteilen
i = 1
While i <= AnzahlAepfel
   k = Random(LetzterKorb)
   If Korb(k) < MaxProKorb
      Korb(k) + 1
      i + 1                  ; nächster Apfel
   EndIf
Wend

;-- Ergebnis ausgeben
For i = 0 To LetzterKorb
   Debug Korb(i)
Next
Gruß, Little John

Verfasst: 22.10.2008 19:58
von Froggerprogger
Genau das macht auch die Procedure.l FillRandom(A.l(1), limit.l, sum.l, uniform.l) mit uniform auf #True.
Nachteil: Laufzeit O(sum), bzw. O(AnzahlAepfel). Also wenn man 100000 Äpfel verteilt kann das ganz schön dauern. Da könnte man dann aber alternativ anfangs Portionen zu mehr als 1 Apfel auf die Körbe verteilen, oder ein ganz anderes Vorgehen versuchen.

Verfasst: 22.10.2008 20:45
von Little John
Froggerprogger hat geschrieben:Genau das macht auch die Procedure.l FillRandom(A.l(1), limit.l, sum.l, uniform.l) mit uniform auf #True.
Beziehst Du Dich auf meinen Beitrag? Sorry, ich habe den Anfang des Threads, wo die Fragestellung noch überhaupt nicht präzise formuliert war, nicht gründlich gelesen.
Froggerprogger hat geschrieben:Nachteil: Laufzeit O(sum), bzw. O(AnzahlAepfel). Also wenn man 100000 Äpfel verteilt kann das ganz schön dauern. Da könnte man dann aber alternativ anfangs Portionen zu mehr als 1 Apfel auf die Körbe verteilen, oder ein ganz anderes Vorgehen versuchen.
Der Code ist noch langsamer als O(AnzahlAepfel), weil es zunehmend passiert, dass zunächst versucht wird ein Apfel einem best. Korb zuzuteilen, um dann festzustellen dass dieser schon voll ist. Das lässt sich immerhin beheben, indem man -- wie im wahren Leben :-) -- einen Korb "beiseite stellt" sobald er voll ist:

Code: Alles auswählen

EnableExplicit

Define AnzahlAepfel, AnzahlKoerbe, MaxProKorb, LetzterKorb, i, k

;-- gegeben:
AnzahlAepfel = 32
AnzahlKoerbe = 5
MaxProKorb = 10


If AnzahlAepfel > AnzahlKoerbe*MaxProKorb
   Debug "Das geht nicht -- Programm abgebrochen!"
   End
EndIf

LetzterKorb = AnzahlKoerbe - 1
Dim Korb(LetzterKorb)

;-- zufällig verteilen
For i = 1 To AnzahlAepfel
   k = Random(LetzterKorb)
   Korb(k) + 1
   If Korb(k) = MaxProKorb
      Swap Korb(k), Korb(LetzterKorb)
      LetzterKorb - 1
   EndIf
Next

;-- Ergebnis ausgeben
For i = 0 To AnzahlKoerbe - 1
   Debug Korb(i)
Next
Übrigens gibt es hier nicht -- wie der Threadtitel suggeriert -- mehrere Zufallsvariablen, sondern nur eine, nämlich die Nummer des Korbes in den ein gegebener Apfel gelegt wird.

Gruß, Little John

Verfasst: 22.10.2008 22:26
von Xaby
@Little John

ICH LIEBE DICH

So einfach, so genial. Wieder einmal war ich geistig umnachtet.

:allright: :allright: :allright: :allright: :allright:

Verfasst: 22.10.2008 22:27
von Kaeru Gaman
... und mein Beispiel interessiert keinen? :( *schmoll*

Verfasst: 22.10.2008 22:43
von Xaby
@Little John,

meine Euphorie nach einigen Tests hält sich in Grenzen.

Ich muss leider meine Liebe wieder zurück nehmen.

Das Problem ist, dass sich bei großen Anzahlen von Äpfeln und einer geringen Anzahl an Körben, die Verteilung der Äpfel doch sehr ähnelt.

Es gibt keine Spitzen.

Beispiel: 3 Körbe, 300 Äpfel und ein Limit pro Korb bei 200

Pegelt es sich auf ~100 ein.

Ich würde gern auch Spitzen haben wie 0 und das Maximum. :freak:

@Kaeru

:roll: Also so richtig richtig zufällig ist es auch noch nicht.
Hab die Körbe mal fest auf 10 eingestellt.

Es kommen oft Füllmengen pro Korb doppelt vor und wie du selbst schreibst, sind ne Menge Nullen bei.

Was wäre, wenn man eine logarithmische Kurve nimmt und zufällig bestimmt, wie weit die einzelnen Korbwerte auseinander liegen?

Vielleicht müsste man auch drei Methoden nach einander anwenden.

:shock:

Verfasst: 22.10.2008 23:10
von Kaeru Gaman
Xaby hat geschrieben:@Kaeru

:roll: Also so richtig richtig zufällig ist es auch noch nicht.
doch das ist es, das ist ja grad dein problem.
wenn man am Anfang zufällig zu viel rein tut, dann bleiben am Ende eben wenige übrig.

... mach halt mal das Maximum auf faktor 2 oder 1.5, schreib die zahl an den anfang der formel.

Verfasst: 22.10.2008 23:33
von Froggerprogger
Hier nochmal der überarbeitete und erweiterte Code (nutzt kein ArraySize() mehr, aber immernoch ein Array als Parameter, gibt's das schon bei 4.2? Ich nutze 4.3):

Code: Alles auswählen

Procedure.l Min(a.l, b.l)
  If a > b
    ProcedureReturn b
  Else
    ProcedureReturn a
  EndIf
EndProcedure

Procedure.l Max(a.l, b.l)
  If a > b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure.l FillRandom(A.l(1), arraySize.l, limit.l, sum.l, mode.l)
 
  If arraySize * limit < sum ; problem not solveable
    ProcedureReturn #False
  EndIf

  If mode > limit ; senseless to make uniform > limit
    mode = limit
  EndIf

  remainSum.l = sum
  n.l = arraySize
  While remainSum > 0
    curIndex.l = Random(n-1)
   
    If mode = -1
      curVal.l = 1 ; use only portion of 1 => uniform distribution
    ElseIf mode = -2
      curVal.l = Max(1, Random(Min(limit, remainSum/n))) ; use bigger portions => near uniform
    ElseIf mode > 0
      curVal.l = Max(1, Random(Min(mode, remainSum))) ; use up to customized portions at each round
    EndIf
   
    If A(curIndex)+curVal < limit
      A(curIndex)+curVal
      remainSum-curVal
    EndIf
  Wend

  ProcedureReturn #True
EndProcedure

;- example
arraySize.l = 10

Dim A.l(arraySize)
FillRandom(A(), arraySize, 400, 1000, -1) ; uniform
Debug "uniform"
For i=0 To arraySize-1
  Debug A(i)
Next

Dim A.l(arraySize)
FillRandom(A(), arraySize, 400, 1000, -2) ; near uniform
Debug "near uniform"
For i=0 To arraySize-1
  Debug A(i)
Next 

Dim A.l(arraySize)
FillRandom(A(), arraySize, 400, 1000, 200) ; portion-size up to 200
Debug "stronger disturbed"
For i=0 To arraySize-1
  Debug A(i)
Next
Der bietet drei Veteilungsmodi:
a) uniform (könnte wie bei Little John noch beschleunigt werden)
b) near uniform (etwas schneller, aber Ziel ebenfalls etwa uniforme Verteilung)
c) zufällige Päckchengröße bis zu Parameterwert mode.l (Je größer mode.l, desto krasser streut die Verteilung.)

Hier eine Beispielausgabe:

Code: Alles auswählen

uniform
109
87
104
93
95
99
112
101
108
92
near uniform
38
91
158
135
124
86
119
126
37
86
stronger disturbed
94
20
236
0
96
167
2
312
1
72

Verfasst: 23.10.2008 02:26
von Xaby
@Kaeru

Ja, leider heiraten kann ich dich auch nicht.

Es tritt ein Fehler auf, wenn die Summe der Äpfel größer wird als zwei volle Körbe, würde ich vorsichtig schätzen.

Code: Alles auswählen

EnableExplicit

; Startwerte, nimm was du willst

Define l.l
For l=0 To 9

Define Koerbe = 3

Define MaxProKorb = 255;Aepfel / Koerbe * 3

Define Aepfel = Random(Koerbe*MaxProKorb)

Define AlleAepfel=0
Define DieserKorb=0

Define n=0, sum=0

Define out$=""

Dim Korb(Koerbe)


Debug "=========================================="
Debug Str(Aepfel) + " Äpfel in " + Str(Koerbe) + " Körben."
Debug "- - - - - - - - - - - - - - - -"


For n=1 To Koerbe
  DieserKorb =  Random(MaxProKorb)
  If AlleAepfel + DieserKorb > Aepfel
    DieserKorb = Aepfel - AlleAepfel
  EndIf
  AlleAepfel + DieserKorb
  Korb(n) = DieserKorb
  Debug "In Korb " + Str(n) + " sind " + Str(DieserKorb) + " Äpfel."
Next

Debug "------------------------------"
Debug "Probe:"
out$ = Str(Korb(1))
sum = Korb(1)
For n=2 To Koerbe
  out$ + " + " + Str(Korb(n))
  sum + Korb(n)
Next
out$ + " = " + Str(sum)
If sum = Aepfel
  Debug "stimmt"
  Else
  Debug "F E H L E R!!!"
EndIf
Debug out$

Next
Alle Zeiten sind UTC+02:00
Seite 2 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de