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
So I deserve the credit for porting the code form Javascript to PureBasic.Weighted random functions allow you to randomly choose between multiple options, while specifying the exact odds of getting any one option.
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<