Ghost in the Cell -- refactoring; separate AI from IO.

Contests/GhostInTheCell/GhostInTheCell.hs

@@ -35,10 +35,10 @@ data Troop   = Troop   { troopId           :: EntityId
                        } deriving (Eq, Show)
 
 data Bomb    = Bomb    { bombId            :: EntityId
-                       , bombSender        :: PlayerId
+                       , bombOwner         :: PlayerId
                        , bombOrigin        :: FactoryId
                        , bombTarget        :: FactoryId
-                       , bombDelay         :: Int
+                       , bombTurnsLeft     :: Int
                        } deriving (Eq, Show)
 
 data Action  = Move FactoryId FactoryId Int
@@ -47,14 +47,41 @@ data Action  = Move FactoryId FactoryId Int
              | Wait
              deriving (Eq, Show)
 
+class    HasEntityId a       where entityId  :: a -> EntityId
+instance HasEntityId Factory where entityId  = factoryId
+instance HasEntityId Troop   where entityId  = troopId
+instance HasEntityId Bomb    where entityId  = bombId
+
+class    HasOwner a          where owner     :: a -> PlayerId
+instance HasOwner Factory    where owner     = factoryOwner
+instance HasOwner Troop      where owner     = troopOwner
+instance HasOwner Bomb       where owner     = bombOwner
+
+class    HasCyborgs a        where cyborgs   :: a -> Int
+instance HasCyborgs Factory  where cyborgs   = factoryCyborgs
+instance HasCyborgs Troop    where cyborgs   = troopCyborgs
+
+class    HasOrigin a         where origin    :: a -> FactoryId
+instance HasOrigin Troop     where origin    = troopOrigin
+instance HasOrigin Bomb      where origin    = bombOrigin
+
+class    HasTarget a         where target    :: a -> FactoryId
+instance HasTarget Troop     where target    = troopTarget
+instance HasTarget Bomb      where target    = bombTarget
+
+class    HasTurnsLeft a      where turnsLeft :: a -> Int
+instance HasTurnsLeft Troop  where turnsLeft = troopTurnsLeft
+instance HasTurnsLeft Bomb   where turnsLeft = bombTurnsLeft
+
 data GameState =
    GameState
-      { gsLinks        :: M.Map (FactoryId, FactoryId) Int
+      { gsLinks      :: M.Map (FactoryId, FactoryId) Int
-      , gsFactories    :: [Factory]
+      , gsFactories  :: [Factory]
-      , gsTroops       :: [Troop]
+      , gsTroops     :: [Troop]
-      , gsBombs        :: [Bomb]
+      , gsBombs      :: [Bomb]
-      , gsMyBombsLeft  :: Int
+      , gsBombsLeft  :: Int
-      , gsNextEntity   :: EntityId
+      , gsNextEntity :: EntityId
+      , gsTurnCount  :: Int
       } deriving (Show)
 
 actionString :: Action -> String
@@ -72,21 +99,18 @@ main :: IO ()
 main = do
    hSetBuffering stdout NoBuffering -- DO NOT REMOVE
 
-   factoryCount <- readLn :: IO Int -- the number of factories
+   factoryCount <- readLn :: IO Int -- the number of factories (not used)
    linkCount    <- readLn :: IO Int -- the number of links between factories
 
    links <- fmap (M.fromList . concat) $ replicateM linkCount $ do
       [f1, f2, dist] <- map read . words <$> getLine
       pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)])
 
-   bombsLeftRef <- newIORef 2
    turnCountRef <- newIORef 1
+   bombsLeftRef <- newIORef 2
 
    forever $ do
-      turnCount <- readIORef turnCountRef
+      entityCount <- readLn :: IO Int
-      bombsLeft <- readIORef bombsLeftRef
-      entityCount <- readLn :: IO Int -- the number of entities (e.g. factories and troops)
-
       (partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do
          ((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine
          pure $ case entityType of
@@ -94,104 +118,101 @@ main = do
                "TROOP"   -> Right . Left  $ Troop   entityId a1 a2 a3 a4 a5
                "BOMB"    -> Right . Right $ Bomb    entityId a1 a2 a3 a4
 
-      let nextEntity = (+1) $ maximum $ 0 : map factoryId factoryList
+      let nextEntity = (+1) $ maximum $ 0 : map entityId factoryList
-                                         ++ map troopId   troopList
+                                         ++ map entityId troopList
-                                         ++ map bombId    bombList
+                                         ++ map entityId bombList
 
-      let gs = GameState { gsLinks = links
+      turnCount <- readIORef turnCountRef
-                         , gsFactories = factoryList
+      bombsLeft <- readIORef bombsLeftRef
-                         , gsTroops = troopList
-                         , gsBombs = bombList
-                         , gsMyBombsLeft = bombsLeft
-                         , gsNextEntity = nextEntity
-                         }
 
-      let factories   = M.fromList [ (factoryId f, f) | f <- factoryList ]
+      let chosenActions = chooseActions $
-      let myFactories = filter (\f -> factoryOwner f == thisPlayer) factoryList
+            GameState { gsLinks      = links
-      let inTransitTo =
+                      , gsFactories  = factoryList
-            let transitMap = M.fromList
+                      , gsTroops     = troopList
-                  [ (to, (mine, theirs))
+                      , gsBombs      = bombList
-                  | let myTroops    = filter (\t -> troopOwner t == thisPlayer) troopList
+                      , gsNextEntity = nextEntity
-                  , let theirTroops = filter (\t -> troopOwner t /= thisPlayer) troopList
+                      , gsTurnCount  = turnCount
-                  , to <- map factoryId factoryList
+                      , gsBombsLeft  = bombsLeft
-                  , let mine   = sum $ map troopCyborgs $ filter (\t -> troopTarget t == to) myTroops
+                      }
-                  , let theirs = sum $ map troopCyborgs $ filter (\t -> troopTarget t == to) theirTroops
-                  ]
-            in \dst -> fromMaybe (0, 0) $ M.lookup dst transitMap
 
-      let distributeScores src = do
+      case chosenActions of
-            dst <- myFactories
-            guard $ factoryId dst /= factoryId src
-            let (srcDefending, srcAttacking) = inTransitTo (factoryId src)
-            let (dstDefending, dstAttacking) = inTransitTo (factoryId dst)
-            let srcTotal = factoryCyborgs src - srcAttacking
-            let dstTotal = factoryCyborgs dst + dstDefending - dstAttacking
-            let amount = (factoryCyborgs src + 1) `div` 3
-            guard $ amount > 0 && amount <= factoryCyborgs src
-            dist <- toList $ M.lookup (factoryId src, factoryId dst) links
-            pure $ Move (factoryId src) (factoryId dst) amount
-
-      let attackScores src = do
-            dst <- filter (\f -> factoryOwner f /= thisPlayer) factoryList
-            dist <- toList $ M.lookup (factoryId src, factoryId dst) links
-            let (mineDefending, theirsAttacking) = inTransitTo (factoryId src)
-            let (mineAttacking, theirsDefending) = inTransitTo (factoryId dst)
-            let myTotal    = factoryCyborgs src - theirsAttacking
-            let theirTotal = factoryCyborgs dst + theirsDefending - mineAttacking
-            let theirEstimate
-                  | factoryOwner dst == neutralPlayer = theirTotal
-                  | otherwise = theirTotal + factoryProduction dst * (1 + dist)
-            let amount = theirEstimate + 1
-            guard $ amount > 0 && amount <= factoryCyborgs src
-            pure $ Move (factoryId src) (factoryId dst) amount
-
-      let increaseScores src = do
-            guard $ factoryProduction src < 3
-            guard $ factoryCyborgs src >= 10
-            pure $ Increase (factoryId src)
-
-      let factoryActions src = foldr mplus mempty $ map ($ src) $
-            [ distributeScores, attackScores, increaseScores ]
-
-      let actions = concatMap factoryActions myFactories
-
-      let bombActions = do
-            guard $ bombsLeft > 0 && not (null myFactories)
-            guard $ bombsLeft > 1 || turnCount > 50
-            dst <- filter (\f -> factoryOwner f == opponent) factoryList
-            --guard $ factoryCyborgs dst >= 50 + 50 * (2 - bombsLeft)
-            let src = snd $ minimumBy (compare `on` fst) $
-                  [ (dist, s) | s <- myFactories
-                  , dist <- toList $ M.lookup (factoryId s, factoryId dst) links
-                  ]
-            pure $ SendBomb (factoryId src) (factoryId dst)
-
-      remainingActions <- newIORef (actions ++ bombActions)
-      chosenActions <- newIORef []
-      projScore <- newIORef (scoreGame (simulate [] 20 gs))
-
-      fix $ \loop -> do
-         cs <- readIORef chosenActions
-         as <- readIORef remainingActions
-         sc <- readIORef projScore
-         let scoredActions = map (\a -> (scoreGame (simulate [(thisPlayer, cs++[a])] 20 gs), a)) as
-         case best 10 scoredActions of
-            [] -> pure ()
-            (sc',a):rs -> when (sc' > sc) $ do
-               writeIORef chosenActions (cs ++ [a])
-               writeIORef remainingActions (map snd rs)
-               writeIORef projScore sc'
-               loop
-
-      chosenActions' <- readIORef chosenActions
-      case chosenActions' of
          [] -> putStrLn $ actionString Wait
          xs -> putStrLn $ intercalate "; " $ map actionString xs
 
       let isSendBomb act = case act of { SendBomb _ _ -> True; _ -> False }
-      modifyIORef bombsLeftRef (subtract $ length $ filter isSendBomb chosenActions')
+      modifyIORef bombsLeftRef (subtract $ length $ filter isSendBomb chosenActions)
       modifyIORef turnCountRef (+1)
 
+awareness, foresight :: Int
+awareness = 10  -- number of actions to consider
+foresight = 30  -- number of moves to look ahead
+
+chooseActions :: GameState -> [Action]
+chooseActions gs = loop [] (scoreGame (simulate [] foresight gs)) (allFactoryActions ++ bombActions)
+   where
+      scoreActions as = scoreGame $ simulate [(thisPlayer, as)] foresight gs
+      loop cs sc as = case best awareness $ map (\a -> (scoreActions (cs ++ [a]), a)) as of
+         (sc',a):rs | sc' > sc -> loop (cs ++ [a]) sc' (map snd rs)
+         _                     -> cs
+
+      myFactories = filter (\f -> owner f == thisPlayer) (gsFactories gs)
+
+      transitMap = M.fromList
+         [ (to, (mine, theirs))
+         | let (myTroops, theirTroops) = partition (\t -> owner t == thisPlayer) (gsTroops gs)
+         , to <- map entityId (gsFactories gs)
+         , let mine   = sum [ cyborgs t | t <- myTroops,    target t == to ]
+         , let theirs = sum [ cyborgs t | t <- theirTroops, target t == to ]
+         ]
+      inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap
+
+      distributeScores src = do
+         dst <- myFactories
+         guard $ entityId dst /= entityId src
+         let (srcDefending, srcAttacking) = inTransitTo (entityId src)
+         let (dstDefending, dstAttacking) = inTransitTo (entityId dst)
+         let srcTotal = cyborgs src - srcAttacking
+         let dstTotal = cyborgs dst + dstDefending - dstAttacking
+         let amount = (cyborgs src + 1) `div` 3
+         guard $ amount > 0 && amount <= cyborgs src
+         dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs)
+         pure $ Move (entityId src) (entityId dst) amount
+
+      attackScores src = do
+         dst <- filter (\f -> owner f /= thisPlayer) (gsFactories gs)
+         dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs)
+         let (mineDefending, theirsAttacking) = inTransitTo (entityId src)
+         let (mineAttacking, theirsDefending) = inTransitTo (entityId dst)
+         let myTotal    = cyborgs src - theirsAttacking
+         let theirTotal = cyborgs dst + theirsDefending - mineAttacking
+         let theirEstimate
+               | owner dst == neutralPlayer = theirTotal
+               | otherwise = theirTotal + factoryProduction dst * (1 + dist)
+         let amount = theirEstimate + 1
+         guard $ amount > 0 && amount <= cyborgs src
+         pure $ Move (entityId src) (entityId dst) amount
+
+      increaseScores src = do
+         guard $ factoryProduction src < 3
+         guard $ cyborgs src >= 10
+         pure $ Increase (entityId src)
+
+      factoryActions src = foldr mplus mempty $ map ($ src) $
+         [ distributeScores, attackScores, increaseScores ]
+
+      allFactoryActions = concatMap factoryActions myFactories
+
+      bombActions = do
+         guard $ (gsBombsLeft gs) > 0 && not (null myFactories)
+         guard $ (gsBombsLeft gs) > 1 || (gsTurnCount gs) > 50
+         dst <- filter (\f -> owner f == opponent) (gsFactories gs)
+         --guard $ cyborgs dst >= 50 + 50 * (2 - (gsBombsLeft gs))
+         let src = snd $ minimumBy (compare `on` fst) $
+               [ (dist, s) | s <- myFactories
+               , dist <- toList $ M.lookup (entityId s, entityId dst) (gsLinks gs)
+               ]
+         pure $ SendBomb (entityId src) (entityId dst)
+
 best :: Ord a => Int -> [(a, b)] -> [(a, b)]
 best n = take n . sortBy (flip compare `on` fst)
 
@@ -212,31 +233,21 @@ scoreGame :: GameState -> Double
 scoreGame gs = (fromIntegral myCyborgs  + 10 * fromIntegral myProduction  + 10 * fromIntegral myFactories)
              / (fromIntegral oppCyborgs + 10 * fromIntegral oppProduction + 10 * fromIntegral oppFactories + 1)
    where
-      myFactories  = length $ filter (\f -> factoryOwner f == thisPlayer) (gsFactories gs)
+      myFactories  = length $ filter (\f -> owner f == thisPlayer) (gsFactories gs)
-      oppFactories = length $ filter (\f -> factoryOwner f == opponent) (gsFactories gs)
+      oppFactories = length $ filter (\f -> owner f == opponent) (gsFactories gs)
-      ((Sum myCyborgs, Sum myProduction),
+      ((Sum myCyborgs, Sum myProduction), (Sum oppCyborgs, Sum oppProduction)) = execWriter $ do
-       (Sum oppCyborgs, Sum oppProduction)) = execWriter $ do
          forM_ (gsFactories gs) $ \f -> do
-            when (factoryOwner f == thisPlayer) $
+            when (owner f == thisPlayer) $ tell ((Sum (cyborgs f), Sum (factoryProduction f)), mempty)
-               tell ((Sum (factoryCyborgs f), Sum (factoryProduction f)), mempty)
+            when (owner f == opponent)   $ tell (mempty, (Sum (cyborgs f), Sum (factoryProduction f)))
-            when (factoryOwner f == opponent) $
-               tell (mempty, (Sum (factoryCyborgs f), Sum (factoryProduction f)))
          forM_ (gsTroops gs) $ \t -> do
-            when (troopOwner t == thisPlayer) $
+            when (owner t == thisPlayer) $ tell ((Sum (cyborgs t), mempty), mempty)
-               tell ((Sum (troopCyborgs t), mempty), mempty)
+            when (owner t == opponent)   $ tell (mempty, (Sum (cyborgs t), mempty))
-            when (troopOwner t == opponent) $
-               tell (mempty, (Sum (troopCyborgs t), mempty))
 
 moveTroops, moveBombs, produceCyborgs,
    solveBattles, explodeBombs :: GameState -> GameState
 
-moveTroops gs0 = gs0 { gsTroops = map moveTroop (gsTroops gs0) }
+moveTroops gs0 = gs0 { gsTroops = map (\t -> t { troopTurnsLeft = turnsLeft t - 1 }) (gsTroops gs0) }
-   where
+moveBombs  gs0 = gs0 { gsBombs  = map (\b -> b { bombTurnsLeft  = turnsLeft b - 1 }) (gsBombs gs0)  }
-      moveTroop t = t { troopTurnsLeft = troopTurnsLeft t - 1 }
-
-moveBombs gs0 = gs0 { gsBombs = map moveBomb (gsBombs gs0) }
-   where
-      moveBomb b = b { bombDelay = bombDelay b - 1 }
 
 processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
 processOrders orders gs0 = foldl processOrder gs0 orders
@@ -248,77 +259,71 @@ processOrders orders gs0 = foldl processOrder gs0 orders
          Increase factory -> processIncrease p factory gs
          Wait             -> gs
       processMove p from to amt gs =
-         gs { gsFactories = map (\f -> if factoryId f /= from then f
+         gs { gsFactories = map (\f -> if entityId f /= from then f
-                                       else f { factoryCyborgs = max 0 (factoryCyborgs f - amt) })
+                                       else f { factoryCyborgs = max 0 (cyborgs f - amt) })
                                 (gsFactories gs)
             , gsTroops     = gsTroops gs ++
                [Troop { troopId        = gsNextEntity gs
                       , troopOwner     = p
                       , troopOrigin    = from
                       , troopTarget    = to
-                      , troopCyborgs   = min amt (sum $ map (\f -> if factoryId f == from then factoryCyborgs f else 0) (gsFactories gs))
+                      , troopCyborgs   = min amt (sum $ map (\f -> if entityId f == from then cyborgs f else 0) (gsFactories gs))
                       , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
                       }]
             , gsNextEntity = gsNextEntity gs + 1
             }
       processBomb p from to gs =
          gs { gsBombs = gsBombs gs ++
-               [Bomb { bombId = gsNextEntity gs
+               [Bomb { bombId        = gsNextEntity gs
-                     , bombSender = p
+                     , bombOwner     = p
-                     , bombOrigin = from
+                     , bombOrigin    = from
-                     , bombTarget = to
+                     , bombTarget    = to
-                     , bombDelay  = fromJust $ M.lookup (from, to) (gsLinks gs)
+                     , bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
                      }]
             , gsNextEntity = gsNextEntity gs + 1
             }
       processIncrease p factory gs =
-         gs { gsFactories = map (\f -> if factoryId f /= factory || factoryCyborgs f < 10 then f
+         gs { gsFactories = map (\f -> if entityId f /= factory || cyborgs f < 10 then f else
-                                       else f { factoryCyborgs    = factoryCyborgs f - 10
+                                          f { factoryCyborgs    = cyborgs f - 10
-                                              , factoryProduction = min 3 (factoryProduction f + 1)
+                                            , factoryProduction = min 3 (factoryProduction f + 1)
-                                              })
+                                            })
                                 (gsFactories gs)
             }
       checkBalances gs
-         | all (\f -> factoryCyborgs f >= 0) (gsFactories gs) = gs
+         | all (\f -> cyborgs f >= 0) (gsFactories gs) = gs
          | otherwise = error "Cyborg count is negative!"
 
 produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) }
    where
       produce f
          | factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 }
-         | otherwise = f { factoryCyborgs = factoryCyborgs f + factoryProduction f }
+         | otherwise = f { factoryCyborgs = cyborgs f + factoryProduction f }
 
 solveBattles gs =
    gs { gsFactories = map solveFactory (gsFactories gs)
       , gsTroops = troopsInTransit
       }
    where
-      (troopsArriving, troopsInTransit) = partition (\t -> troopTurnsLeft t <= 0) (gsTroops gs)
+      (troopsArriving, troopsInTransit) = partition (\t -> turnsLeft t <= 0) (gsTroops gs)
       solveFactory f
          | attacking > defending = f { factoryOwner = attackingPlayer
                                      , factoryCyborgs = attacking - defending
                                      }
          | otherwise = f { factoryCyborgs = defending - attacking }
          where
-            troopsArrivingHere = filter (\t -> troopTarget t == factoryId f) troopsArriving
+            troopsArrivingHere = filter (\t -> target t == entityId f) troopsArriving
-            defending = factoryCyborgs f + sum (map troopCyborgs $
+            defending = cyborgs f + sum [ cyborgs t | t <- troopsArrivingHere, owner t == owner f ]
-                                                filter (\t -> troopOwner t == factoryOwner f) $
+            attacking =             sum [ cyborgs t | t <- troopsArrivingHere, owner t /= owner f ]
-                                                troopsArrivingHere)
+            attackingPlayer = if owner f == opponent then thisPlayer else opponent
-            attacking = sum (map troopCyborgs $
-                             filter (\t -> troopOwner t /= factoryOwner f) $
-                             troopsArrivingHere)
-            attackingPlayer = if factoryOwner f == opponent
-                              then thisPlayer
-                              else opponent
 
 explodeBombs gs =
    gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
       , gsBombs     = bombsInTransit
       }
    where
-      (bombsArrived, bombsInTransit) = partition (\b -> bombDelay b <= 0) (gsBombs gs)
+      (bombsArrived, bombsInTransit) = partition (\b -> turnsLeft b <= 0) (gsBombs gs)
       explodeBomb fs b = flip map fs $ \f ->
-         if factoryId f /= bombTarget b then f else
+         if entityId f /= target b then f else
-         f { factoryCyborgs = max 0 (factoryCyborgs f - max 10 (factoryCyborgs f `div` 2))
+            f { factoryCyborgs = max 0 (cyborgs f - max 10 (cyborgs f `div` 2))
-           , factoryDelay   = 5
+              , factoryDelay   = 5
-           }
+              }