Weighted Random

This code has been declared by its author to be Public Domain code.

Weighted Random by Streaksy

2010

This has probably been done in the archives but hopefully I've done it a little differently. I had portability and ease-of-use in mind.

Just add to the case list with AddWeightedCase(weight), weight being an integer.

Then to pick one of them using their weights, just call WeightedRandom().

Hope it's useful to someone. =D

;WEIGHTED RANDOM ARRAYS
Global weightedcases,maxweightedcases=10000
Dim weightedcaseweight(maxweightedcases)
Dim weightedcaselabel$(maxweightedcases)






;DEMO
AppTitle "Weighted Random Demo"
Dim demodim(10)
AddWeightedCase 10
AddWeightedCase 5
AddWeightedCase 2
AddWeightedCase 1
AddWeightedCase 1
AddWeightedCase 1
AddWeightedCase 1
AddWeightedCase 1
AddWeightedCase 1
AddWeightedCase 1
SetBuffer BackBuffer()
SetFont LoadFont("verdana",17)
Repeat
Cls
		w=WeightedRandom()
		demodim(w)=demodim(w)+1
	For t=1 To 10
	Color 100,50,50:Rect 0,(t-1)*20,demodim(t),18
	Color 100,150,255:Text 20,(t-1)*20,"weight: "+weightedcaseweight(t)
	Next
		sum=0
		For t=1 To 10
		sum=sum+demodim(t)
		Next
	For t=1 To 10
	perc=(demodim(t)*100)/sum
	Color 100,250,155:Text 220,(t-1)*20,"occurance: "+perc+"%"
	Next
Flip
Until KeyHit(1)
End







;WEIGHTED RANDOM FUNCTIONS
Function WeightedRandom()
For t=1 To weightedcases:maxweight=maxweight+weightedcaseweight(t):Next
v=Rand(1,maxweight)
	For t=1 To weightedcases
	w=weightedcaseweight(t)
	If maxweight-w<v Then Return t
	maxweight=maxweight-w
	Next
End Function

Function AddWeightedCase(weight,label$="")
weightedcases=weightedcases+1
weightedcaseweight(weightedcases)=weight
weightedcaselabel(weightedcases)=label
End Function

Function ClearWeightedCases()
weightedcases=0
End Function

Comments

None.

Code Archives Forum