DiceFSharp (Dice)

#!import ../../../polyglot/lib/fsharp/Notebooks

///- --test

// The test helpers this notebook uses, from polyglot's Testing.livemd, which references Expecto by a path relative to an
// old notebook runner's install directory (unresolvable on the Kino route); here Expecto comes from NuGet.
#r "nuget: Expecto, 11.0.0-alpha8"

type AssertExceptionFormatter (ex) =
    member _.Text =
        ex.ToString()
            .Replace("\u001b[32m", "<span style=\"color: green;\">")
            .Replace("\u001b[39m", "</span>")
            .Replace("\u001b[31m", "<span style=\"color: red;\">")
            .Replace("\n", "<br/>\n")

Formatter.Register<AssertExceptionFormatter> ((fun (x : AssertExceptionFormatter) -> x.Text), "text/html")

let inline __expect fn log expected actual =
    if log then printfn $"{actual.ToDisplayString ()}"
    try
        "Testing.__expect" |> fn actual expected
    with :? Expecto.AssertException as ex ->
        AssertExceptionFormatter(ex).Display () |> ignore
        failwith (ex.GetType().FullName)

let inline __assertEqual log expected actual = __expect Expecto.Expect.equal log expected actual
let inline _assertEqual expected actual = __assertEqual true expected actual

let inline __throwsC log expected actual = __expect Expecto.Expect.throwsC log expected actual
let inline _throwsC expected actual = __throwsC true expected actual

#!import ../../../polyglot/lib/fsharp/Common.fs

#if !INTERACTIVE
open Polyglot
open Lib
#endif

open Common

sixthPowerSequence

let sixthPowerSequence () =
    1 |> Seq.unfold (fun state -> Some (state, state * 6)) |> Seq.cache

///- --test

sixthPowerSequence ()
|> Seq.take 8
|> Seq.toList
|> _assertEqual [ 1; 6; 36; 216; 1296; 7776; 46656; 279936 ]

accumulateDiceRolls

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

///- --test

accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 0 1000
|> _assertEqual (Some (1006, [ 5; 4; 3; 2 ]))

///- --test

accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 1 1000
|> _assertEqual (Some (1035, [ 4; 3; 2 ]))

///- --test

accumulateDiceRolls (Some (printfn "%s")) [ 6; 5; 4; 3; 2 ] 2 1000
|> _assertEqual (Some (1208, [ 3; 2 ]))

rollWithinBounds

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

///- --test

rollWithinBounds (Some (printfn "%s")) 2000 [ 1; 5; 4; 4; 5 ]
|> _assertEqual (Some 995)

///- --test

rollWithinBounds (Some (printfn "%s")) 2000 [ 2; 2; 6; 4; 5 ]
|> _assertEqual (Some 1715)

///- --test

rollWithinBounds (Some (printfn "%s")) 2000 [ 4; 1; 1; 2; 3 ]
|> _assertEqual None

calculateDiceCount

let inline calculateDiceCount log max =
    let rec 루프 n p =
        if p < max
        then 루프 (n + 1) (p * 6)
        else
            log |> Option.iter ((|>) $"calculateDiceCount / max: {max} / n: {n} / p: {p}")
            n
    if max = 1
    then 1
    else 루프 0 1

///- --test

calculateDiceCount (Some (printfn "%s")) 36
|> _assertEqual 2

///- --test

calculateDiceCount (Some (printfn "%s")) 7777
|> _assertEqual 6

rollDice

let private random = System.Random ()
let rollDice () =
    random.Next (1, 7)

rotateNumber

let rotateNumber max n =
    (n - 1 + max) % max + 1

rotateNumbers

let rotateNumbers max items =
    items |> Seq.map (rotateNumber max)

///- --test

[ -1 .. 14 ]
|> rotateNumbers 6
|> Seq.toList
|> _assertEqual [ 5; 6; 1; 2; 3; 4; 5; 6; 1; 2; 3; 4; 5; 6; 1; 2 ]

createSequentialRoller

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

let rollProgressively log roll reroll max =
    let power = (calculateDiceCount log max) - 1
    let rec 루프 rolls size =
        if size < power + 1
        then 루프 (roll () :: rolls) (size + 1)
        else
            match accumulateDiceRolls log rolls power 0 with
            | Some (result, _) when result <= max -> result
            | _ when reroll -> 루프 (List.init power (fun _ -> roll ())) power
            | _ -> 루프 (roll () :: rolls) (size + 1)
    루프 [] 0

///- --test

rollProgressively None rollDice false 1
|> _assertEqual 1

///- --test

let sequentialRoll = createSequentialRoller [ 5; 4; 4; 5; 1 ]

rollProgressively (Some (printfn "%s")) sequentialRoll false 2000
|> _assertEqual 995

///- --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"
)

///- --ignore

rollProgressively (Some (printfn "%s")) rollDice false 2000

///- --ignore

rollProgressively (Some (printfn "%s")) rollDice true 2000

///- --ignore

[| 1 .. 10000 |]
|> Array.Parallel.map (fun _ -> rollProgressively None rollDice false 10)
|> Array.Parallel.groupBy id
|> Array.Parallel.map (fun (k, v) -> k, v.Length)
|> Array.Parallel.sortBy fst

///- --ignore

[| 1 .. 10000 |]
|> Array.Parallel.map (fun _ -> rollProgressively None rollDice true 10)
|> Array.Parallel.groupBy id
|> Array.Parallel.map (fun (k, v) -> k, v.Length)
|> Array.Parallel.sortBy fst

///- --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
    )
)

///- --ignore

let inline rollMax fn max n =
    [| 1 .. n |]
    |> Array.Parallel.map (fun _ -> fn max)
    |> Array.Parallel.groupBy id
    |> Array.Parallel.map (fun (_, v) -> v.Length)

let rec rollN max n even current =
    let roll = rollMax (rollProgressively None rollDice true) max n
    if roll |> Array.Parallel.forall ((=) even)
    then current
    else rollN max n even (current + 1)

let run () =
    let max = 10
    let n = 30
    let even = (n / max) |> int

    rollN max n even 0

// run ()

///- --ignore

let run () =
    let max = 10
    let n = 30
    let even = (n / max) |> int
    [| 1 .. 100 |]
    |> Array.Parallel.map (fun i ->
        let roll = rollN max n even 0
        printfn $"i: {i} / roll: {roll}"
        float roll
    )
    |> Array.Parallel.average

// run ()

FsCheck (test)

#r "nuget: FsCheck, 3.1.0"
#r "nuget: Expecto.FsCheck, 11.0.0-alpha8"

///- --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

main

let main args =
    let result = rollProgressively (Some (printfn "%s")) rollDice true (System.Int32.MaxValue / 10)
    trace Debug (fun () -> $"main / result: {result}") _locals
    0