DiceFSharp (Dice)¶
In [ ]:
#!import ../../../polyglot/lib/fsharp/Notebooks.dib
#!import ../../../polyglot/lib/fsharp/Testing.dib
In [ ]:
#!import ../../../polyglot/lib/fsharp/Common.fs
In [ ]:
#if !INTERACTIVE
open Polyglot
open Lib
#endif
open Common
sixthPowerSequence¶
In [ ]:
let sixthPowerSequence () =
1 |> Seq.unfold (fun state -> Some (state, state * 6)) |> Seq.cache
In [ ]:
//// test
sixthPowerSequence ()
|> Seq.take 8
|> Seq.toList
|> _assertEqual [ 1; 6; 36; 216; 1296; 7776; 46656; 279936 ]
[1; 6; 36; 216; 1296; 7776; 46656; 279936]
accumulateDiceRolls¶
In [ ]:
let rec accumulateDiceRolls log rolls power acc =
match rolls with
| _ when power < 0 ->
log |> Option.iter ((|>) $"accumulateDiceRolls / power: {power} / acc: {acc}")
Some (acc + 1, rolls)
| [] -> None
| roll :: rest when roll > 1 ->
let coeff = sixthPowerSequence () |> Seq.item power
let value = (roll - 1) * coeff
log |> Option.iter ((|>) $"accumulateDiceRolls / \
power: {power} / acc: {acc} / roll: {roll} / value: {value}"
)
accumulateDiceRolls log rest (power - 1) (acc + value)
| roll :: rest ->
log |> Option.iter ((|>) $"accumulateDiceRolls / power: {power} / acc: {acc} / roll: {roll}")
accumulateDiceRolls log rest (power - 1) acc
In [ ]:
//// test
accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 0 1000
|> _assertEqual (Some (1006, [ 5; 4; 3; 2 ]))
accumulateDiceRolls / power: 0 / acc: 1000 / roll: 6 / value: 5 accumulateDiceRolls / power: -1 / acc: 1005 Some (1006, [5; 4; 3; 2])
In [ ]:
//// test
accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 1 1000
|> _assertEqual (Some (1035, [ 4; 3; 2 ]))
accumulateDiceRolls / power: 1 / acc: 1000 / roll: 6 / value: 30 accumulateDiceRolls / power: 0 / acc: 1030 / roll: 5 / value: 4 accumulateDiceRolls / power: -1 / acc: 1034 Some (1035, [4; 3; 2])
In [ ]:
//// test
accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 2 1000
|> _assertEqual (Some (1208, [ 3; 2 ]))
accumulateDiceRolls / power: 2 / acc: 1000 / roll: 6 / value: 180 accumulateDiceRolls / power: 1 / acc: 1180 / roll: 5 / value: 24 accumulateDiceRolls / power: 0 / acc: 1204 / roll: 4 / value: 3 accumulateDiceRolls / power: -1 / acc: 1207 Some (1208, [3; 2])
rollWithinBounds¶
In [ ]:
let rollWithinBounds log max rolls =
let power = List.length rolls - 1
match accumulateDiceRolls log rolls power 0 with
| Some (result, _) when result >= 1 && result <= max -> Some result
| _ -> None
In [ ]:
//// test
rollWithinBounds (Some (printfn "%s")) 2000 [ 1; 5; 4; 4; 5 ]
|> _assertEqual (Some 995)
accumulateDiceRolls / power: 4 / acc: 0 / roll: 1 accumulateDiceRolls / power: 3 / acc: 0 / roll: 5 / value: 864 accumulateDiceRolls / power: 2 / acc: 864 / roll: 4 / value: 108 accumulateDiceRolls / power: 1 / acc: 972 / roll: 4 / value: 18 accumulateDiceRolls / power: 0 / acc: 990 / roll: 5 / value: 4 accumulateDiceRolls / power: -1 / acc: 994 Some 995
In [ ]:
//// test
rollWithinBounds (Some (printfn "%s")) 2000 [ 2; 2; 6; 4; 5 ]
|> _assertEqual (Some 1715)
accumulateDiceRolls / power: 4 / acc: 0 / roll: 2 / value: 1296 accumulateDiceRolls / power: 3 / acc: 1296 / roll: 2 / value: 216 accumulateDiceRolls / power: 2 / acc: 1512 / roll: 6 / value: 180 accumulateDiceRolls / power: 1 / acc: 1692 / roll: 4 / value: 18 accumulateDiceRolls / power: 0 / acc: 1710 / roll: 5 / value: 4 accumulateDiceRolls / power: -1 / acc: 1714 Some 1715
In [ ]:
//// test
rollWithinBounds (Some (printfn "%s")) 2000 [ 4; 1; 1; 2; 3 ]
|> _assertEqual None
accumulateDiceRolls / power: 4 / acc: 0 / roll: 4 / value: 3888 accumulateDiceRolls / power: 3 / acc: 3888 / roll: 1 accumulateDiceRolls / power: 2 / acc: 3888 / roll: 1 accumulateDiceRolls / power: 1 / acc: 3888 / roll: 2 / value: 6 accumulateDiceRolls / power: 0 / acc: 3894 / roll: 3 / value: 2 accumulateDiceRolls / power: -1 / acc: 3896 <null>
calculateDiceCount¶
In [ ]:
let inline calculateDiceCount log max =
let rec loop n p =
if p < max
then loop (n + 1) (p * 6)
else
log |> Option.iter ((|>) $"calculateDiceCount / max: {max} / n: {n} / p: {p}")
n
if max = 1
then 1
else loop 0 1
In [ ]:
//// test
calculateDiceCount (Some (printfn "%s")) 36
|> _assertEqual 2
calculateDiceCount / max: 36 / n: 2 / p: 36 2
In [ ]:
//// test
calculateDiceCount (Some (printfn "%s")) 7777
|> _assertEqual 6
calculateDiceCount / max: 7777 / n: 6 / p: 46656 6
rollDice¶
In [ ]:
#if FABLE_COMPILER_RUST
let rollDice () : int =
#if !WASM && !CONTRACT
Fable.Core.RustInterop.emitRustExpr () "rand::Rng::gen_range(&mut rand::thread_rng(), 1..7)"
#else
1
#endif
#else
let private random = System.Random ()
let rollDice () =
random.Next (1, 7)
#endif
rotateNumber¶
In [ ]:
let rotateNumber max n =
(n - 1 + max) % max + 1
rotateNumbers¶
In [ ]:
let rotateNumbers max items =
items |> Seq.map (rotateNumber max)
In [ ]:
//// test
[ -1 .. 14 ]
|> rotateNumbers 6
|> Seq.toList
|> _assertEqual [ 5; 6; 1; 2; 3; 4; 5; 6; 1; 2; 3; 4; 5; 6; 1; 2 ]
[5; 6; 1; 2; 3; 4; 5; 6; 1; 2; 3; 4; 5; 6; 1; 2]
createSequentialRoller¶
In [ ]:
let createSequentialRoller list =
let mutable currentIndex = 0
fun () ->
match list |> List.tryItem currentIndex with
| Some item ->
currentIndex <- currentIndex + 1
item
| None ->
failwith "createSequentialRoller / End of list"
rollProgressively¶
In [ ]:
let rollProgressively log roll reroll max =
let power = (calculateDiceCount log max) - 1
let rec loop rolls size =
if size < power + 1
then loop (roll () :: rolls) (size + 1)
else
match accumulateDiceRolls log rolls power 0 with
| Some (result, _) when result <= max -> result
| _ when reroll -> loop (List.init power (fun _ -> roll ())) power
| _ -> loop (roll () :: rolls) (size + 1)
loop [] 0
In [ ]:
//// test
rollProgressively None rollDice false 1
|> _assertEqual 1
1
In [ ]:
//// test
let sequentialRoll = createSequentialRoller [ 5; 4; 4; 5; 1 ]
rollProgressively (Some (printfn "%s")) sequentialRoll false 2000
|> _assertEqual 995
calculateDiceCount / max: 2000 / n: 5 / p: 7776 accumulateDiceRolls / power: 4 / acc: 0 / roll: 1 accumulateDiceRolls / power: 3 / acc: 0 / roll: 5 / value: 864 accumulateDiceRolls / power: 2 / acc: 864 / roll: 4 / value: 108 accumulateDiceRolls / power: 1 / acc: 972 / roll: 4 / value: 18 accumulateDiceRolls / power: 0 / acc: 990 / roll: 5 / value: 4 accumulateDiceRolls / power: -1 / acc: 994 995
In [ ]:
//// test
let sequentialRoll = createSequentialRoller [ 5; 4; 4; 5; 2 ]
fun () -> rollProgressively (Some (printfn "%s")) sequentialRoll false 2000 |> ignore
|> _throwsC (fun ex _ ->
SpiralSm.format_exception ex
|> _assertEqual "System.Exception: createSequentialRoller / End of list"
)
<fun:it@5-13> calculateDiceCount / max: 2000 / n: 5 / p: 7776 accumulateDiceRolls / power: 4 / acc: 0 / roll: 2 / value: 1296 accumulateDiceRolls / power: 3 / acc: 1296 / roll: 5 / value: 864 accumulateDiceRolls / power: 2 / acc: 2160 / roll: 4 / value: 108 accumulateDiceRolls / power: 1 / acc: 2268 / roll: 4 / value: 18 accumulateDiceRolls / power: 0 / acc: 2286 / roll: 5 / value: 4 accumulateDiceRolls / power: -1 / acc: 2290 "System.Exception: createSequentialRoller / End of list"
In [ ]:
//// test
[| 1 .. 100 |]
|> Array.Parallel.iter (fun n ->
[| 0 .. 1 |]
|> Array.Parallel.iter (fun reroll ->
[| 1 .. 3500 |]
|> Array.Parallel.map (fun _ -> rollProgressively None rollDice (reroll = 1) n)
|> Array.Parallel.groupBy id
|> Array.length
|> __assertEqual false n
)
)
FsCheck (test)¶
In [ ]:
#r @"../../../../../../../.nuget/packages/fscheck/3.0.0-rc3/lib/netstandard2.0/FsCheck.dll"
#r @"../../../../../../../.nuget/packages/expecto.fscheck/10.2.1-fscheck3/lib/net6.0/Expecto.FsCheck3.dll"
In [ ]:
//// test
type ValorDado =
| Um
| Dois
| Tres
| Quatro
| Cinco
| Seis
type Aspecto =
| Passado of string
| Presente of string
| Futuro of string
| Desafios of string
| Recursos of string
| ResultadoProjetado of string
| InfluenciaExterna of string
type Contexto =
| Amor of string
| Trabalho of string
| Saude of string
| Dinheiro of string
type Universo =
| Real of string
| Virtual of string
| Espiritual of string
type Caracteristica =
| Aspecto of Aspecto
| Contexto of Contexto
| Universo of Universo
| DadoRolado of ValorDado
type Interacao =
| Conflito
| Parceria
| Crescimento
| Estagnacao
| Separacao
| Harmonia
| Desafio
| Colaboracao
| Progresso
| Mudanca
| Sucesso
type Interpretacao =
| Interpretacao of Caracteristica * Interacao * Caracteristica
type SistemaDivinacao =
| SistemaDivinacao of Interpretacao list * Caracteristica
let config = { Expecto.FsCheckConfig.defaultConfig with maxTest = 10000 }
let shuffleList xs seed =
let rnd = Random (seed)
xs
|> List.map (fun x -> rnd.Next(), x)
|> List.sortBy fst
|> List.map snd
type Complexity = Simple | Moderate | Complex
type Duration = Short | Medium | Long
type Dice = D1 of int | D2 of int
type Task =
| Task of Complexity * Duration * Task
| NoTask
let durationOfFocus (d1: int) (d2: int) =
match d1 + d2 with
| sum when sum <= 4 -> Short
| sum when sum <= 8 -> Medium
| _ -> Long
let complexityOfTask (d1: int) (d2: int) =
match d1 * d2 with
| product when product <= 12 -> Simple
| product when product <= 24 -> Moderate
| _ -> Complex
let rec generateTaskList d1 d2 previousTask =
match d1, d2 with
| d1, d2 when d1 > 0 && d2 > 0 ->
let complexity = complexityOfTask d1 d2
let duration = durationOfFocus d1 d2
let newTask = Task (complexity, duration, previousTask)
generateTaskList (d1 - 1) (d2 - 1) newTask
| _, _ -> previousTask
let properties =
Expecto.Tests.testList "FsCheck samples" [
let sistemaDivinacao (interpretacoes: Interpretacao list, caracteristica: Caracteristica) =
let interpretacoes = interpretacoes |> List.sort
SistemaDivinacao (interpretacoes, caracteristica)
Expecto.ExpectoFsCheck.testPropertyWithConfig config "SistemaDivinacao is consistent" <|
fun (interpretacoes: Interpretacao list, caracteristica: Caracteristica) ->
sistemaDivinacao (interpretacoes, caracteristica)
= sistemaDivinacao (interpretacoes, caracteristica)
Expecto.ExpectoFsCheck.testPropertyWithConfig config "SistemaDivinacao is variant under permutation" <|
fun (input: Interpretacao list, caracteristica: Caracteristica) ->
let seed = 42
let shuffledInput = shuffleList input seed
sistemaDivinacao (input, caracteristica) = sistemaDivinacao (shuffledInput, caracteristica)
Expecto.ExpectoFsCheck.testPropertyWithConfig config "SistemaDivinacao can handle lists of any size" <|
fun (input: Interpretacao list, caracteristica: Caracteristica) ->
let sistema = sistemaDivinacao (input, caracteristica)
sistema <> Unchecked.defaultof<_>
Expecto.ExpectoFsCheck.testPropertyWithConfig config "SistemaDivinacao is invariant under data transformations" <|
fun (input: Interpretacao list, caracteristica: Caracteristica, newInterpretation: Interpretacao) ->
let containsNewInterpretation = input |> List.contains newInterpretation
let modifiedInput =
if containsNewInterpretation
then input
else newInterpretation :: input
if containsNewInterpretation
then sistemaDivinacao (List.sort input, caracteristica)
= sistemaDivinacao (List.sort modifiedInput, caracteristica)
else sistemaDivinacao (List.sort input, caracteristica)
<> sistemaDivinacao (List.sort modifiedInput, caracteristica)
let focusDurationProperty =
FsCheck.FSharp.Prop.forAll (FsCheck.FSharp.Arb.fromGen (FsCheck.FSharp.Gen.map2 (fun d1 d2 -> (d1, d2)) (FsCheck.FSharp.Gen.choose (1, 6)) (FsCheck.FSharp.Gen.choose (1, 6)))) <| fun (d1, d2) ->
let expected =
match d1 + d2 with
| sum when sum <= 4 -> Short
| sum when sum <= 8 -> Medium
| _ -> Long
let actual = durationOfFocus d1 d2
expected = actual
let taskComplexityProperty =
FsCheck.FSharp.Prop.forAll (FsCheck.FSharp.Arb.fromGen (FsCheck.FSharp.Gen.map2 (fun d1 d2 -> (d1, d2)) (FsCheck.FSharp.Gen.choose (1, 6)) (FsCheck.FSharp.Gen.choose (1, 6)))) <| fun (d1, d2) ->
let expected =
match d1 * d2 with
| product when product <= 12 -> Simple
| product when product <= 24 -> Moderate
| _ -> Complex
let actual = complexityOfTask d1 d2
expected = actual
let taskListLengthProperty =
FsCheck.FSharp.Prop.forAll (FsCheck.FSharp.Arb.fromGen (FsCheck.FSharp.Gen.map2 (fun d1 d2 -> (d1, d2)) (FsCheck.FSharp.Gen.choose (1, 6)) (FsCheck.FSharp.Gen.choose (1, 6)))) <| fun (d1, d2) ->
let taskList = generateTaskList d1 d2 NoTask
let rec taskListLength taskList =
match taskList with
| Task (_, _, nextTask) -> 1 + taskListLength nextTask
| NoTask -> 0
let actual = taskListLength taskList
let expected = min d1 d2
expected = actual
Expecto.ExpectoFsCheck.testProperty "Duration of focus should be calculated correctly" focusDurationProperty
Expecto.ExpectoFsCheck.testProperty "Task complexity should be calculated correctly" taskComplexityProperty
Expecto.ExpectoFsCheck.testProperty "Task list should have the correct length" taskListLengthProperty
]
let dice1 = 6
let dice2 = 6
let taskList = generateTaskList dice1 dice2 NoTask
let rec printTaskList taskList =
match taskList with
| Task (complexity, duration, nextTask) ->
printfn "Complexidade: %A, Duração: %A" complexity duration
printTaskList nextTask
| NoTask -> ()
printTaskList taskList
Expecto.Tests.runTestsWithCLIArgs [] [||] properties
|> _assertEqual 0
Complexidade: Simple, Duração: Short Complexidade: Simple, Duração: Short Complexidade: Simple, Duração: Medium Complexidade: Moderate, Duração: Medium Complexidade: Complex, Duração: Long Complexidade: Complex, Duração: Long [23:58:04 INF] EXPECTO? Running tests... <Expecto> [23:58:08 INF] EXPECTO! 7 tests run in 00:00:04.3520369 for FsCheck samples – 7 passed, 0 ignored, 0 failed, 0 errored. Success! <Expecto> 0
main¶
In [ ]:
let main args =
let result = rollProgressively (Some (printfn "%s")) rollDice true (System.Int32.MaxValue / 10)
trace Debug (fun () -> $"main / result: {result}") _locals
0