WeightedRandom - OOP

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

WeightedRandom - OOP

Post by StarBootics »

Hello everyone,

Something that might be useful in a game project a WeightedRandom 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 : WeightedRandom
; File Name : WeightedRandom - 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 WeightedRandom
  
  Interface WeightedRandom
    
    AddValues(Chance.f, Associated.s)
    Clear()
    RandomPick.s()
    Free()
    
  EndInterface
  
  Declare.i New()
  
EndDeclareModule

Module WeightedRandom
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< 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.WeightedRandom::WeightedRandom = WeightedRandom::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 Thu May 20, 2021 3:04 pm, edited 2 times in total.
The Stone Age did not end due to a shortage of stones !
User avatar
STARGÅTE
Addict
Addict
Posts: 1621
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: WeightedRandom - 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 4.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 716
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: WeightedRandom - 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 !
KayBur
User
User
Posts: 21
Joined: Tue Apr 20, 2021 11:45 am

Re: WeightedRandom - OOP

Post by KayBur »

Seems to be a good result. Although, it may be possible to optimize the process.
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 716
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: WeightedRandom - OOP

Post by StarBootics »

Hello everyone,

A little update.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : WeightedRandom
; File Name : WeightedRandom - OOP.pb
; File version: 1.2.0
; Programming : OK
; Programmed by : StarBootics
; Date : May 1st, 2021
; Last Update : May 18th, 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 V 1.1.0
;
; 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
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Correction V 1.2.0
; 
; In order to speed up the RandomPick() method the TotalChance
; is now being pre-calculated in the AddValues() method. Also
; the While loop to make sure that we never get the random 
; value two times back to back as been removed.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule WeightedRandom
  
  Interface WeightedRandom
    
    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
    TotalChance.f
    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
    *This\TotalChance + *This\Values()\Chance
    
  EndProcedure

  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Clear operator <<<<<

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

  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The RandomPick operator <<<<<
  
  Procedure.s RandomPick(*This.Private_Members)
           
    Rand.f = RandomFloat() * *This\TotalChance
    
    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.WeightedRandom::WeightedRandom = WeightedRandom::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!")
  
  For TestID = 0 To 4
    
    Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
    Debug "; Test ID : " + Str(TestID + 1)
    Debug ""
    
    MyTree.BinaryTree::BinaryTree = BinaryTree::New()
    
    For Index = 0 To 500
      ThePrice.s = "You get " + Price\RandomPick()
      ; Debug ThePrice
      MyTree\AddNode(ThePrice)
    Next
    
    MyTree\Debugging()
    Debug ""
    
    MyTree\Free()
    
  Next
  
  Price\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by StarBootics on Thu May 20, 2021 3:06 pm, edited 1 time in total.
The Stone Age did not end due to a shortage of stones !
Seymour Clufley
Addict
Addict
Posts: 1139
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Re: WeightedRandom - OOP

Post by Seymour Clufley »

You are mis-spelling "weighted", even in the thread title, over and over again.
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."
User avatar
Kiffi
Addict
Addict
Posts: 1206
Joined: Tue Mar 02, 2004 1:20 pm
Location: Amphibios 9

Re: WeightedRandom - OOP

Post by Kiffi »

Seymour Clufley wrote: Thu May 20, 2021 1:21 pm You are mis-spelling "weighted", even in the thread title, over and over again.
Corrected in the subjects
Hygge
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 716
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: WeightedRandom - OOP

Post by StarBootics »

Seymour Clufley wrote: Thu May 20, 2021 1:21 pm You are mis-spelling "weighted", even in the thread title, over and over again.
Sorry about that. I took time to correct the mis-spelling error should be OK now.

@Kiffi : Thanks for the change in the subject title.

Best regards
StarBootics
The Stone Age did not end due to a shortage of stones !
Seymour Clufley
Addict
Addict
Posts: 1139
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Re: WeightedRandom - OOP

Post by Seymour Clufley »

Thank you.
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."
Thorium
Addict
Addict
Posts: 1268
Joined: Sat Aug 15, 2009 6:59 pm

Re: WeightedRandom - OOP

Post by Thorium »

Looks a bit complecated.
There is a fairly simple approach to weighted random numbers. Take a look here: https://stackoverflow.com/questions/176 ... om-numbers

Maybe your binary tree is faster with big data sets, but probably to much overhead for small data sets.
User avatar
StarBootics
Enthusiast
Enthusiast
Posts: 716
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: WeightedRandom - OOP

Post by StarBootics »

Thorium wrote: Wed Jun 02, 2021 9:46 am Looks a bit complecated.
There is a fairly simple approach to weighted random numbers. Take a look here: https://stackoverflow.com/questions/176 ... om-numbers
Did you take time to watch the video on YouTube ? It look complicated because the chances doesn't need to add up to 1.000 unlike the example you provided.
Thorium wrote: Wed Jun 02, 2021 9:46 am Maybe your binary tree is faster with big data sets, but probably to much overhead for small data sets.
The binary tree was used because I was too lazy to program a Frequency Table to count the times all options occurs. You can delete it if you wish, it's not part of the WeightedRandom system.

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