module Numeric.Probability.Example.Collection where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Random as Rnd
import Numeric.Probability.Distribution ((??), )
import Numeric.Probability.Simulation ((~.), )

import Numeric.Probability.Percentage (Dist)

import Numeric.Probability.Monad (doWhile, )
import Control.Monad.Trans.State (StateT(StateT, runStateT), evalStateT, )
import Control.Monad (liftM2, replicateM, )

import qualified Data.List.HT as ListHT
import System.Random (Random)



type Collection a = [a]

type Probability = Rational


selectOne :: (Fractional prob) =>
   StateT (Collection a) (Dist.T prob) a
selectOne :: forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne =
   forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall prob a. Fractional prob => Spread prob a
Dist.uniform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(a, [a])]
ListHT.removeEach

select1 :: (Fractional prob) => Collection a -> Dist.T prob a
select1 :: forall prob a. Fractional prob => Spread prob a
select1 = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne

select2 :: (Fractional prob) => Collection a -> Dist.T prob (a,a)
select2 :: forall prob a. Fractional prob => Collection a -> T prob (a, a)
select2 = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne)

select :: (Fractional prob) => Int -> Collection a -> Dist.T prob [a]
select :: forall prob a.
Fractional prob =>
Int -> Collection a -> T prob (Collection a)
select Int
n = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne)


-- * Example collections

-- ** marbles

data Marble = R | G | B deriving (Marble -> Marble -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marble -> Marble -> Bool
$c/= :: Marble -> Marble -> Bool
== :: Marble -> Marble -> Bool
$c== :: Marble -> Marble -> Bool
Eq,Eq Marble
Marble -> Marble -> Bool
Marble -> Marble -> Ordering
Marble -> Marble -> Marble
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Marble -> Marble -> Marble
$cmin :: Marble -> Marble -> Marble
max :: Marble -> Marble -> Marble
$cmax :: Marble -> Marble -> Marble
>= :: Marble -> Marble -> Bool
$c>= :: Marble -> Marble -> Bool
> :: Marble -> Marble -> Bool
$c> :: Marble -> Marble -> Bool
<= :: Marble -> Marble -> Bool
$c<= :: Marble -> Marble -> Bool
< :: Marble -> Marble -> Bool
$c< :: Marble -> Marble -> Bool
compare :: Marble -> Marble -> Ordering
$ccompare :: Marble -> Marble -> Ordering
Ord,Int -> Marble -> ShowS
[Marble] -> ShowS
Marble -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Marble] -> ShowS
$cshowList :: [Marble] -> ShowS
show :: Marble -> String
$cshow :: Marble -> String
showsPrec :: Int -> Marble -> ShowS
$cshowsPrec :: Int -> Marble -> ShowS
Show)

bucket :: Collection Marble
bucket :: [Marble]
bucket = [Marble
R,Marble
R,Marble
R,Marble
R,Marble
R, Marble
G,Marble
G,Marble
G, Marble
B,Marble
B]

jar :: Collection Marble
jar :: [Marble]
jar = [Marble
R,Marble
R,Marble
G,Marble
G,Marble
B]

-- pRGB = prob (just [R,G,B]) (select 3 bucket)
pRGB :: Probability
pRGB :: Probability
pRGB = forall a. Eq a => a -> Event a
Dist.just [Marble
R,Marble
G,Marble
B] forall prob a. Num prob => Event a -> T prob a -> prob
?? forall prob a.
Fractional prob =>
Int -> Collection a -> T prob (Collection a)
select Int
3 [Marble]
jar
pRG :: Probability
pRG :: Probability
pRG  = forall a. Eq a => [a] -> Event a
Dist.oneOf [[Marble
R,Marble
G],[Marble
G,Marble
R]] forall prob a. Num prob => Event a -> T prob a -> prob
?? forall prob a.
Fractional prob =>
Int -> Collection a -> T prob (Collection a)
select Int
2 [Marble]
jar

-- ** cards

data Suit = Club | Spade | Heart | Diamond
            deriving (Suit -> Suit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suit -> Suit -> Bool
$c/= :: Suit -> Suit -> Bool
== :: Suit -> Suit -> Bool
$c== :: Suit -> Suit -> Bool
Eq,Eq Suit
Suit -> Suit -> Bool
Suit -> Suit -> Ordering
Suit -> Suit -> Suit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Suit -> Suit -> Suit
$cmin :: Suit -> Suit -> Suit
max :: Suit -> Suit -> Suit
$cmax :: Suit -> Suit -> Suit
>= :: Suit -> Suit -> Bool
$c>= :: Suit -> Suit -> Bool
> :: Suit -> Suit -> Bool
$c> :: Suit -> Suit -> Bool
<= :: Suit -> Suit -> Bool
$c<= :: Suit -> Suit -> Bool
< :: Suit -> Suit -> Bool
$c< :: Suit -> Suit -> Bool
compare :: Suit -> Suit -> Ordering
$ccompare :: Suit -> Suit -> Ordering
Ord,Int -> Suit -> ShowS
[Suit] -> ShowS
Suit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suit] -> ShowS
$cshowList :: [Suit] -> ShowS
show :: Suit -> String
$cshow :: Suit -> String
showsPrec :: Int -> Suit -> ShowS
$cshowsPrec :: Int -> Suit -> ShowS
Show,Int -> Suit
Suit -> Int
Suit -> [Suit]
Suit -> Suit
Suit -> Suit -> [Suit]
Suit -> Suit -> Suit -> [Suit]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Suit -> Suit -> Suit -> [Suit]
$cenumFromThenTo :: Suit -> Suit -> Suit -> [Suit]
enumFromTo :: Suit -> Suit -> [Suit]
$cenumFromTo :: Suit -> Suit -> [Suit]
enumFromThen :: Suit -> Suit -> [Suit]
$cenumFromThen :: Suit -> Suit -> [Suit]
enumFrom :: Suit -> [Suit]
$cenumFrom :: Suit -> [Suit]
fromEnum :: Suit -> Int
$cfromEnum :: Suit -> Int
toEnum :: Int -> Suit
$ctoEnum :: Int -> Suit
pred :: Suit -> Suit
$cpred :: Suit -> Suit
succ :: Suit -> Suit
$csucc :: Suit -> Suit
Enum)

data Rank = Plain Int | Jack | Queen | King | Ace
            deriving (Rank -> Rank -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq,Eq Rank
Rank -> Rank -> Bool
Rank -> Rank -> Ordering
Rank -> Rank -> Rank
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rank -> Rank -> Rank
$cmin :: Rank -> Rank -> Rank
max :: Rank -> Rank -> Rank
$cmax :: Rank -> Rank -> Rank
>= :: Rank -> Rank -> Bool
$c>= :: Rank -> Rank -> Bool
> :: Rank -> Rank -> Bool
$c> :: Rank -> Rank -> Bool
<= :: Rank -> Rank -> Bool
$c<= :: Rank -> Rank -> Bool
< :: Rank -> Rank -> Bool
$c< :: Rank -> Rank -> Bool
compare :: Rank -> Rank -> Ordering
$ccompare :: Rank -> Rank -> Ordering
Ord,Int -> Rank -> ShowS
[Rank] -> ShowS
Rank -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rank] -> ShowS
$cshowList :: [Rank] -> ShowS
show :: Rank -> String
$cshow :: Rank -> String
showsPrec :: Int -> Rank -> ShowS
$cshowsPrec :: Int -> Rank -> ShowS
Show)

type Card = (Rank,Suit)

plains :: [Rank]
plains :: [Rank]
plains = forall a b. (a -> b) -> [a] -> [b]
map Int -> Rank
Plain [Int
2..Int
10]

faces :: [Rank]
faces :: [Rank]
faces = [Rank
Jack,Rank
Queen,Rank
King,Rank
Ace]

isFace :: Card -> Bool
isFace :: Card -> Bool
isFace (Rank
r,Suit
_) = Rank
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rank]
faces
-- isFace = (`elem` faces) . fst

isPlain :: Card -> Bool
isPlain :: Card -> Bool
isPlain (Rank
r,Suit
_) = Rank
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rank]
plains

ranks :: [Rank]
ranks :: [Rank]
ranks = [Rank]
plains forall a. [a] -> [a] -> [a]
++ [Rank]
faces

suits :: [Suit]
suits :: [Suit]
suits = [Suit
Club,Suit
Spade,Suit
Heart,Suit
Diamond]

deck :: Collection Card
deck :: Collection Card
deck = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Rank]
ranks [Suit]
suits


-- * Example

{- | mini-blackjack:
draw 2 cards, and if value is less than 14, continue drawing
until value equals or exceeds 14.  if values exceeds 21,
you lose, otherwise you win.
-}

value :: Card -> Int
value :: Card -> Int
value ((Plain Int
n),Suit
_) = Int
n
value (Rank
Ace,Suit
_) = Int
11
value Card
_ = Int
10

totalValue :: Collection Card -> Int
totalValue :: Collection Card -> Int
totalValue Collection Card
cards = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map Card -> Int
value Collection Card
cards)

-- this can be made with StateT, too, I think
draw :: (Fractional prob) =>
   ([Card], Collection Card) -> Dist.T prob ([Card], Collection Card)
draw :: forall prob.
Fractional prob =>
(Collection Card, Collection Card)
-> T prob (Collection Card, Collection Card)
draw (Collection Card
cards,Collection Card
cl) =
   forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:Collection Card
cards) forall prob a. Fractional prob => StateT (Collection a) (T prob) a
selectOne) Collection Card
cl

drawF :: ([Card], Collection Card) -> Dist ([Card], Collection Card)
drawF :: (Collection Card, Collection Card)
-> Dist (Collection Card, Collection Card)
drawF = forall prob.
Fractional prob =>
(Collection Card, Collection Card)
-> T prob (Collection Card, Collection Card)
draw


drawTo16 :: Rnd.T ([Card], Collection Card)
drawTo16 :: T (Collection Card, Collection Card)
drawTo16 =
   forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
doWhile
      (\(Collection Card
cards,Collection Card
_) -> Collection Card -> Int
totalValue Collection Card
cards forall a. Ord a => a -> a -> Bool
< Int
16)
      (forall prob a.
(Num prob, Ord prob, Random prob) =>
T prob a -> Change a
Rnd.change (Collection Card, Collection Card)
-> Dist (Collection Card, Collection Card)
drawF) ([], Collection Card
deck)

win :: ([Card], b) -> Bool
win :: forall b. (Collection Card, b) -> Bool
win (Collection Card
cards,b
_) = Collection Card -> Int
totalValue Collection Card
cards forall a. Ord a => a -> a -> Bool
<= Int
21

chanceWin :: (Fractional prob, Ord prob, Random prob) =>
   Rnd.T (Dist.T prob Bool)
chanceWin :: forall prob.
(Fractional prob, Ord prob, Random prob) =>
T (T prob Bool)
chanceWin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map forall b. (Collection Card, b) -> Bool
win) ((Int
100 forall (c :: * -> *) prob a.
(C c, Fractional prob, Ord prob, Random prob, Ord a) =>
Int -> (a -> c a) -> Transition prob a
~. forall a b. a -> b -> a
const T (Collection Card, Collection Card)
drawTo16) forall a. HasCallStack => a
undefined)