Returns Index of a pre-assigned Probability-Option

BlitzPlus Forums/BlitzPlus Tutorials/Returns Index of a pre-assigned Probability-Option

diceman(Posted 2010) [#1]
This is kinda hard to explain for a non-native speaker, but I'll try anyway; maybe someone can use this Function, too.

Say, you're programming an RPG-Game and you repeatedly want to check, whether certain events with different probabilites are about to happen. For example, you'll want to create a couple of Unique, Rare and Common Items, and that certain Unique Sword of Fate should occur much more scarcely then a common Famer's Shovel. Of course.

Now this neat little Function can be assigned certain fields of probabilites (a maximum of 10), then it rolls a dice within the range of 1 and all added fields, and finally returns the index, in which field the number occured. The Function can return a maximum of 10 Index-Numbers.

Dim z_chance(10) ;Maximum of Probabilty-Fields
Dim iReturn(10) ; Maximum of returned Numbers



; Initialize a 33% Chance, returns one Number:
Perchance(20,20,20,0,0,0,0,0,0,0,1)

; Initialize a 10 / 20 / 30 / 40% Chance, returns one Number:
Perchance(1,2,3,4,0,0,0,0,0,0,1)

; Initialize a 0.1 / 5 / 10% Chance (Remainder 84.9%), returns 4 Numbers:
Perchance(1,50,100,849,0,0,0,0,0,0,4)






Function Perchance(z_chance1,z_chance2,z_chance3,z_chance4,z_chance5,z_chance6,z_chance7,z_chance8,z_chance9,z_chance10,z_nr)
	Local zMax = 0
	Local z0
	Local zDice
	Local zAdd

	z_chance(1) = z_chance1
	z_chance(2) = z_chance2
	z_chance(3) = z_chance3
	z_chance(4) = z_chance4
	z_chance(5) = z_chance5
	z_chance(6) = z_chance6
	z_chance(7) = z_chance7
	z_chance(8) = z_chance8
	z_chance(9) = z_chance9
	z_chance(10) = z_chance10

        For a = 1 to z_nr
                iReturn(a) = 0
        Next
	
        z0 = 11
	For a = 1 To 10
		If z_chance(a) > 0
			zMax = zMax + z_chance(a)
		Else
			z0 = a
		EndIf
	Next
	
	For nr = 1 To z_nr
		zDice = Rand(1,zMax)
		zAdd = 0
		For a = 1 To (z0-1)
			zAdd = zAdd + z_chance(a)
			If zAdd >= zDice And iReturn(nr) = 0
				iReturn(nr) = a
			EndIf
		Next
	Next
End Function