WeigthedRandom - OOP

Advanced game related topics
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 640
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

WeigthedRandom - OOP

Post by StarBootics »

Hello everyone,

Something that might be useful in a game project a WeigthedRandom system.

This code is based on this video on Youtube Coding Math: Episode 47 - Weighted Random
Weighted random functions allow you to randomly choose between multiple options, while specifying the exact odds of getting any one option.
So I deserve the credit for porting the code form Javascript to PureBasic.

Feel free to modify

EDIT : Code updated to V1.1.0 - Some correction suggested by STARGATE

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : WeigthedRandom
; File Name : WeigthedRandom - OOP.pb
; File version: 1.1.0
; Programming : OK
; Programmed by : StarBootics
; Date : May 1st, 2021
; Last Update : May 2nd, 2021
; PureBasic code : V5.73 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming notes
;
; Code based on the Youtube channel "Coding Math" video :
; 
; "Coding Math: Episode 47 - Weighted Random"
;
; https://www.youtube.com/watch?v=MGTQWV1VfWk
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Correction
;
; The use of a RandomFloat() and chance changed to float as 
; well suggested by STARGATE appear to have solved the 
; problem when the odds are the same for two or more items
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule WeigthedRandom
  
  Interface WeigthedRandom
    
    AddValues(Chance.f, Associated.s)
    Clear()
    RandomPick.s()
    Free()
    
  EndInterface
  
  Declare.i New()
  
EndDeclareModule

Module WeigthedRandom
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Structures declaration <<<<<
  
  Structure Values
    
    Chance.f
    Associated.s
   
  EndStructure
  
  Structure Private_Members
    
    VirtualTable.i
    List Values.Values()
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< RandomFloat <<<<<
  
  Procedure.f RandomFloat(Maximum.f = 1.0, Minimum.f = 0.0)
    
    ; Suggested by STARGATE
    
    ProcedureReturn (Maximum-Minimum) * 4.6566128752457969241e-10 * Random(2147483647) + Minimum
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The AddValues operator <<<<<

  Procedure AddValues(*This.Private_Members, Chance.f, Associated.s)
    
    AddElement(*This\Values())
    *This\Values()\Chance = Chance
    *This\Values()\Associated = Associated
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Clear operator <<<<<

  Procedure Clear(*This.Private_Members)
   
    ClearList(*This\Values())
    
  EndProcedure

  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The RandomPick operator <<<<<
  
  Procedure.s RandomPick(*This.Private_Members)
    
    Static LastRandom.f
    Static OneShot.b
    
    If OneShot = 0
      OneShot = 1
      LastRandom = -1.0
    EndIf
    
    TotalChance.f = 0
    
    ForEach *This\Values()
      TotalChance + *This\Values()\Chance
    Next
    
    While Exit_Condition.b = #False
      
      Rand.f = RandomFloat() * TotalChance
      
     If Rand <> LastRandom
       Exit_Condition = #True
       LastRandom = Rand
     EndIf
      
    Wend
    
    ForEach *This\Values()
      
      If Rand < *This\Values()\Chance
        Break
      EndIf
      
      Rand - *This\Values()\Chance
      
    Next
    
    ProcedureReturn *This\Values()\Associated
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Destructor <<<<<

  Procedure Free(*This.Private_Members)
    
    FreeStructure(*This)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Constructor <<<<<

  Procedure.i New()
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    ProcedureReturn *This
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Virtual Table Entries <<<<<

  DataSection
    START_METHODS:
    Data.i @AddValues()
    Data.i @Clear()
    Data.i @RandomPick()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  DeclareModule BinaryTreeNode
    
    Interface BinaryTreeNode
      
      GetWord.s()
      GetWordCounter.l()
      GetChild.i(ChildID.l)
      SetWord(P_Word.s)
      SetWordCounter(P_WordCounter.l)
      SetChild(ChildID.l, P_Child.i)
      Free()
      
    EndInterface
    
    Declare.i New()
    
  EndDeclareModule
  
  Module BinaryTreeNode
    
    Structure Private_Members
      
      VirtualTable.i
      Word.s
      WordCounter.l
      Child.i[2]
      
    EndStructure
    
    Procedure.s GetWord(*This.Private_Members)
      
      ProcedureReturn *This\Word
    EndProcedure
    
    Procedure.l GetWordCounter(*This.Private_Members)
      
      ProcedureReturn *This\WordCounter
    EndProcedure
    
    Procedure.i GetChild(*This.Private_Members, ChildID.l)
      
      ProcedureReturn *This\Child[ChildID]
    EndProcedure
    
    Procedure SetWord(*This.Private_Members, P_Word.s)
      
      *This\Word = P_Word
      
    EndProcedure
    
    Procedure SetWordCounter(*This.Private_Members, P_WordCounter.l)
      
      *This\WordCounter = P_WordCounter
      
    EndProcedure
    
    Procedure SetChild(*This.Private_Members, ChildID.l, P_Child.i)
      
      *This\Child[ChildID] = P_Child
      
    EndProcedure
    
    Procedure Free(*This.Private_Members)
      
      For ChildID = 0 To 1
        If *This\Child[ChildID] <> #Null
          Free(*This\Child[ChildID])
        EndIf
      Next
      
      ; Debug "Free called for : " + *This\Word
      
      FreeStructure(*This)
      
    EndProcedure
    
    Procedure.i New()
      
      *This.Private_Members = AllocateStructure(Private_Members)
      *This\VirtualTable = ?START_METHODS
      
      ProcedureReturn *This
    EndProcedure
    
    DataSection
      START_METHODS:
      Data.i @GetWord()
      Data.i @GetWordCounter()
      Data.i @GetChild()
      Data.i @SetWord()
      Data.i @SetWordCounter()
      Data.i @SetChild()
      Data.i @Free()
      END_METHODS:
    EndDataSection
    
  EndModule
  
  DeclareModule BinaryTree
    
    Interface BinaryTree
      
      AddNode(Word.s)
      Debugging()
      Free()
      
    EndInterface
    
    Declare.i New()
    
  EndDeclareModule
  
  Module BinaryTree
    
    Structure Private_Members
      
      VirtualTable.i
      NodeCount.l
      Root.BinaryTreeNode::BinaryTreeNode
      
    EndStructure
    
    Procedure Private_AddNode(*This.Private_Members, *Node.BinaryTreeNode::BinaryTreeNode, Word.s)
      
      If *This\NodeCount = 0
        *This\NodeCount = *This\NodeCount + 1
        *Node\SetWord(Word)
        *Node\SetWordCounter(1)
        *Node\SetChild(0, #Null)
        *Node\SetChild(1, #Null)
      Else
        
        If *Node = #Null
          
          *Node = BinaryTreeNode::New()
          *This\NodeCount = *This\NodeCount + 1
          *Node\SetWord(Word)
          *Node\SetWordCounter(1)
          *Node\SetChild(0, #Null)
          *Node\SetChild(1, #Null)
          
        ElseIf UCase(*Node\GetWord()) = UCase(Word)
          
          *Node\SetWordCounter(*Node\GetWordCounter() + 1)
          
        ElseIf UCase(Word) < UCase(*Node\GetWord())
          
          *Node\SetChild(0, Private_AddNode(*This, *Node\GetChild(0), Word))
          
        ElseIf UCase(Word) > UCase(*Node\GetWord())
          
          *Node\SetChild(1, Private_AddNode(*This, *Node\GetChild(1), Word))
          
        EndIf
        
      EndIf
      
      ProcedureReturn *Node
    EndProcedure
    
    Procedure AddNode(*This.Private_Members, Word.s)
      
      Private_AddNode(*This, *This\Root, Word)
      
    EndProcedure
    
    Procedure Private_DebuggingNode(*Node.BinaryTreeNode::BinaryTreeNode)
      
      If *Node <> #Null
        
        Private_DebuggingNode(*Node\GetChild(0))
        
        If *Node\GetWordCounter() = 1
          Debug *Node\GetWord() + " -> " + Str(*Node\GetWordCounter()) + " time"
        Else
          Debug *Node\GetWord() + " -> " + Str(*Node\GetWordCounter()) + " times"
        EndIf
        
        Private_DebuggingNode(*Node\GetChild(1))
        
      EndIf
      
    EndProcedure
    
    Procedure Debugging(*This.Private_Members)
      
      Private_DebuggingNode(*This\Root)
      
    EndProcedure
    
    Procedure Free(*This.Private_Members)
      
      If *This\Root <> #Null
        *This\Root\Free()
      EndIf
      
      FreeStructure(*This)
      
    EndProcedure
    
    Procedure.i New()
      
      *This.Private_Members = AllocateStructure(Private_Members)
      *This\VirtualTable = ?START_METHODS
      
      *This\Root = BinaryTreeNode::New()
      
      ProcedureReturn *This
    EndProcedure
    
    DataSection
      START_METHODS:
      Data.i @AddNode()
      Data.i @Debugging()
      Data.i @Free()
      END_METHODS:
    EndDataSection
    
  EndModule
  
  Price.WeigthedRandom::WeigthedRandom = WeigthedRandom::New()
  
;   Price\AddValues(8, "nothing!")
;   Price\AddValues(5, "a gold piece!")
;   Price\AddValues(2, "a treasure chest!")
;   Price\AddValues(1, "a poison vial!")
;   Price\AddValues(3, "some food!")
  
  Price\AddValues(0.5, "nothing!")
;   Price\AddValues(5, "a gold piece!")
;   Price\AddValues(2, "a treasure chest!")
;   Price\AddValues(0.5, "a poison vial!")
  Price\AddValues(0.5, "some food!")
  
  For TestID = 0 To 4
    
    Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
    Debug "; Test ID : " + Str(TestID + 1)
    Debug ""
    
    MyTree.BinaryTree::BinaryTree = BinaryTree::New()
    
    For Index = 0 To 500
      MyTree\AddNode("You get " + Price\RandomPick())
    Next
    
    MyTree\Debugging()
    Debug ""
    
    MyTree\Free()
    
  Next
  
  Price\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by StarBootics on Sun May 02, 2021 4:08 pm, edited 1 time in total.
The Stone Age did not end due to a shortage of stones !
User avatar
STARGÅTE
Addict
Addict
Posts: 1444
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: WeigthedRandom - OOP

Post by STARGÅTE »

There is a mistake in your code. For a 1 to 1 chance the result is twice for the last item:

Code: Select all

  Price.WeigthedRandom::WeigthedRandom = WeigthedRandom::New()
  Price\AddValues(1, "nothing!")
  Price\AddValues(1, "some food!")
  
  MyTree.BinaryTree::BinaryTree = BinaryTree::New()
  For Index = 0 To 10000
  	MyTree\AddNode("You get " + Price\RandomPick())
  Next
  MyTree\Debugging()
  MyTree\Free()
  
  Price\Free()
You get nothing! -> 3319 times
You get some food! -> 6682 times
I think you have to write: "Rand.l = Random(TotalChance-1)" in Line 99

The next question is, why you not allow floating point values?
You can also easily calculate your TotalChance with floats and then generate a random float like here:

Code: Select all

Procedure.f RandomFloat(Maximum.f = 1.0, Minimum.f=0.0)
  
  ProcedureReturn (Maximum-Minimum) * 4.6566128752457969241e-10 * Random(2147483647) + Minimum
  
EndProcedure
An other question is, why you ignore a random number which is equal to the last number?
Such output is not really random:
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
nothing!
some food!
...
PB 5.73 ― Win 10, 20H2 ― Ryzen 9 3900X ― Radeon RX 5600 XT ITX ― Vivaldi 3.6 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 640
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: WeigthedRandom - OOP

Post by StarBootics »

Hello everyone,

I have updated to code to version 1.1.0 (see first post) . Now when I run an example like this one :

Code: Select all

  Price\AddValues(0.5, "nothing!")
;   Price\AddValues(5, "a gold piece!")
;   Price\AddValues(2, "a treasure chest!")
;   Price\AddValues(0.5, "a poison vial!")
  Price\AddValues(0.5, "some food!")
This what I get :
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Test ID : 1

You get nothing! -> 240 times
You get some food! -> 261 times

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Test ID : 2

You get nothing! -> 250 times
You get some food! -> 251 times

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Test ID : 3

You get nothing! -> 246 times
You get some food! -> 255 times

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Test ID : 4

You get nothing! -> 244 times
You get some food! -> 257 times

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Test ID : 5

You get nothing! -> 269 times
You get some food! -> 232 times
Appear to be OK to me.

Best regards
StarBootics
The Stone Age did not end due to a shortage of stones !
Post Reply