module Data.Bet
(
BetType(..)
, oppositeBetType
, betBool
, Bet(..)
, BetFlipped(..)
, betType
, odds
, stake
, liability
, winningPotential
, pattern BetType
, pattern BetLiability
, pattern BetWinningPotential
, bestTradingStake
, bestTradingStake2
)
where
import Control.Applicative
import Control.Lens
import Data.Aeson
import Data.Bifoldable
import Data.Bitraversable
import Data.Foldable
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Bifoldable
import Data.Traversable
import Data.Typeable
data BetType = Back | Lay
deriving ( Eq, Ord, Show, Read, Typeable, Enum )
betBool :: Iso' BetType Bool
betBool = iso (\case
Back -> False
Lay -> True)
(\case
False -> Back
True -> Lay)
oppositeBetType :: BetType -> BetType
oppositeBetType Back = Lay
oppositeBetType Lay = Back
data Bet odds money = Bet !BetType odds money
deriving ( Traversable
, Foldable
, Typeable
, Functor
, Read
, Show
, Ord
, Eq )
instance Foldable1 (Bet odds)
instance Bifoldable1 Bet
instance Bifoldable Bet where
bifoldMap f g (Bet _ o m) = f o `mappend` g m
instance Bitraversable Bet where
bitraverse f g (Bet t o m) = Bet t <$> f o <*> g m
instance (Semigroup odds, Semigroup money) => Semigroup (Bet odds money) where
b1 <> b2 = b1 & (stake %~ (<> b2^.stake)) .
(odds %~ (<> b2^.odds))
instance Bifunctor Bet where
bimap fun1 fun2 = (odds %~ fun1) . (stake %~ fun2)
newtype BetFlipped money odds = BetFlipped { getFlipped :: Bet odds money }
deriving ( Typeable
, Read
, Show
, Ord
, Eq )
instance Functor (BetFlipped money) where
fmap f (getFlipped -> Bet t o m) = BetFlipped $ Bet t (f o) m
instance Foldable (BetFlipped money) where
foldMap f (getFlipped -> Bet _ o _) = f o
foldr f r (getFlipped -> Bet _ o _) = f o r
instance Traversable (BetFlipped money) where
traverse f (getFlipped -> bet) =
BetFlipped . (\x -> bet & odds .~ x) <$> f (bet^.odds)
sequenceA (getFlipped -> Bet t o m) =
BetFlipped <$> (Bet t <$> o <*> pure m)
instance (Semigroup odds, Semigroup money)
=> Semigroup (BetFlipped money odds) where
(getFlipped -> b1) <> (getFlipped -> b2) =
BetFlipped $ b1 <> b2
instance Bifunctor BetFlipped where
bimap fun2 fun1 (getFlipped -> b) =
BetFlipped $ b & (odds %~ fun1) . (stake %~ fun2)
instance Bifoldable BetFlipped where
bifoldMap f g (getFlipped -> Bet _ o m) = g o `mappend` f m
instance Bifoldable1 BetFlipped
instance Bitraversable BetFlipped where
bitraverse f g (getFlipped -> Bet t o m) =
BetFlipped <$> (Bet t <$> g o <*> f m)
instance Foldable1 (BetFlipped money)
odds :: Lens (Bet odds1 money) (Bet odds2 money) odds1 odds2
odds = lens (\(Bet _ o _) -> o)
(\(Bet t _ m) o -> Bet t o m)
stake :: Lens (Bet odds money1) (Bet odds money2) money1 money2
stake = lens (\(Bet _ _ m) -> m)
(\(Bet t o _) m -> Bet t o m)
betType :: Lens' (Bet odds money) BetType
betType = lens (\(Bet t _ _) -> t)
(\(Bet _ o m) t -> Bet t o m)
liability :: (Fractional odds, odds ~ money) => Lens' (Bet odds money) money
liability = lens getLiability setLiability
setLiability :: (Fractional odds, odds ~ money)
=> Bet odds money -> money -> Bet odds money
setLiability bet@(BetType Back) new_m = bet & stake .~ new_m
setLiability bet@(Bet Lay o _) new_l = bet & stake .~ new_l/(o1)
setLiability _ _ = error "setLiability: impossible"
getLiability :: (Num odds, odds ~ money) => Bet odds money -> money
getLiability (Bet Back _ m) = m
getLiability (Bet Lay o m) = m*(o1)
winningPotential :: (Fractional odds, odds ~ money)
=> Lens' (Bet odds money) money
winningPotential = lens getWinningPotential setWinningPotential
getWinningPotential :: (Num odds, odds ~ money) => Bet odds money -> money
getWinningPotential (Bet Back o m) = (o1) * m
getWinningPotential (Bet Lay _ m) = m
setWinningPotential :: (Fractional odds, odds ~ money)
=> Bet odds money -> money -> Bet odds money
setWinningPotential bet@(BetType Back) new_w =
bet & stake .~ new_w / (bet^.odds 1)
setWinningPotential bet new_w =
bet & stake .~ new_w
pattern BetType b <- Bet b _ _
pattern BetLiability b o l <- Bet b o (getLiability -> l)
pattern BetWinningPotential b o w <- Bet b o (getWinningPotential -> w)
bestTradingStake :: ( Fractional odds, odds ~ money )
=> Bet odds money -> odds -> money
bestTradingStake (Bet bt o m) opposing_odds = case bt of
Back -> o*m / opposing_odds
Lay -> m*o / opposing_odds
bestTradingStake2 :: ( Fractional odds, odds ~ money )
=> Bet odds money -> odds -> Bet odds money
bestTradingStake2 bet opposing_odds =
Bet (oppositeBetType $ bet^.betType)
opposing_odds
(bestTradingStake bet opposing_odds)
instance FromJSON BetType where
parseJSON (String "BACK") = pure Back
parseJSON (String "LAY") = pure Lay
parseJSON _ = empty
instance ToJSON BetType where
toJSON Back = String "BACK"
toJSON Lay = String "LAY"