Steve's Simple Dice Roller

[SMcNeill]

My old dice rolling routine, shared for Staxtix, to help showcase the core idea behind my new and improved utility which I'm working up:

Code: QB64: [Select]

1. _TITLE "Steve's Simple Dice Roller"
2. SCREEN _NEWIMAGE(1280, 720, 256)
3.  
4. REDIM SHARED Results(0, 0) AS LONG
5. RANDOMIZE TIMER
6.  
7.  
8. QuickRoll 10, 2, 10, 0, 0, 0, 0
9. PrintResults
10. SLEEP
11. QuickRoll 2, 5, 6, 1, 0, 3, 0
12. PrintResults
13. SLEEP
14.  
15. DO
16.     INPUT "Dice to Roll =>"; d$
17.     IF LTRIM$(d$) = "" THEN EXIT DO
18.     IF UCASE$(d$) = "R" THEN d$ = old$ 'R for Reroll
19.     old$ = d$
20.     RollDice d$
21.     PrintResults
22. LOOP
23.  
24. SYSTEM
25.  
26.  
27.  
28. SUB QuickRoll (S, D, N, DM, TM, KH, KL)
29.     REDIM Results(S, D) AS LONG
30.     REDIM Rolls(D - 1) AS LONG, LowRolls(D - 1) AS LONG
31.  
32.     IF KL < 0 THEN KL = 0
33.     IF KH < 0 THEN KH = 0
34.     IF KL > D THEN KL = D
35.     IF KH > D THEN KH = D
36.  
37.     Results(0, 0) = TM
38.     FOR j = 1 TO S
39.         FOR i = 1 TO D
40.             Rolls(i - 1) = INT(RND * N) + 1 + DM
41.             'PRINT Rolls(i - 1),                               'UNREMARK THIS LINE TO SEE UNSORTED NUMBERS
42.         NEXT
43.         'PRINT                                                 'AND THIS LINE TO SEE UNSORTED NUMBERS
44.  
45.         'The dice sorting routine, optimized to use _MEM and a comb sort algorithm.  It's more than fast enough for our needs here I think.  ;)
46.         IF D > 1 THEN 'No need to try and sort only 1 dice.
47.             DIM m AS _MEM
48.             DIM o AS _OFFSET, o1 AS _OFFSET
49.             DIM t AS LONG, t1 AS LONG
50.             m = _MEM(Rolls())
51.             $CHECKING:OFF
52.             gap = UBOUND(Rolls)
53.  
54.             DO
55.                 gap = 10 * gap \ 13
56.                 IF gap < 1 THEN gap = 1
57.                 i = 0
58.                 swapped = 0
59.                 DO
60.                     o = m.OFFSET + i * 4
61.                     o1 = m.OFFSET + (i + gap) * 4
62.                     IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
63.                         _MEMGET m, o1, t1
64.                         _MEMGET m, o, t
65.                         _MEMPUT m, o1, t
66.                         _MEMPUT m, o, t1
67.                         swapped = -1
68.                     END IF
69.                     i = i + 1
70.                 LOOP UNTIL i + gap > UBOUND(Rolls)
71.             LOOP UNTIL swapped = 0 AND gap = 1
72.             $CHECKING:ON
73.             _MEMFREE m
74.         END IF
75.  
76.         'FOR i = 1 TO d: PRINT Rolls(i - 1),: NEXT: PRINT      'UNREMARK THIS LINE TO SEE THE SORTED NUMBERS, BEFORE WE DISCARD LOW OR HIGH
77.  
78.         IF KH THEN 'drop the undesired low rolls
79.             FOR i = 1 TO D - KH: Rolls(i - 1) = 0: NEXT
80.         END IF
81.         IF KL THEN 'drop the undesired high rolls
82.             FOR i = KL + 1 TO D: Rolls(i - 1) = 0: NEXT
83.         END IF
84.         FOR i = 1 TO D
85.             Results(j, i) = Rolls(i - 1)
86.         NEXT
87.     NEXT
88.  
89.  
90.     FOR j = 1 TO S
91.         total = 0
92.         FOR i = 1 TO D
93.             total = total + Results(j, i)
94.         NEXT
95.         total = total + Results(0, 0) 'Results 0,0 holds our total modifier
96.         Results(j, 0) = total 'And store the total in the 0 element of the array
97.     NEXT
98.  
99.  
100.  
101. END SUB
102.  
103.  
104. SUB RollDice (text$)
105.     DIM s AS LONG, d AS LONG, n AS LONG
106.     DIM dm AS LONG, tm AS LONG
107.  
108.     'First strip spaces if any
109.     FOR i = 1 TO LEN(text$)
110.         IF MID$(text$, i, 1) <> " " THEN t$ = t$ + MID$(text$, i, 1)
111.     NEXT
112.     d$ = UCASE$(text$) 'Then make it UCASE for ease of parsing
113.  
114.     'Parse the text for the proper number and size dice to roll
115.     l = INSTR(d$, "D") 'l is the location of the D which tells us how many dice to roll and what size
116.     MID$(d$, l) = "@" 'Replace the D with something else so we don't accept it as a scientific notation value
117.     l1 = INSTR(l + 1, d$, "+") 'l1 is the location of the dice modifier (+/-), which is optional
118.     IF l1 = 0 THEN l1 = INSTR(l + 1, d$, "-")
119.  
120.     l2 = INSTR(d$, "S") 'l2 is the location of S, which is the number of sets of dice we want to roll
121.  
122.     l3 = INSTR(d$, "T") 'l3 is the location of the total modifier, if any
123.     IF l1 > l3 AND l3 <> 0 THEN l1 = 0 'In case we have a T-100 and not a +/- to the dice rolls first
124.  
125.     l4 = INSTR(d$, "KH") 'l4 tells us how many of the high rolls to keep
126.     IF l4 = 0 THEN l4 = -INSTR(d$, "KL") 'or how many of the low rolls to keep
127.  
128.     s = VAL(LEFT$(d$, l2)): IF s < 1 THEN s = 1
129.     d = VAL(MID$(d$, l2 + 1)): IF d < 1 THEN d = 1
130.     n = VAL(MID$(d$, l + 1)): IF n <= 0 THEN REDIM Results(0, 0) AS LONG: EXIT SUB
131.  
132.     IF l1 THEN dm = VAL(MID$(d$, l1))
133.     IF l3 THEN tm = VAL(MID$(d$, l3 + 1))
134.     IF l4 > 0 THEN kh = VAL(MID$(d$, l4 + 2))
135.     IF l4 < 0 THEN kl = VAL(MID$(d$, -l4 + 2))
136.     IF kl < 0 THEN kl = 0
137.     IF kh < 0 THEN kh = 0
138.     IF kl > d THEN kl = d
139.     IF kh > d THEN kh = d
140.  
141.     REDIM Results(s, d) AS LONG
142.     REDIM Rolls(d - 1) AS LONG, LowRolls(d - 1) AS LONG
143.     Results(0, 0) = tm
144.     FOR j = 1 TO s
145.         FOR i = 1 TO d
146.             Rolls(i - 1) = INT(RND * n) + 1 + dm
147.             'PRINT Rolls(i - 1),                               'UNREMARK THIS LINE TO SEE UNSORTED NUMBERS
148.         NEXT
149.         'PRINT                                                 'AND THIS LINE TO SEE UNSORTED NUMBERS
150.  
151.         'The dice sorting routine, optimized to use _MEM and a comb sort algorithm.  It's more than fast enough for our needs here I think.  ;)
152.         IF d > 1 THEN 'No need to try and sort just one dice
153.             DIM m AS _MEM
154.             DIM o AS _OFFSET, o1 AS _OFFSET
155.             DIM t AS LONG, t1 AS LONG
156.             m = _MEM(Rolls())
157.             $CHECKING:OFF
158.             gap = UBOUND(Rolls)
159.  
160.             DO
161.                 gap = 10 * gap \ 13
162.                 IF gap < 1 THEN gap = 1
163.                 i = 0
164.                 swapped = 0
165.                 DO
166.                     o = m.OFFSET + i * 4
167.                     o1 = m.OFFSET + (i + gap) * 4
168.                     IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
169.                         _MEMGET m, o1, t1
170.                         _MEMGET m, o, t
171.                         _MEMPUT m, o1, t
172.                         _MEMPUT m, o, t1
173.                         swapped = -1
174.                     END IF
175.                     i = i + 1
176.                 LOOP UNTIL i + gap > UBOUND(Rolls)
177.             LOOP UNTIL swapped = 0 AND gap = 1
178.             $CHECKING:ON
179.             _MEMFREE m
180.         END IF
181.  
182.         'FOR i = 1 TO d: PRINT Rolls(i - 1),: NEXT: PRINT      'UNREMARK THIS LINE TO SEE THE SORTED NUMBERS, BEFORE WE DISCARD LOW OR HIGH
183.  
184.         IF kh THEN 'drop the undesired low rolls
185.             FOR i = 1 TO d - kh: Rolls(i - 1) = 0: NEXT
186.         END IF
187.         IF kl THEN 'drop the undesired high rolls
188.             FOR i = kl + 1 TO d: Rolls(i - 1) = 0: NEXT
189.         END IF
190.         FOR i = 1 TO d
191.             Results(j, i) = Rolls(i - 1)
192.         NEXT
193.     NEXT
194.  
195.  
196.     FOR j = 1 TO s
197.         total = 0
198.         FOR i = 1 TO d
199.             total = total + Results(j, i)
200.         NEXT
201.         total = total + Results(0, 0) 'Results 0,0 holds our total modifier
202.         Results(j, 0) = total 'And store the total in the 0 element of the array
203.     NEXT
204.  
205.  
206.  
207. END SUB
208.  
209.  
210. SUB PrintResults
211.     FOR s = 1 TO UBOUND(results, 1)
212.         FOR i = 1 TO UBOUND(results, 2)
213.             PRINT Results(s, i);
214.             IF i < UBOUND(results, 2) THEN PRINT " + ";
215.         NEXT
216.         PRINT " = "; Results(s, 0)
217.     NEXT
218. END SUB
219.  

So there's a ton of dice rolling routines out there already you say...   You ask, "What makes this one different?"

Well, I'm glad you asked!  (Or that I imagined you'd ask...)

This routine lets us send it a STRING, and it parses that single string and sends us back the results that we wanted.
String format is: #S#D#+#T#

Sounds complicated at first, but it's not.
#S is the numbers of sets of dice we want rolled.
#D# is the number of dice in the set, and the size of the dice.
+# is the modifier for each dice
T# is the total modifier.

So some working examples -- run the program and type these in and see the way it works.
3d4
3d6
3d10
3d4+10
3d4-10
3d4+10T100
3d4-10T-100

Now those will get you single runs of the wanted rolls.   Also give these a fast try
5s3d10
10s2d4+1T10

To break down the last valid command there (10s2d4+1T10), what it's telling the program to do is:
Roll 10 SETS
Of 2
D4 (a four sided dice)
add 1 to each dice roll
and then add 10 to the total

so the numbers we generate will be 1-4+1, or 2-5.   For 2 dice, which gives us a range of 4-10.    And then we add 10, so our range is now 14-20.
And we do this for 10 sets which fall into that end range of 14-20...


Notice this has two main processing routines for us:

QuickDice, which is an easy way to plug into an existing QB64 program and pass simple parameters to it for, and then it generates our formula for processing (for folks who aren't interested in learning the rolling syntax).

RollDice, which takes the proper syntax as illustrated above, and then sends us the results so we can use them in our programs however we see fit. 

Results from the diceroll are returned via a 2 dimensional array called, fitting enough, Results(set, roll)

So if we send it "3S2d6" -- the command to roll 3 sets of 2D6, what we get back is a 2 dimensional array,   Results(3,2), which looks like:
Results(1,1) = 1
Results(1,2) = 3
Results(2,1) = 2
Results(2,2) = 5
Results(3,1) = 3
Results(3,2) = 1

The first 2 results are the first set (1,3), the next are the second set (2,5), and the last is the third set (3,1).

If all we care about is the TOTAL of the rolls, it's pre-added in the second index.
Results(1,0) = 4
Results(2,0) = 7
Results(3,0) = 4

Send it a string formula, get back an array of results...


It's actually a very powerful little routine, which can be used in all sorts of ways.  The main purpose of Steve's Ole Dice Roller (the work in progress) is to add more functionality and a simple UI so people who aren't used to these type dice rolls will have an easier way to interact with the roller.  ;)

[STxAxTIC]

Thanks for the info-download... I've been having a look.

One question that I had fun pursing is the probability of getting certain numbers on a dice roll knowing that certain results are excluded. I may or may not have come up with an alternative derivation of geometric series along the way.

Beginning with the clear question, start with a dice that is inherently six sided, but modify the "2" face so that some other random face is attained in place of 2 during a random toss. (Our definition of a re-roll.) What is the probability of getting a "3" after one trial, or two, or N, or infinite?

Denote A as the avoided face "2", and denote B as *all* other valid numbers 1,3,4,5,6. After one trial, we find:

P(A) = 1/6     and     P(B) = 5/6

Denote the vertical slash ( | ) as the word "given", so we may handle trials with multiple tosses. It follows that the probability of getting two "2"-s in a row is written:

P(A|A) = (1/6)*(1/6)

... and meanwhile the probability of re-rolling to yield valid number after first landing on "2" is:

P(B|A) = (5/6)*(1/6)

Extending this out to N trials, we evidently have:

P(A|...|A) = (1/6)^N

P(B|...|A) = (5/6) * (1/6)^(N-1)

Those are the star results, but before writing a sermon on them, exploit the probabilistic axiom that the probability of all events must sum to 1. First suppose the first toss resulted in a valid number, so we list P(B). Then suppose the first toss landed on 2, which re-rolled to give a valid number, corresponding to P(B|A). Next, suppose that even the re-roll landed on a 2, but the second re-roll was valid, so we must list P(B|A|A) as that event... and so on... After expending this analysis, we write:

P(All valid events) = P(B) + P(B|A) + P(B|A|A) + P(B|A|A|A) + P(B|A|A|A|A) + ...

On the left side, we simply have 1. On the right, the series becomes:

1 = (5/6) + (5/6)*(1/6) + (5/6)*(1/6)^2 + (5/6)*(1/6)^3 + (5/6)*(1/6)^4 + ...

1 = (5/6) * (1 + (1/6) + (1/6)^2 + (1/6)^3 + (1/6)^4 + ...)

... which, for those who know about geometric series, converges to the proper fraction. For those who didn't, we just proved that:

1 + (1/6) + (1/6)^2 + (1/6)^3 + (1/6)^4 + ... = 6/5

... Alright that's enough for a minute. With all this I advance the question: what is the probability of getting two 3's in a row on a dice that refuses 2's IF (i) infinite re-rolls are allowed, or (ii) infinite re-rolls are forbidden?

[SMcNeill]

... Alright that's enough for a minute. With all this I advance the question: what is the probability of getting two 3's in a row on a dice that refuses 2's?

Assuming you have a 6-sided dice, I’d say 1/25 as long as you don’t count the discards...

Roll a D6.  The chance of any number coming up should be an equal 1 in 6 probability...  IF a 2 is rolled, regardless of number of rerolls needed to get rid of it, the numbers that replace it all have the same equal chance of appearing, effectively reducing your probability of any number appearing to become 1 in 5.

With that base 1 in 5, the chance of the same number appearing twice would be (1/5) * (1/5) = (1/25), or 1 in 25...

Now IF you count the discard, you only have a “natural” 1 in 6 chance, so (1/6) * (1/6) = (1/36) chance on a normal dice.

Unless my logic is wrong somehow?

[STxAxTIC]

Ah, that answers my original thing about your method - you are indeed allowing infinite re-rolls when its needed, so the dice is ultimately N-1 sided.

To prove this out in my notation, let C equal any valid number (not all of them like B was), and we write:

P(C) = p(c) + p(C|A) + p(c|A|A) + ...
P(C) = (1/6) + (1/6)^2 + (1/6)^3 + ...
P(C) = (1/6)*(5/6)
P(C) = 1/5

So what just happened? If we have a dice that allows for infinite, on-the-spot re-rolls when it lands on a given face, the rest of the faces have probability 1/5.

This means the answer is (1/5)^2 for infinite re-rolls allowed,
... and the answer is (1/6)^2 for zero re-rolls...

So NOW we may wonder about the in-between cases... oh boy...

EDIT: But of course if you rule out the in-between cases and go only with the infinite re-roll - well, for those following this thread - we just found it isn't actually needed. That's right, no re-roll needed, because you just use an N-1 face dice in that slot.

[Pete]

I hope you two figure this out before QB-Quantum is released. Then this project will have to be renamed Steve's not so Simple Quantum Dice Roller.

My advice would be to establish a standard and base the code on that standard. We love your programs Steve, but no worries about any of us loving this one so much we make an infinite number of rolls when using it. So if you go with the infinity model, you should be OK.

Pete

[SMcNeill]

This means the answer is (1/5)^2 for infinite re-rolls allowed,
... and the answer is (1/6)^2 for zero re-rolls...

So NOW we may wonder about the in-between cases... oh boy...

In between cases would converge on the 1/5 probability with the more dice rolls allowed, with a chance for “Invalid Result” to appear based upon your limit.

Roll twice:
1 in 6 chance the first roll is invalid (2).
1 in 6 chance the second roll is invalid (2).   <— 1 in 36 chance we don’t even get a valid result...

To get a 3, with only one reroll, the chance is:
1/6 natural + (1/6 for a 2) * (1/6 for a 3 on the reroll)

The more rerolls, the more the + (1/6 for a 2) * (1/6 for a 3 on the reroll) factors, leading towards the convergence of 1/25 of infinite rerolls.

[STxAxTIC]

All sounds good. So will there be an option in the program to set the number of re-rolls, or will this be infinite?

[SMcNeill]

All sounds good. So will there be an option in the program to set the number of re-rolls, or will this be infinite?

I can add another option to set one easily enough, if somebody needs such a thing, but unless it’s requested, I’ll just go with infinite rerolls.  I can’t see much point in rolling a dice for gameplay and saying, “It’s nothing — invalid result.”  ;)

[STxAxTIC]

Excellent - so if it's going to be stuck to the infinite re-roll case, which is indistinguishable from an N-1 dice, why still include it? Could save you dozens or hundreds of lines to realize this early.

[SMcNeill]

Because most people don’t want to have to custom set dice faces....

Roll 2D6, reroll 2’s... 

You have equal chances of rolling (1, 3, 4, 5, 6), but PRINT INT(RND * 5) + 1 would only give you values of (1,2,3,4,5)...  You’d have to set custom faces to the 5-sided die to see those results, which most folks find much easier to just roll a D6 and then reroll the 2s.  ;)

[STxAxTIC]

Okay, so it's a tradeoff, right?

(i) You either re-map the calculated result to the public-facing values... i.e. re-map all 2's to something else... which happens in one pass... Which is of course done internally so the user is none-the-wiser...

or your method,

(ii) Re-roll on the fly until the a desirable answer comes up. This is problematic for a six-sided dice, but consider something with fewer sides, like 3. This means you will spend about a third of total loop time discarding bad answers. These examples are trivial but are enough so show it doesn't scale. Just saying, remapping is where its at.

[SMcNeill]

Only problem with re-mapping is it’s a lot more work than rerolling.

Say you want to roll a 100-sided dice and reroll all unlucky 13s...

A simple loop of the following fixes the reroll issue:

DO
    result = INT(RND * 100) + 1
LOOP UNTIL result <> 13


To remap, you’d need:
DIM sides (1 TO 99)
FOR I = 1 TO 99
   count = count + 1
   IF count <> 13 then sides(I) = count
NEXT

result = sides(INT(RND * 99) + 1)

************

Just seems simpler to me to do a reroll, and loop time should be inconsequential. Even if we go crazy and reroll all 1’s on a 2-sided dice, the chances are we’ll get a 2 is almost guaranteed after a dozen rolls or so, and I can’t think of any PC that can’t do those calculations in a few nanoseconds for us.  ;)

[STxAxTIC]

Meh, if we're going to argue by knocking over straw men, at least use a similarly-trivial example of remapping:

DO
    result = INT(RND * 99) + 1
    IF result = 13 THEN result = 100
    PRINT result
LOOP

The idea is: to skip 13 on a 100 sided dice, roll a 99 sided dice instead, and boot all instances of 13 to the 100 case. This extends to far more complicated cases with zero wasted loop time.