MTGBuilder 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+214/−2 lines, 4 files

Files

• MTGBuilder.cabal +5/−2
• src/MTGBuilder/Combination.hs +14/−0
• src/MTGBuilder/Deck.hs +129/−0
• src/MTGBuilder/Parser.hs +66/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                MTGBuilder-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Builds decks out of a meta -- description:          license:             MIT@@ -17,7 +17,10 @@  executable mtg-builder   main-is:             Main.hs-  -- other-modules:       +  other-modules:+    MTGBuilder.Deck+    MTGBuilder.Combination+    MTGBuilder.Parser   -- other-extensions:       build-depends:         base >=4.8 && <4.9

@@ -0,0 +1,14 @@+module MTGBuilder.Combination where++import Data.Set (Set)+import qualified Data.Set as Set++combinations :: Ord a => Int -> Set a -> Set (Set a)+combinations k xs = combinations' (Set.size xs) k xs+    where combinations' n k' s+            | k' == 0   = Set.singleton (Set.empty)+            | k' >= n   = Set.singleton (s)+            | null s    = Set.empty+            | otherwise = case Set.minView s of+                Just (y, ys)    -> Set.map (Set.insert y) (combinations' (n-1) (k'-1) ys) `Set.union` combinations' (n-1) k' ys+                Nothing         -> error "Invalid empty set"

@@ -0,0 +1,129 @@+{-# LANGUAGE BangPatterns #-}++module MTGBuilder.Deck (+    makeRanking,+    composeDecks,+    dumpDeck,+    dumpRanking,+    Ranking,+    Card(..),+    Deck+) where++import MTGBuilder.Combination+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.List+import Control.Monad.Reader+import System.IO++data Card = MkCard {+    name :: String,+    copy :: Int+} deriving (Show, Eq, Ord)++type Deck = Set Card++{-+The ranking is the most important data structure++http://www.channelfireball.com/articles/magic-math-a-new-way-to-determine-an-aggregate-deck-list-rg-dragons/++Frank Karsten's algorithm is an example of building a deck based soley on first order rankings.++An Nth order ranking is the popularty of a particular combination of N cards.+If six of the input decks run Bolt1+Snapcaster1, that combination gets a score of 6.++The interaction field is the map of all combinations found in any input deck,+and the number of decks that have that combination.++The interactionSize field is the maximum order of rank.+This is used to throttle the computational expense, at the cost of precision.+Precision beyond 3rd order likely isn't necessary.+2nd order is enough for most cases.+1st order is exactly Karsten's algorithm, and is only good enough for single-archetype aggregations.+-}++data Ranking = MkRanking {+    interaction :: Map (Set Card) Int,+    interactionSize :: Int+}++-- The return type of this function is a reader over IO so that verbosity can be read, and verbose messages can be printed+makeRanking :: Int -> [(String, Deck)] -> ReaderT Bool IO Ranking+makeRanking size inputDecks = do+    verbose <- ask+    rankDecks MkRanking { interaction=Map.empty, interactionSize=size } inputDecks+    where+        rankDecks :: Ranking -> [(String, Deck)] -> ReaderT Bool IO Ranking+        rankDecks ranking [] = return ranking+        rankDecks ranking ((name, deck):decks) = do+            verbose <- ask+            when verbose (liftIO $ hPutStrLn stderr $ "Ranking " ++ name)+            rankDecks (ranking { interaction=int }) decks+            where+                !int = -- Strict, because it will be fully evaluated anyway, and this provides more realistic verbose messages.+                    let f map x = Map.insertWith (+) x 1 map+                    in  foldl f (interaction ranking) $ Set.unions [combinations n deck | n <- [1..(interactionSize ranking)]]++dumpDeck :: Deck -> String+dumpDeck deck = intercalate "\n" lines+    where+        lines :: [String]+        lines = fmap (\(cardName, count) -> (show count) ++ " " ++ cardName) (Map.assocs getMap)+            where+                getMap :: Map String Int+                getMap = foldl f Map.empty deck+                    where+                        f = (\map card -> Map.insertWith (+) (name card) 1 map)++dumpRanking :: Ranking -> String+dumpRanking ranking = intercalate "\n" lines+    where+        lines :: [String]+        lines = fmap (\(combo, count) -> (show count) ++ " : " ++ (show combo)) $ Map.assocs $ interaction ranking+{-+Composition combines all the input decks.+Note: Although different copies of the same card are treated as different cards in this algorithm,+the same copies of the same card from different decks are treated as the same.+So when we union the decks, we are merely merging all the cards in all decks.+So if two decks each have 4 Bolts, we still only see 4 Bolts in the union.++Composing decks simply sorts the cards in the union by sortWithRanking,+then removes the lowest ranked card, then repeats until the deck is down to the provided size.+-}+composeDecks :: Ranking -> Int -> [Deck] -> ReaderT Bool IO Deck+composeDecks ranking deckSize decks = compose $ Set.unions decks+    where+        compose :: Deck -> ReaderT Bool IO Deck+        compose cards+            | Set.size sorted <= deckSize = return $ Set.map snd sorted+            | otherwise = do+                verbose <- ask+                when verbose $ liftIO $ hPutStrLn stderr (show $ Set.size sorted)+                compose $ Set.map snd $ fromMaybe Set.empty $ fmap snd $ Set.minView sorted+            where sorted = sortWithRanking ranking cards++-- Each card in the set is ranked.+sortWithRanking :: Ranking -> Set Card -> Set (Double, Card)+sortWithRanking ranking deck = Map.foldlWithKey (\set card rank -> Set.insert (rank, card) set) Set.empty rankMap+    where+        rankMap = Map.foldlWithKey rankCombo Map.empty $ interaction ranking+        rankCombo map combo count+            | combo `Set.isSubsetOf` deck = foldl (\m card -> Map.insertWith (+) card rank m) map combo+            | otherwise = map+            where+                {-+                To rank a card, look at each combination in the ranking.+                For each combination that contains the card, and is a subset of the deck,+                add to the card's ranking the following:++                    (popularity of combo) * 1 / (2 ^ order of combo)++                This way, lower orders are considered more important,+                thus the popularity of the card on its own (first order combination) is most important+                -}+                rank = (fromIntegral count) * 1.0 / (2.0 ^ Set.size combo)

@@ -0,0 +1,66 @@+module MTGBuilder.Parser (+    deckParser,+    parseDeckString,+    parseDeckFile+) where++import MTGBuilder.Deck+import Control.Monad+import Data.Set+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as Token+import Text.Parsec.Char+import Text.ParserCombinators.Parsec.Combinator++deckTokens = Token.makeTokenParser $ emptyDef {+    identStart = alphaNum <|> char '_',+    commentLine = "//",+    caseSensitive = False+}++identifier = Token.identifier deckTokens+lexeme = Token.lexeme deckTokens+reserved = Token.reserved deckTokens+symbol = Token.symbol deckTokens+natural = Token.natural deckTokens+brackets = Token.brackets deckTokens+whiteSpace = Token.whiteSpace deckTokens++deckParser :: Parser Deck+deckParser = do+    whiteSpace+    d <- deck+    optionMaybe sideboard+    return d++deck :: Parser Deck+deck = do+    cards <- many cardParser+    return $ unions cards++cardParser :: Parser (Set Card)+cardParser = lexeme (mainboardCard <|> (sideboardCard >> return empty))++mainboardCard :: Parser (Set Card)+mainboardCard = do+    numCopies <- natural+    set <- optionMaybe $ brackets $ optionMaybe identifier+    name <- manyTill anyChar endOfCard+    return $ fromList [MkCard {name=name,copy=fromIntegral n} | n <- [1..numCopies]]+    where endOfCard = (endOfLine >> return ()) <|> eof++sideboardCard :: Parser ()+sideboardCard = do+    symbol "SB:"+    mainboardCard+    return ()++sideboard :: Parser ()+sideboard = do+    reserved "sideboard"+    deck+    return ()++parseDeckString = parse deckParser+parseDeckFile = parseFromFile deckParser