How to resolve the algorithm Dice game probabilities step by step in the Forth programming language

Published on 12 May 2024 09:40 PM
#Forth

How to resolve the algorithm Dice game probabilities step by step in the Forth programming language

Table of Contents

Problem Statement

Two players have a set of dice each. The first player has nine dice with four faces each, with numbers one to four. The second player has six normal dice with six faces each, each face has the usual numbers from one to six. They roll their dice and sum the totals of the faces. The player with the highest total wins (it's a draw if the totals are the same). What's the probability of the first player beating the second player? Later the two players use a different set of dice each. Now the first player has five dice with ten faces each, and the second player has six dice with seven faces each. Now what's the probability of the first player beating the second player? This task was adapted from the Project Euler Problem n.205: https://projecteuler.net/problem=205

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Dice game probabilities step by step in the Forth programming language

Source code in the forth programming language

#! /usr/bin/gforth

\ Dice game probabilities

: min? ( addr -- min )
    @
;

: max? ( addr -- max )
    cell + @
;

: max+1-min? ( addr -- max+1 min )
    dup max? 1+ swap min?
;

: addr? ( addr x -- addr' )
    over min? - 2 + cells +
;

: weight? ( addr x -- w )
    2dup swap min? < IF
        2drop 0
    ELSE
        2dup swap max? > IF
            2drop 0
        ELSE
            addr? @
        THEN
    THEN
;

: total-weight?   ( addr -- w )
    dup max? 1+   ( addr max+1 )
    over min?     ( addr max+1 min )
    0 -rot ?DO ( adrr 0 max+1 min )
        over i weight? +
    LOOP
    nip
;

: uniform-aux ( min max x -- addr )
    >r 2dup
    2dup swap - 3 + cells allocate throw ( min max min max addr )
    tuck cell + !                        ( min max min addr )
    tuck !                               ( min max addr )
    -rot swap                            ( addr max min )
    r> -rot                              ( addr x max min )
    - 3 + 2 ?DO                          ( addr x )
        2dup swap i cells + !
    LOOP
    drop
;

: convolve { addr1 addr2 -- addr }
    addr1 min? addr2 min? +
    addr1 max? addr2 max? +
    0 uniform-aux                    { addr }
    addr1 max+1-min? ?DO
        addr2 max+1-min? ?DO
            addr1 j weight?
            addr2 i weight? *
            addr i j + addr? +!
        LOOP
    LOOP
    addr
;

: even? ( n -- f )
    2 mod 0=
;

: power ( addr exp -- addr' )
    dup 1 = IF
        drop
    ELSE
        dup even? IF
            2/ recurse dup convolve
        ELSE
            over swap 2/ recurse dup convolve convolve
        THEN
    THEN
;

: .dist { addr -- }
    addr total-weight? { tw }
    addr max+1-min? ?DO
        i 10 .r
        addr i weight? dup 20 .r
        0 d>f tw 0 d>f f/ ."  " f. cr
    LOOP
;

: dist-cmp { addr1 addr2 xt -- p }
    0
    addr1 max+1-min? ?DO
        addr2 max+1-min? ?DO
            j i xt execute IF
                addr1 j weight?
                addr2 i weight?
                * +
            THEN
        LOOP
    LOOP
    0 d>f
    addr1 total-weight? addr2 total-weight? um* d>f
    f/
;

: dist> ( addr1 addr2 -- p )
    ['] > dist-cmp
;

\ creates the uniform distribution with outcomes from min to max
: uniform ( min max -- addr )
    1 uniform-aux
;

\ example

1 4 uniform 9 power
1 6 uniform 6 power
dist> f. cr

1 10 uniform 5 power
1  7 uniform 6 power
dist> f. cr

bye

You may also check:How to resolve the algorithm Higher-order functions step by step in the Delphi programming language
You may also check:How to resolve the algorithm Multisplit step by step in the Run BASIC programming language
You may also check:How to resolve the algorithm Fibonacci sequence step by step in the Falcon programming language
You may also check:How to resolve the algorithm N-queens problem step by step in the Maxima programming language
You may also check:How to resolve the algorithm Metaprogramming step by step in the Arturo programming language