Aktuelle Zeit: 22.11.2019 00:00

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: Umfassende Random-Funktion
BeitragVerfasst: 18.06.2019 22:22 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Want more random with your random? 8)
Ich habe eine umfassende Zufallszahlen-Maschine geschrieben, die mir bei meinen Spielereien große Dienste leistet.
Code:
Rnd(min,max,[Mode])

erzeugt komfortable Zufallszahlen mit der Option auf diverse statistische Verteilungen:

Features:
• wenn man sich mit dem min und max-Wert vertut, werden die Werte automatisch korrigiert
• es dürfen negative Zahlen übergeben werden (auch beide Werte!)
• Der [Mode]-Parameter ist optional. Wenn man hier nichts eingibt, wird einfach nur stumpf eine Zahl innerhalb der übergebenen range erzeugt (#Rnd_Default)
• #Rnd_BellCurve erzeugt Zahlen gemäß der Gauß'schen Normalverteilung, will heißen, die range wird auf 2 Würfel aufgeteilt
• #Rnd_WellCurve erzeugt Zahlen gemäß einer invertierten Normalverteilung, d.h. extreme Werte in beiden Achsen werden bevorzugt
• #Rnd_GaußCeil erzeugt einen Gauß'schen Würfel mit Wichtung zum oberen Wert hin (z.B. erzeugt der Bereich 1-10 einen Würfel mit 55 Seiten)
• #Rnd_GaußFloor erzeugt einen Gauß'schen Würfel mit Wichtung zum unteren Wert

Viel Spaß! :) :lurk:

//EDIT:
Update 20.06.2019


Code:
EnableExplicit
Enumeration
   #Rnd_Default
   #Rnd_BellCurve
   #Rnd_GaussCeil
   #Rnd_GaussFloor
   #Rnd_WellCurve
EndEnumeration
Declare Rnd(min,max,rndMode = #Rnd_Default)




Define dice
Define a
Define low   = -10
Define high   = -2
Define offset = -low      ;offset for Dim(), in case negative numbers are involved
Dim nr(high+offset)      

For a = 1 To 1000000                  ;roll 1 mio. numbers
   dice = Rnd(low,high,#Rnd_GaussCeil)
   nr(dice+offset) +1                  ;count, how often each number appears
Next

For a = low To high
   Debug ""+a+": "+nr(a+offset)
Next











Procedure Rnd(min,max,rndMode = #Rnd_Default)
   Define newValue
   Define minus
   Define a
   Define sum, add
   Dim dice(1)
   Define lowMedian, highMedian
   Define absLow, absHigh
   
   If min > max                   ;wrong values will be corrected
      Swap min,max
   EndIf
   
   
   max - min                  ;always work with numbers from 0 to x
   
   
   
   Select rndMode
      Case #Rnd_Default
         newValue = Random(max)         ;roll a die, duh
         
      Case #Rnd_BellCurve
         If max % 2 = 0                  ;if difference is even ...
            dice(0) = max/2            ;... create 2 even dice
            dice(1) = max/2
         Else         
            dice(0) = (max-1)/2            ;otherwise create 2 different dice (0-x and 0-(x+1))
            dice(1) = (max+1)/2
         EndIf
         newValue = Random(dice(0)) + Random(dice(1))   
         
      Case #Rnd_GaussCeil, #Rnd_GaussFloor
         max +1                           ;temporarily increase max by 1 (Small Gauss only works with numbers > 0)
         sum = (max+1)*(max*0.5)          ;sum of all numbers from 1 to the chosen maxValue = Small Gauss
         newValue = Random(sum,1)       ;roll a random number between 1 and the Small Gauss
         For a = 1 To max
            add = add+a
            If add >= newValue               ;find the corresponding value
               If rndMode = #Rnd_GaussCeil      :   newValue = a - 1      :   EndIf   ;get high values
               If rndMode = #Rnd_GaussFloor   :   newValue = (max-a)       :   EndIf  ;get low values
               Break
            EndIf
         Next
         
      Case #Rnd_WellCurve
         lowMedian =  max/2
         highMedian = max/2
         If lowMedian + highMedian < max
            highMedian +1
         EndIf
         dice(0) = Random(lowMedian)                  ;get a low DieRoll (0 to lowMedian)
         dice(1) = Random(max,highMedian)          ;get a high DieRoll (highMedian to max)
         absLow = Abs(dice(0)-lowMedian)             ;determine, which roll is farther away from the Median value ...
         absHigh = Abs(dice(1)-highMedian)
                                          ;... and pass it back
         If absLow = absHigh
            newValue = dice(Random(1))
         EndIf
         If absLow > absHigh
            newValue = dice(0)                       
         EndIf
         If absHigh > absLow
            newValue = dice(1)
         EndIf
         
   EndSelect
   
   
   ProcedureReturn newValue + min      ;Add back the initially subtraced min-Value
EndProcedure

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Zuletzt geändert von diceman am 21.06.2019 14:53, insgesamt 5-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 08:46 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
Gefällt mir :allright:

Was mir aufgefallen ist:

Ich denke hier ist ein kleiner Fehler:
Code:
  If min < 0                     ;if negative values are involved ...
      min = 0                     ; ...temporarily elevate them into the positive range ...
      max + minus                 
      minus = Abs(min)            ; ...and store the offset
   EndIf


Damit 'max +' auch einen Wert erhält:
Code:
   If min < 0                     ;if negative values are involved ...
      min = 0                     ; ...temporarily elevate them into the positive range ...         
      minus = Abs(min)            ; ...and store the offset
      max + minus         
   EndIf

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 09:10 
Offline

Registriert: 13.05.2010 09:26
Wohnort: Berlin
Mijikai hat geschrieben:
Gefällt mir :allright:

Was mir aufgefallen ist:

Ich denke hier ist ein kleiner Fehler:
Code:
  If min < 0                     ;if negative values are involved ...
      min = 0                     ; ...temporarily elevate them into the positive range ...
      max + minus                 
      minus = Abs(min)            ; ...and store the offset
   EndIf


Damit 'max +' auch einen Wert erhält:
Code:
   If min < 0                     ;if negative values are involved ...
      min = 0                     ; ...temporarily elevate them into the positive range ...         
      minus = Abs(min)            ; ...and store the offset
      max + minus         
   EndIf

Ich habe mir den Code im Ursprungsposting nicht näher angesehen, aber die beiden hier zitierten Schnipsel können vereinfacht werden zu
Code:
If min < 0     
   min = 0   
   max + minus
   minus = 0
EndIf

und

Code:
If min < 0 
   min = 0         
   minus = 0
   max + 0         
EndIf

;-)

_________________
Dieser Satz ist falsch.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 09:43 
Offline

Registriert: 13.05.2010 09:26
Wohnort: Berlin
diceman hat geschrieben:
• #Rnd_BellCurve erzeugt Zahlen gemäß der Gauß'schen Normalverteilung, will heißen, die range wird auf 2 Würfel aufgeteilt

Die Idee geht in die richtige Richtung, denn der zentrale Grenzwertsatz rechtfertigt die Annahme, dass eine Zufallsvariable normalverteilt ist, wenn verschiedene Einflüsse additiv und unabhängig voneinander zusammenwirken. Man kann also im Prinzip durch Addition von Würfelergebnissen angenähert normalverteilte Werte erhalten. Mit nur 2 Würfeln ist die Annäherung allerdings sehr schlecht! Da sollte man schon mehr nehmen. Oder man macht es besser gleich ganz anders, eine Suche im engl. Forum lohnt sich in dieser Hinsicht.

_________________
Dieser Satz ist falsch.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 10:18 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Ich finde es nicht gut, dass hier Ganzzahlen und Fließkommazahlen vermischt werden. Abs(), Round() und Zahlen wie 0.5 sind hier fehl am Platz. Große Integer werden so verfälscht und Fließkommaungenauigkeiten können auftreten. Allgemein lässt die Typisierung zu wünschen übrig. Bitte einmal am Anfang EnableExplicit einfügen und alles korrigieren. Wo kommen eigentlich die Konstanten her? Den Code kann ich so gar nicht erst starten, da #Rnd_Default nicht gefunden wird.

_________________
Neustes Video: Neje DK - 1 Watt Laser Engraver
Ubuntu Gnome 19.04 LTS x64, PureBasic 5.71 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 12:33 
Offline
Benutzeravatar

Registriert: 22.02.2008 20:49
Wohnort: Utah, USA
Ausführbar:

Code:
;code by diceman with minor modifications by Demivec
Runtime Enumeration
  #Rnd_BellCurve
  #Rnd_WellCurve
  #Rnd_GaussCeil
  #Rnd_GaussFloor
  #Rnd_Default
EndEnumeration

Procedure Rnd(min,max,rndMode = #Rnd_Default)
   Define singleDie
   Define minus
   Define a
   Define sum, add
   Dim dice(1)
   Define lowMedian, highMedian
   Define absLow, absHigh
   
   If min > max                   ;wrong values will be corrected
      Swap min,max
   EndIf
   
   If min < 0                     ;if negative values are involved ...
      minus = min                 ; ...store the offset
      min = 0                     ; ...and temporarily elevate them into the positive range ...
      max - minus                 
     
   EndIf
   
   Select rndMode
      Case #Rnd_Default
        singleDie = Random(max, min)         ;roll a die, duh
       
       Case #Rnd_BellCurve
        max - min                     ;always work with numbers from 0 to x
        If (((max  / 2) + 1) % 2) = 0       ;if difference is even ...
          dice(0) = (max  / 2)           ;... create 2 even dice
          dice(1) = (max  / 2)
        Else
          dice(0) = ((max-1) / 2)         ;otherwise create 2 different dice (0-x and 0-(x+1))
          dice(1) = ((max+1) / 2)
        EndIf
        singleDie = Random(dice(0)) + Random(dice(1)) + min   ;roll both dice, add values up, and add back the subtracted min value
       
      Case #Rnd_GaussCeil, #Rnd_GaussFloor
         sum = (max + 1) * (max / 2)               ;sum of all numbers from 1 to the chosen maxValue = Small Gauss
         singleDie = Random(sum, 1)             ;roll a random number between 1 and the Small Gauss
         add = 0
         For a = 1 To max
            add + a
            If add >= singleDie               ;find the corresponding value
               If rndMode = #Rnd_GaussCeil      :   singleDie = (a + min) - 1      :   EndIf   ;get high values
               If rndMode = #Rnd_GaussFloor   :   singleDie = (max - a) + min      :   EndIf  ;get low values
               Break
            EndIf
         Next
         
      Case #Rnd_WellCurve
         lowMedian = (max + min) / 2                      ;get RoundDown Median
         highMedian = (max + min + 1) / 2                 ;get RoundUp Median (both Values may be the same)
         dice(0) = Random(lowMedian, min)                  ;get a low DieRoll (0 to lowMedian)
         dice(1) = Random(max, highMedian)               ;get a high DieRoll (highMedian to max)
         absLow = lowMedian - dice(0)                  ;determine, which roll is farther away from the Median value ...
         absHigh = dice(1) - highMedian
                                                ;... and pass it back
         If absLow = absHigh
            singleDie = dice(Random(1))
         EndIf
         If absLow > absHigh
            singleDie = dice(0)                       
         EndIf
         If absHigh > absLow
            singleDie = dice(1)
         EndIf
         
   EndSelect
   
   
   If minus
      singleDie + minus            ;if negative numbers were given, restore the original range
   EndIf
   
   ProcedureReturn singleDie
 EndProcedure
 
 CompilerIf #PB_Compiler_IsMainFile
   Define cg_width = 200, cg_height = 200
 
   Procedure drawResults(cgID, reps = 10, RND_Type = #PB_Default, title$ = "Default")
     Shared cg_width, cg_height
     Protected min = 0, max = cg_height - 5, x, i, result
     
     StartDrawing(CanvasOutput(cgID))
     
       Box(0, 0, OutputWidth(), OutputHeight(), RGB(0, 0, 0))
       
       If RND_Type < 0 Or RND_Type > #Rnd_Default
         RND_Type = #Rnd_Default
       EndIf
       
       FrontColor(RGB(((RND_Type + 1) * $80) % 256, ((RND_Type + 1) * $40) % 256, ((RND_Type - 1) * $C0) % 256))
       For i = 1 To reps
         For x = 0 To cg_width - 1
           result = Rnd(min, max, RND_Type)
           Plot(x, result)
         Next
       Next

       DrawText((cg_width - TextWidth(title$)) / 2, 0, title$, RGB(0, 0, 0), RGB($C0, $C0, $C0))
       
     StopDrawing()
   EndProcedure
       
   OpenWindow(0, 0, 0, cg_width * 3, cg_height * 2, "Test", #PB_Window_SystemMenu)
   SetWindowColor(0, RGB(0, 0, 0))
   CanvasGadget( 0,            0,             0, cg_width, cg_height)
   CanvasGadget( 1, cg_width    ,             0, cg_width, cg_height)
   CanvasGadget( 2, cg_width * 2,             0, cg_width, cg_height)
   CanvasGadget( 3,            0, cg_height    , cg_width, cg_height)
   CanvasGadget( 4, cg_width    , cg_height    , cg_width, cg_height)
   
   Define reps = 50
   drawResults(0, reps, #Rnd_Default, "Default")
   drawResults(1, reps, #Rnd_BellCurve, "BellCurve")
   drawResults(2, reps, #Rnd_WellCurve, "WellCurve")
   drawResults(3, reps, #Rnd_GaussCeil, "GaussCeil")
   drawResults(4, reps, #Rnd_GaussFloor, "GaussFloor")
   
   Define event
   Repeat
     event = WaitWindowEvent()
     If event = #PB_Event_CloseWindow
       End
     EndIf
   ForEver
   
 CompilerEndIf

_________________
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 14:24 
Offline

Registriert: 13.05.2010 09:26
Wohnort: Berlin
NicTheQuick hat geschrieben:
Bitte einmal am Anfang EnableExplicit einfügen und alles korrigieren. Wo kommen eigentlich die Konstanten her? Den Code kann ich so gar nicht erst starten, da #Rnd_Default nicht gefunden wird.

Meiner Ansicht nach hat Code ohne EnableExplicit am Anfang hier in der "Tipps und Tricks"-Abteilung nichts verloren. Und Code der nicht ausführbar ist schon gar nicht.

_________________
Dieser Satz ist falsch.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 14:48 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Ist gemerkt, sorry. Das ich die Konstanten vergessen habe, war ein simpler copy/paste-Fail. Auch dafür ein sorry.
Nächstes Mal wieder mit ausführbarer Demo.
Ist mir zum ersten Mal passiert, daß ich hier wirklich empirischen Mist reingestellt habe. :coderselixir:
Falls überhaupt noch jemand daran interessiert ist, kann ich später ein lauffähiges, bugbereinigtes Update reinstellen. Ansonsten darf der Thread auch gerne gelöscht, bzw verschoben werden, damit er hier nichts vollmüllt). :)




Nic hat geschrieben:
Ich finde es nicht gut, dass hier Ganzzahlen und Fließkommazahlen vermischt werden. Abs(), Round() und Zahlen wie 0.5 sind hier fehl am Platz. Große Integer werden so verfälscht

Round() wird lediglich dazu verwendet, um bei ungerader range den unteren und oberen Bereich abzustecken. Es werden, egal in welcher Größenordnung, keine Zahlen verfälscht, und es kommen auch keine Fließkommazahlen dabei herum:

Code:
lowMedian = Round((max+min)/2,#PB_Round_Down)     ;(2501+0)/2 = 2500
highMedian = Round((max+min)/2,#PB_Round_Up)        ;(2501+0)/2 = 2501

Alternativ hätte man es auch mit
Code:
lowMedian = (min+max-1)/2
highMedian = (min+max+1)/2

lösen können. Wahrscheinlich die bessere Alternative.




Mijikai hat geschrieben:
Ich denke hier ist ein kleiner Fehler:
Code:
  If min < 0                     ;if negative values are involved ...
      min = 0                     ; ...temporarily elevate them into the positive range ...
      max + minus                 
      minus = Abs(min)            ; ...and store the offset
   EndIf


Danke! :oops:
Stimmt natürlich. So muß es aussehen:

Code:
  If min < 0                     ;if negative values are involved ...
      minus = Abs(min)            ; ...store the offset
      min = 0                     ; ...and temporarily elevate them into the positive range ...         
      max + minus         
   EndIf

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Zuletzt geändert von diceman am 19.06.2019 15:41, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 15:41 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
diceman hat geschrieben:
Nic hat geschrieben:
Ich finde es nicht gut, dass hier Ganzzahlen und Fließkommazahlen vermischt werden. Abs(), Round() und Zahlen wie 0.5 sind hier fehl am Platz. Große Integer werden so verfälscht

Round wird lediglich dazu verwendet, um bei ungerader range den unteren und oberen Bereich abzustecken. Es werden, egal in welcher Größenordnung, keine Zahlen verfälscht, und es kommen auch keine Fließkommazahlen dabei herum:

Code:
lowMedian = Round((max+min)/2,#PB_Round_Down)     ;(2501+0)/2 = 2500
highMedian = Round((max+min)/2,#PB_Round_Up)        ;(2501+0)/2 = 2501

Alternativ hätte man es auch mit
Code:
lowMedian = (min+max-1)/2
highMedian = (min+max+1)/2

lösen können.

Ich erkläre es nochmal genauer. Funktionen wie Abs() und Round() liefern immer Fließkommazahlen zurück. Und auch wenn Doubles insgesamt 64 Bit breit sind, ist ihre Mantisse nur 52 Bit breit. Das heißt ab einer gewissen Höhe stimmt ihr Ergebnis nicht mehr mit der übergebenen Ganzzahl überein. Hier ein Beispiel:
Code:
i = 1 << 53 + 1
Debug i
Debug Abs(i)

Das Gute ist: Das Abs(min) kannst du vermeiden, da du es eh nur aufrufst, wenn min < 0 ist. Die Alternative ist also:
Code:
min = -min

und schon hast du die positive Version der Zahl.

Round kannst du auch umgehen. Abgerundet wird bei Ganzzahlen sowieso immer automatisch, zumindest solange die Eingabe positiv ist, da einfach nur die Nachkommastelle abgeschnitten wird. Bei einer negativen Summe muss man noch darauf achten, ob sie gerade oder ungerade ist. Ich würde deshalb folgende Alternativen vorschlagen:
Code:
Procedure medianLow(a.i, b.i)
   Protected sum.i = a + b
   
   If sum > 0
      ProcedureReturn sum / 2
   Else
      ProcedureReturn sum / 2 - sum & 1
   EndIf
EndProcedure

Debug medianLow(1, 2)
Debug medianLow(-1, -2)
Debug medianLow(-1, -3)

Procedure medianHigh(a.i, b.i)
   Protected sum.i = a + b
   
   If sum > 0
      ProcedureReturn sum / 2 + sum & 1
   Else
      ProcedureReturn sum / 2
   EndIf
EndProcedure

Debug medianHigh(1, 2)
Debug medianHigh(-1, -2)
Debug medianHigh(-1, -3)


Und ansonsten muss dieser Thread nicht gelöscht werden. Wenn der Code reif ist, kannst du ihn einfach im ersten Post ersetzen und alle sind glücklich. Die Diskussion um die Fehler kann schließlich auch noch anderen helfen.

_________________
Neustes Video: Neje DK - 1 Watt Laser Engraver
Ubuntu Gnome 19.04 LTS x64, PureBasic 5.71 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Umfassende Random-Funktion
BeitragVerfasst: 19.06.2019 15:48 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Daß Abs() eine Fließkommazahl zurückgibt, wußte ich nicht, bzw. habe es nie in Frage gestellt. :shock: :freak: Danke für den Hinweis!
Daß mit Round() leuchtet mir jetzt auch ein (habe ja bereits selbst eine bessere und saubere Alternative "entwickelt").
Ja, gelernt habe ich eine Menge aus diesem Thread. Und ihr habt mir geholfen, einen tatsächlich schwerwiegenden Bug zu finden (min = 0, bevor der Wert sicher abgelegt wurde).

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye