diff --git a/purescript/README.md b/purescript/README.md
index b8278f7..b11e339 100644
--- a/purescript/README.md
+++ b/purescript/README.md
@@ -21,5 +21,6 @@
| [purpleflow](./purpleflow) | Unfinished dependently-typed programming language |
| [slice](./slice) | Basic benchmarks and a `Slice` type |
| [sprint](./sprint) | Failled effect-system based on typelevel lists |
+| [strategy](./strategy) | Unfinished attempt at implementing a mixed strategy nash equilibrium solver |
| [streams](./streams) | Playing with `purescript-pipes` |
| [typelevel](./typelevel) | Typelevel naturals, vectors, sum-types, orderings and lambda-calculus evaluation and a value-level bounded-type GADT |
diff --git a/purescript/strategy/.gitignore b/purescript/strategy/.gitignore
new file mode 100644
index 0000000..30efe19
--- /dev/null
+++ b/purescript/strategy/.gitignore
@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago
diff --git a/purescript/strategy/packages.dhall b/purescript/strategy/packages.dhall
new file mode 100644
index 0000000..aaab175
--- /dev/null
+++ b/purescript/strategy/packages.dhall
@@ -0,0 +1,105 @@
+{-
+Welcome to your new Dhall package-set!
+
+Below are instructions for how to edit this file for most use
+cases, so that you don't need to know Dhall to use it.
+
+## Use Cases
+
+Most will want to do one or both of these options:
+1. Override/Patch a package's dependency
+2. Add a package not already in the default package set
+
+This file will continue to work whether you use one or both options.
+Instructions for each option are explained below.
+
+### Overriding/Patching a package
+
+Purpose:
+- Change a package's dependency to a newer/older release than the
+ default package set's release
+- Use your own modified version of some dependency that may
+ include new API, changed API, removed API by
+ using your custom git repo of the library rather than
+ the package set's repo
+
+Syntax:
+where `entityName` is one of the following:
+- dependencies
+- repo
+- version
+-------------------------------
+let upstream = --
+in upstream
+ with packageName.entityName = "new value"
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in upstream
+ with halogen.version = "master"
+ with halogen.repo = "https://example.com/path/to/git/repo.git"
+
+ with halogen-vdom.version = "v4.0.0"
+ with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies
+-------------------------------
+
+### Additions
+
+Purpose:
+- Add packages that aren't already included in the default package set
+
+Syntax:
+where `<version>` is:
+- a tag (i.e. "v4.0.0")
+- a branch (i.e. "master")
+- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
+-------------------------------
+let upstream = --
+in upstream
+ with new-package-name =
+ { dependencies =
+ [ "dependency1"
+ , "dependency2"
+ ]
+ , repo =
+ "https://example.com/path/to/git/repo.git"
+ , version =
+ "<version>"
+ }
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in upstream
+ with benchotron =
+ { dependencies =
+ [ "arrays"
+ , "exists"
+ , "profunctor"
+ , "strings"
+ , "quickcheck"
+ , "lcg"
+ , "transformers"
+ , "foldable-traversable"
+ , "exceptions"
+ , "node-fs"
+ , "node-buffer"
+ , "node-readline"
+ , "datetime"
+ , "now"
+ ]
+ , repo =
+ "https://github.com/hdgarrood/purescript-benchotron.git"
+ , version =
+ "v7.0.0"
+ }
+-------------------------------
+-}
+let upstream =
+ https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220921/packages.dhall
+ sha256:169bd823a71ae033eaf4f77776e184f12c656163feae14e7f649a48932ca6ac0
+
+in upstream
diff --git a/purescript/strategy/spago.dhall b/purescript/strategy/spago.dhall
new file mode 100644
index 0000000..7d41bcb
--- /dev/null
+++ b/purescript/strategy/spago.dhall
@@ -0,0 +1,30 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+
+Need help? See the following resources:
+- Spago documentation: https://github.com/purescript/spago
+- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html
+
+When creating a new Spago project, you can use
+`spago init --no-comments` or `spago init -C`
+to generate this file without the comments in this block.
+-}
+{ name = "my-project"
+, dependencies =
+ [ "arrays"
+ , "console"
+ , "dodo-printer"
+ , "effect"
+ , "either"
+ , "fast-vect"
+ , "foldable-traversable"
+ , "maybe"
+ , "prelude"
+ , "random"
+ , "safe-coerce"
+ , "tuples"
+ ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}
diff --git a/purescript/strategy/src/Data/Game.purs b/purescript/strategy/src/Data/Game.purs
new file mode 100644
index 0000000..c5d812d
--- /dev/null
+++ b/purescript/strategy/src/Data/Game.purs
@@ -0,0 +1,203 @@
+module EG.Data.Game where
+
+import Prelude
+
+import Data.Number as Number
+import Data.Array as Array
+import Data.Foldable (maximum, maximumBy, sum)
+import Data.Function (on)
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Number (infinity)
+import Data.Profunctor.Strong (second, (&&&))
+import Data.Tuple (fst, snd)
+import Data.Tuple.Nested (type (/\), (/\))
+import Dodo (Doc)
+import Dodo as DD
+import EG.Data.Payoff (Payoff(..))
+import EG.Data.Tuple (TupleIndex)
+import EG.Data.Tuple as ETuple
+import Effect (Effect)
+import Effect.Random (randomInt)
+import Safe.Coerce (coerce)
+
+type Player = TupleIndex
+
+newtype Game state choice = Game
+ { state :: state
+ , choices :: Array (choice /\ (Game state choice))
+ }
+
+newtype GameReplay state choice = GameReplay
+ { state :: state
+ , next :: Maybe (choice /\ GameReplay state choice)
+ }
+
+newtype SolvedState state choice = SolvedState
+ { state :: state
+ , choice :: Maybe (choice /\ Game (SolvedState state choice) choice)
+ , payoffs :: Maybe (Payoff /\ Payoff)
+ }
+
+type PayoffFunction s = Int -> s -> Maybe (Payoff /\ Payoff)
+
+---------- Helpers
+solvedStatePayoffs :: forall s c. SolvedState s c -> Maybe (Payoff /\ Payoff)
+solvedStatePayoffs (SolvedState { payoffs }) = payoffs
+
+gameNodeCount :: forall s c. Game s c -> Int
+gameNodeCount (Game { choices }) = 1 + sum (map (gameNodeCount <<< snd) choices)
+
+gameLeafCount :: forall s c. Game s c -> Int
+gameLeafCount (Game { choices: [] }) = 1
+gameLeafCount (Game { choices }) = sum (map (gameLeafCount <<< snd) choices)
+
+gameDepth :: forall s c. Game s c -> Int
+gameDepth (Game { choices }) = maybe 0 ((+) 1)
+ $ maximum
+ $ map (snd >>> gameDepth) choices
+
+randomGame :: forall s c. Game s c -> Effect (GameReplay s c)
+randomGame (Game { choices, state }) = do
+ index <- randomInt 0 (Array.length choices - 1)
+ next <- case Array.index choices index of
+ Nothing -> pure Nothing
+ Just (choice /\ next) -> do
+ next <- randomGame next
+ pure (Just (choice /\ next))
+ pure $ GameReplay { state, next }
+
+displayReplay :: forall s c a. (s -> Doc a) -> (c -> Doc a) -> GameReplay s c -> Doc a
+displayReplay printState printChoice (GameReplay { state, next }) =
+ DD.lines
+ [ DD.indent (printState state)
+ , case next of
+ Nothing -> mempty
+ Just (choice /\ next) ->
+ DD.lines
+ [ Array.intercalate DD.space
+ [ DD.text "----"
+ , printChoice choice
+ , DD.text "---->"
+ ]
+ , displayReplay printState printChoice next
+ ]
+
+ ]
+
+gameState :: forall s c. Game s c -> s
+gameState (Game { state }) = state
+
+computePayoffs
+ :: forall s c
+ . Player
+ -> PayoffFunction s
+ -> Game s c
+ -> Game (SolvedState s c) c
+computePayoffs player calculatePayoffs game = go player 0 game
+ where
+ go player depth (Game { state, choices }) = case choices of
+ [] -> Game
+ { choices: []
+ , state: SolvedState
+ { state
+ , payoffs: calculatePayoffs depth state
+ , choice: Nothing
+ }
+ }
+ choices -> Game
+ { choices: nested
+ , state: SolvedState
+ { state
+ , payoffs: map _.payoff optimalChoice
+ , choice: map (_.choice &&& _.game) optimalChoice
+ }
+ }
+ where
+ nested = choices
+ # map (second (go (ETuple.other player) (depth + 1)))
+
+ optimalChoice = nested
+ # map
+ ( \(choice /\ game) ->
+ { choice
+ , game
+ , payoff: game
+ # gameState
+ # solvedStatePayoffs
+ # fromMaybe (hell /\ hell)
+ }
+ )
+ # maximumBy (on compare (_.payoff >>> ETuple.lookupPair player))
+
+ hell = Payoff (-infinity)
+
+-- minmax :: forall s c. PayoffFunction s -> Player -> Game s c -> Maybe (c /\ Game s c)
+-- minmax calculatePayoffs player (Game { choices, state }) =
+-- choices
+-- # Array.mapMaybe
+-- ( \(choice /\ game) -> case calculatePayoffs state of
+-- Just payoffs -> Just { choice, game, payoffs }
+-- Nothing -> Nothing
+-- )
+-- # maximumBy (on compare (_.payoffs >>> ETuple.lookup player))
+-- # map \{ choice, game } -> choice /\ game
+
+---------- Display stuff
+displaySolvedState :: forall a s c. (s -> Doc a) -> (c -> Doc a) -> SolvedState s c -> Doc a
+displaySolvedState displayState displayChoice (SolvedState { payoffs, choice, state }) = DD.lines
+ [ DD.indent (displayState state)
+ , Array.intercalate DD.space
+ [ DD.text "Payoffs:"
+ , displayUnknown displayPayoffs payoffs
+ ]
+ , Array.intercalate DD.space
+ [ DD.text "Optimal choice:"
+ , displayUnknown displayChoice (map fst choice)
+ ]
+ ]
+
+ where
+ displayUnknown :: forall e. (e -> Doc a) -> Maybe e -> Doc a
+ displayUnknown f (Just a) = f a
+ displayUnknown f Nothing = DD.text "???"
+
+ displayPayoffs (l /\ r) = Array.fold
+ [ DD.text "("
+ , displayNum (coerce l)
+ , DD.text ","
+ , DD.space
+ , displayNum (coerce r)
+ , DD.text ")"
+ ]
+ where
+ displayNum num = DD.text (show $ Number.floor (num * precision) / precision)
+ precision = 1000.0
+
+-- newtype Payoff = Payoff Int
+--
+-- newtype PayoffTreeNode label state choice = PayoffTreeNode
+-- { expectedPayoff :: Payoff /\ Payoff
+-- , children :: PayoffTree label state choicehoi--
+--
+-- newtype PayoffTree label state choice = PayoffTree
+-- { label :: label
+-- , state :: state
+-- , choices :: Array (PayoffTreeNode label state choice)
+-- }
+
+-- minmax
+-- :: forall label choice
+-- . Foldable choice
+-- => Player
+-- -> PayoffTree label choice
+-- -> PayoffTreeNode label choice
+-- minmax player (PayoffTree { label, choices }) = choice
+-- where
+-- choice = choices # maximumBy
+-- ( on compare \(PayoffTreeNode { expectedPayoff, children }) ->
+-- ETuple.lookup player expectedPayoff
+-- )
+
+---------- Typeclass instances
+-- derive instance Eq Payoff
+-- derive instance Ord Payoff
diff --git a/purescript/strategy/src/Data/Payoff.purs b/purescript/strategy/src/Data/Payoff.purs
new file mode 100644
index 0000000..d240245
--- /dev/null
+++ b/purescript/strategy/src/Data/Payoff.purs
@@ -0,0 +1,13 @@
+module EG.Data.Payoff where
+
+import Prelude
+import Data.FastVect.FastVect (Vect)
+
+newtype Payoff = Payoff Number
+
+newtype PayoffMatrix p1 p2 = PayoffMatrix (Vect p1 (Vect p2 Payoff))
+
+---------- Typeclass instances
+derive instance Eq Payoff
+derive instance Ord Payoff
+derive newtype instance Show Payoff
diff --git a/purescript/strategy/src/Data/Tuple.purs b/purescript/strategy/src/Data/Tuple.purs
new file mode 100644
index 0000000..8ce3b99
--- /dev/null
+++ b/purescript/strategy/src/Data/Tuple.purs
@@ -0,0 +1,32 @@
+module EG.Data.Tuple (TupleIndex, left, right, lookupPair, lookup, other) where
+
+import Data.Either (Either(..))
+import Data.Either.Nested (type (\/))
+import Data.HeytingAlgebra (not)
+import Data.Tuple.Nested (type (/\), (/\))
+import Safe.Coerce (coerce)
+
+-- | Position in a tuple.
+-- | Logically equivalent to a boolean
+-- | Constructable using `left` and `right`
+newtype TupleIndex = TupleIndex Boolean
+
+other :: TupleIndex -> TupleIndex
+other = coerce (not :: Boolean -> Boolean)
+
+left :: TupleIndex
+left = TupleIndex false
+
+right :: TupleIndex
+right = TupleIndex true
+
+lookupPair :: forall a. TupleIndex -> a /\ a -> a
+lookupPair (TupleIndex inner) (a /\ b) =
+ if inner then b
+ else a
+
+lookup :: forall a b. TupleIndex -> a /\ b -> a \/ b
+lookup (TupleIndex inner) (a /\ b) =
+ if inner then Right b
+ else Left a
+
diff --git a/purescript/strategy/src/Games/Tictactoe.purs b/purescript/strategy/src/Games/Tictactoe.purs
new file mode 100644
index 0000000..f51c7a8
--- /dev/null
+++ b/purescript/strategy/src/Games/Tictactoe.purs
@@ -0,0 +1,188 @@
+module EG.Games.Tictactoe where
+
+import Prelude
+
+import Data.Array (findMap, foldl, intercalate)
+import Data.Array as Array
+import Data.Int as Int
+import Data.Maybe (Maybe(..), isJust)
+import Data.Tuple.Nested (type (/\), (/\))
+import Dodo (Doc)
+import Dodo as DD
+import EG.Data.Game (Game(..))
+import EG.Data.Payoff (Payoff(..))
+import EG.Data.Tuple as ETuple
+
+---------- Types
+data Piece = X | O
+
+type Board = Array (Maybe Piece)
+type Player = ETuple.TupleIndex
+
+data TurnState = NextMove Player | WonBy Player | Draw
+
+newtype State = State
+ { board :: Board
+ , turnState :: TurnState
+ }
+
+type GameGenerationState = { board :: Board, player :: Player }
+
+type Choice = Int -- mod 9
+
+type TictactoeGame = Game State Choice
+
+---------- Helpers
+initialState :: GameGenerationState
+initialState =
+ { board: Array.replicate 9 Nothing
+ , player: ETuple.left
+ }
+
+pieceToPlayer :: Piece -> Player
+pieceToPlayer X = ETuple.left
+pieceToPlayer O = ETuple.right
+
+playerToPiece :: Player -> Piece
+playerToPiece player = ETuple.lookupPair player (X /\ O)
+
+winner :: Board -> Maybe Player
+winner = case _ of
+ [ a11
+ , a12
+ , a13
+ , a21
+ , a22
+ , a23
+ , a31
+ , a32
+ , a33
+ -- For 10 element version
+ -- , a41
+ ] ->
+ patterns # findMap (allEqual >=> map pieceToPlayer)
+ where
+ patterns =
+ [ [ a11, a12, a13 ]
+ , [ a21, a22, a23 ]
+ , [ a31, a32, a33 ]
+ , [ a11, a21, a31 ]
+ , [ a12, a22, a32 ]
+ , [ a13, a23, a33 ]
+ , [ a11, a22, a33 ]
+ , [ a13, a22, a31 ]
+ -- for weird version
+ -- , [ a11, a23, a32 ]
+ -- , [ a33, a12, a21 ]
+ -- even more weird version
+ -- , [ a13, a32, a21 ]
+ -- , [ a31, a23, a12 ]
+
+ -- for 10 element version
+ -- , [ a21, a31, a41 ]
+ -- , [ a23, a32, a41 ]
+
+ -- for 12 element version
+ -- , [ a41, a42, a43 ]
+ -- , [ a21, a31, a41 ]
+ -- , [ a22, a32, a42 ]
+ -- , [ a23, a33, a43 ]
+ -- , [ a21, a32, a43 ]
+ -- , [ a23, a32, a41 ]
+ ]
+ _ -> Nothing
+ where
+ allEqual :: forall a. Eq a => Array a -> Maybe a
+ allEqual = foldl go (Just Nothing) >>> join
+ where
+ go (Just Nothing) e = Just (Just e)
+ go whole@(Just (Just p)) e
+ | e == p = whole
+ go _ _ = Nothing
+
+---------- Game related functions
+game :: TictactoeGame
+game = go initialState
+ where
+ go { board, player }
+ | Just player <- winner board = Game
+ { state: State { board, turnState: WonBy player }
+ , choices: []
+ }
+ | Array.all isJust board = Game
+ { state: State { board, turnState: Draw }
+ , choices: []
+ }
+ | otherwise = Game
+ { state: State { board, turnState: NextMove player }
+ , choices: do
+ emptySpot <- board
+ # Array.mapWithIndex (/\)
+ # Array.mapMaybe \(index /\ piece) -> case piece of
+ Nothing -> Just index
+ Just _ -> Nothing
+
+ let
+ state =
+ { player: ETuple.other player
+ , board: board #
+ Array.modifyAtIndices
+ [ emptySpot ]
+ (const $ Just $ playerToPiece player)
+ }
+
+ pure (emptySpot /\ (go state))
+ }
+
+payoff :: Int -> State -> Maybe (Payoff /\ Payoff)
+payoff depth (State { turnState }) = case turnState of
+ WonBy player -> Just $ ETuple.lookupPair player ((pos /\ neg) /\ (neg /\ pos))
+ Draw -> Just (mid /\ mid)
+ _ -> Nothing
+ where
+ depth' = Int.toNumber depth
+ pos = Payoff (1.0 / depth')
+ mid = Payoff 0.0
+ neg = Payoff (-1.0 / depth')
+
+---------- Display stuff
+displayChoice :: forall a. Choice -> Doc a
+displayChoice num = Array.intercalate DD.space
+ [ DD.text "Place a piece at"
+ , DD.text "("
+ <> DD.text (show (num `mod` 3))
+ <> DD.text ","
+ <> DD.space
+ <> DD.text (show (num / 3))
+ <> DD.text ")"
+ ]
+
+displayState :: forall a. State -> Doc a
+displayState (State { board, turnState }) = DD.lines
+ [ intercalate DD.space (map printPiece $ Array.slice 0 3 board)
+ , intercalate DD.space (map printPiece $ Array.slice 3 6 board)
+ , intercalate DD.space (map printPiece $ Array.slice 6 9 board)
+
+ -- for 10 element version
+ -- , intercalate DD.space (map printPiece $ Array.slice 9 10 board)
+ , DD.text "State: " <> printTurnState turnState
+ ]
+ where
+ printPiece (Just X) = DD.text "X"
+ printPiece (Just O) = DD.text "O"
+ printPiece Nothing = DD.text "-"
+
+ printTurnState Draw = DD.text "Draw!"
+ printTurnState (NextMove player) = Array.intercalate DD.space
+ [ DD.text "player "
+ , DD.text (ETuple.lookupPair player ("1" /\ "2"))
+ , DD.text "should make a move"
+ ]
+ printTurnState (WonBy player) = Array.intercalate DD.space
+ [ DD.text "won by - "
+ , DD.text (ETuple.lookupPair player ("X player" /\ "O player"))
+ ]
+
+---------- Typeclass instances
+derive instance Eq Piece
+
diff --git a/purescript/strategy/src/Main.purs b/purescript/strategy/src/Main.purs
new file mode 100644
index 0000000..5c18dca
--- /dev/null
+++ b/purescript/strategy/src/Main.purs
@@ -0,0 +1,10 @@
+module Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Console (log)
+
+main :: Effect Unit
+main = do
+ log "🍝"
diff --git a/purescript/strategy/test/Main.purs b/purescript/strategy/test/Main.purs
new file mode 100644
index 0000000..f91f98c
--- /dev/null
+++ b/purescript/strategy/test/Main.purs
@@ -0,0 +1,11 @@
+module Test.Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Class.Console (log)
+
+main :: Effect Unit
+main = do
+ log "🍝"
+ log "You should add some tests."