diff --git a/lucha-libre-torneo/LuchaLibreTorneo.hs b/lucha-libre-torneo/LuchaLibreTorneo.hs new file mode 100644 index 0000000..a6be51a --- /dev/null +++ b/lucha-libre-torneo/LuchaLibreTorneo.hs @@ -0,0 +1,105 @@ +module Main where + +import Control.Concurrent.Async (mapConcurrently) +import Control.Monad (replicateM) +import Data.Either +import Data.Random.Normal (normalIO) +import Debug.Trace +import Text.Printf + +type Card = [Int] + +data Side = A | B + deriving (Show, Eq) + +type Statistics = ((Float, Float), Float, Int) + +sides = [A, B] + +data State = State { turn :: Int, aCards :: [Card], bCards :: [Card], lastWinner :: Side, temp :: [Card] } + deriving (Show) + +data Parameters = Parameters { beginningSide :: Side, fields :: Int, cardsPerSide :: Int } + deriving (Show) + +maxIndex xs = head $ filter ((== maximum xs) . (xs !!)) [0..] + +point :: IO Int +point = abs . truncate . (100 *) <$> (normalIO :: IO Float) + +initialState :: Parameters -> IO State +initialState parameters = + State 0 <$> cards <*> cards <*> pure (beginningSide parameters) <*> pure [] + where card = replicateM (fields parameters) point + cards = replicateM (cardsPerSide parameters) card + +runGame :: State -> Either State (Side, Int) +runGame state = + if turn state >= 1000 then Left state else + case (aCards state, bCards state) of + ([], _) -> Right (A, turn state) + (_, []) -> Right (B, turn state) + (a:ac, b:bc) -> + let + lastWinnersFirstCard = case lastWinner state of + A -> a + B -> b + -- the last winning player picks the field of his card which is best + bestField = maxIndex lastWinnersFirstCard + in + -- trace ("maxIndex of " ++ show lastWinnersFirstCard ++ " is " ++ show bestField) $ + -- trace ("Side " ++ show (lastWinner state) ++ " asking for " ++ show bestField) $ + runGame $ case compare (a !! bestField) (b !! bestField) of + GT -> + -- trace "A won" $ + state + { turn = succ $ turn state + , aCards = ac ++ temp state ++ [a, b] + , bCards = bc + , lastWinner = A + , temp = [] + } + LT -> + -- trace "B won" $ + state + { turn = succ $ turn state + , aCards = ac + , bCards = bc ++ temp state ++ [a, b] + , lastWinner = B + , temp = [] + } + EQ -> + state + { turn = succ $ turn state + , aCards = ac + , bCards = bc + , lastWinner = lastWinner state + , temp = [a, b] + } + +average :: [Either State (Side, Int)] -> Statistics +average results = + ( (winningQuota A, winningQuota B) + , quota $ sum $ map snd $ rights results -- average + , length $ lefts results + ) + where + quota x = fromIntegral x / fromIntegral (length results) + winningQuota side = quota $ length $ filter ((== side) . fst) (rights results) + +allTheStats :: Int -> [Int] -> [Int] -> IO [(Parameters, Statistics)] +allTheStats games possibleFields possibleCardsPerSide = + mapConcurrently averageGame allTheGames + where allTheGames = Parameters <$> [A, B] <*> possibleFields <*> possibleCardsPerSide + averageGame parameters = (,) parameters . average <$> replicateM games (runGame <$> initialState parameters) + +renderStats :: (Parameters, Statistics) -> String +renderStats (parameters, ((winsA, winsB), turns, loops)) = printf "(begin %s fields %4d cards %4d) A %.2f B %.2f Turns %3.1f Loops %d" (show $ beginningSide parameters) (fields parameters) (cardsPerSide parameters) winsA winsB turns loops + +main = do + stats <- allTheStats 100 [6] [1..20] + mapM_ (putStrLn . renderStats) stats + +-- how many turns do games need on average +-- is any of that influenced by the number of fields, the number of cards per side and who began (initial lastWinner) +-- diff --git a/lucha-libre-torneo/Readme.md b/lucha-libre-torneo/Readme.md new file mode 100644 index 0000000..77c94f2 --- /dev/null +++ b/lucha-libre-torneo/Readme.md @@ -0,0 +1,3 @@ +# Lucha Libre Torneo + +Simulating a card game using Haskell.