Ghost in the Cell -- final version.
This commit is contained in:
parent
0ab65cc688
commit
81231223fa
|
|
@ -2,7 +2,6 @@
|
|||
|
||||
module Main (main) where
|
||||
|
||||
import System.IO
|
||||
import Control.Applicative
|
||||
import Control.Arrow (first, second, (>>>))
|
||||
import Control.Monad
|
||||
|
|
@ -15,22 +14,26 @@ import Data.IORef
|
|||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import System.CPUTime
|
||||
import System.IO
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
type EntityId = Int
|
||||
type FactoryId = Int
|
||||
type FactoryId = EntityId
|
||||
type TroopId = EntityId
|
||||
type BombId = EntityId
|
||||
|
||||
data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show)
|
||||
|
||||
data Factory = Factory { factoryId :: EntityId
|
||||
data Factory = Factory { factoryId :: FactoryId
|
||||
, factoryOwner :: PlayerId
|
||||
, factoryCyborgs :: Int
|
||||
, factoryProduction :: Int
|
||||
, factoryTurnsLeft :: Int
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Troop = Troop { troopId :: EntityId
|
||||
data Troop = Troop { troopId :: TroopId
|
||||
, troopOwner :: PlayerId
|
||||
, troopOrigin :: FactoryId
|
||||
, troopTarget :: FactoryId
|
||||
|
|
@ -38,7 +41,7 @@ data Troop = Troop { troopId :: EntityId
|
|||
, troopTurnsLeft :: Int
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Bomb = Bomb { bombId :: EntityId
|
||||
data Bomb = Bomb { bombId :: BombId
|
||||
, bombOwner :: PlayerId
|
||||
, bombOrigin :: FactoryId
|
||||
, bombTarget :: FactoryId
|
||||
|
|
@ -53,133 +56,139 @@ data Action = Move FactoryId FactoryId Int
|
|||
|
||||
data GameState =
|
||||
GameState
|
||||
{ gsLinks :: M.Map (FactoryId, FactoryId) Int
|
||||
, gsFactories :: [Factory]
|
||||
, gsTroops :: [Troop]
|
||||
, gsBombs :: [Bomb]
|
||||
, gsBombsLeft :: M.Map PlayerId Int
|
||||
, gsNextEntity :: EntityId
|
||||
, gsTurnCount :: Int
|
||||
{ _gsLinks :: M.Map (FactoryId, FactoryId) Int
|
||||
, _gsFactories :: M.Map FactoryId Factory
|
||||
, _gsTroops :: M.Map TroopId Troop
|
||||
, _gsBombs :: M.Map BombId Bomb
|
||||
, _gsBombsLeft :: M.Map PlayerId Int
|
||||
, _gsNextEntity :: EntityId
|
||||
, _gsTurnCount :: Int
|
||||
} deriving (Show)
|
||||
|
||||
main :: IO ()
|
||||
--main = withFile "input.txt" ReadMode $ \input -> do
|
||||
main = do
|
||||
let input = stdin
|
||||
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
||||
|
||||
factoryCount <- readLn :: IO Int -- the number of factories (not used)
|
||||
linkCount <- readLn :: IO Int -- the number of links between factories
|
||||
factoryCount <- read <$> hGetLine input :: IO Int -- the number of factories (not used)
|
||||
linkCount <- read <$> hGetLine input :: IO Int -- the number of links between factories
|
||||
|
||||
links <- fmap (M.fromList . concat) $ replicateM linkCount $ do
|
||||
[f1, f2, dist] <- map read . words <$> getLine
|
||||
[f1, f2, dist] <- map read . words <$> hGetLine input
|
||||
pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)])
|
||||
|
||||
turnCountRef <- newIORef 1
|
||||
bombsLeftRef <- newIORef $ M.fromList [(ThisPlayer, 2), (Opponent, 2)]
|
||||
|
||||
forever $ do
|
||||
entityCount <- readLn :: IO Int
|
||||
entityCount <- read <$> hGetLine input :: IO Int
|
||||
startTime <- getCPUTime
|
||||
|
||||
(second partitionEithers . partitionEithers ->
|
||||
(factoryList, (troopList, bombList))) <- replicateM entityCount $ do
|
||||
((read -> eId):eType:(parsePlayerId . read -> a1)
|
||||
:(map read -> [a2,a3,a4,a5])) <- words <$> getLine
|
||||
:(map read -> [a2,a3,a4,a5])) <- words <$> hGetLine input
|
||||
pure $ case eType of
|
||||
"FACTORY" -> Left $ Factory eId a1 a2 a3 a4
|
||||
"TROOP" -> Right . Left $ Troop eId a1 a2 a3 a4 a5
|
||||
"BOMB" -> Right . Right $ Bomb eId a1 a2 a3 a4
|
||||
|
||||
let nextEntity = (+1) $ maximum $ 0 : map (view entityId) factoryList
|
||||
++ map (view entityId) troopList
|
||||
++ map (view entityId) bombList
|
||||
|
||||
turnCount <- readIORef turnCountRef
|
||||
bombsLeft <- readIORef bombsLeftRef
|
||||
|
||||
let gs = GameState { gsLinks = links
|
||||
, gsFactories = factoryList
|
||||
, gsTroops = troopList
|
||||
, gsBombs = bombList
|
||||
, gsNextEntity = nextEntity
|
||||
, gsTurnCount = turnCount
|
||||
, gsBombsLeft = bombsLeft
|
||||
let gs = GameState { _gsLinks = links
|
||||
, _gsFactories = M.fromList [ (f^.entityId, f) | f <- factoryList ]
|
||||
, _gsTroops = M.fromList [ (t^.entityId, t) | t <- troopList ]
|
||||
, _gsBombs = M.fromList [ (b^.entityId, b) | b <- bombList ]
|
||||
, _gsNextEntity = fromMaybe 0 . fmap (+1) . safeMaximumBy compare
|
||||
$ M.keys (gs^.gsFactories)
|
||||
++ M.keys (gs^.gsTroops)
|
||||
++ M.keys (gs^.gsBombs)
|
||||
, _gsTurnCount = turnCount
|
||||
, _gsBombsLeft = bombsLeft
|
||||
}
|
||||
|
||||
let oppActions = [] -- chooseActions (flipSides gs) []
|
||||
let chosenActions = chooseActions gs [(Opponent, oppActions)]
|
||||
let chosenActions = chooseActions gs [(Opponent, oppActions)] 15 22
|
||||
|
||||
case chosenActions of
|
||||
[] -> putStrLn $ actionString Wait
|
||||
xs -> putStrLn $ intercalate "; " $ map actionString xs
|
||||
|
||||
stopTime <- getCPUTime
|
||||
|
||||
hPutStrLn stderr . show . floor $ fromIntegral (stopTime - startTime) / 1e9
|
||||
|
||||
forM_ chosenActions $ \case
|
||||
SendBomb _ _ -> modifyIORef bombsLeftRef (M.update (Just . max 0 . subtract 1) ThisPlayer)
|
||||
SendBomb _ _ -> modifyIORef bombsLeftRef $
|
||||
atKey ThisPlayer . _Just %~ max 0 . subtract 1
|
||||
_ -> pure ()
|
||||
|
||||
modifyIORef turnCountRef (+1)
|
||||
|
||||
awareness, foresight :: Int
|
||||
awareness = 10 -- number of actions to consider
|
||||
foresight = 20 -- number of moves to look ahead (>10)
|
||||
|
||||
scoreGame :: GameState -> Double
|
||||
scoreGame gs = (playerScore ThisPlayer :: Double)
|
||||
/ (playerScore Opponent + 100)
|
||||
scoreGame gs = (playerScore ThisPlayer) - (1.25 * playerScore Opponent)
|
||||
where
|
||||
playerScore p = fromIntegral
|
||||
$ 1 * numCyborgs
|
||||
+ 15 * produced
|
||||
+ 50 * factories
|
||||
+ 60 * bombsLeft
|
||||
playerScore p = 1 * numCyborgs
|
||||
+ 50 * produced
|
||||
+ 25 * upgradable
|
||||
+ 10 * factories
|
||||
+ 50 * bombsLeft
|
||||
where
|
||||
numCyborgs = sum [ f^.cyborgs | f <- gsFactories gs, ownedBy p f ]
|
||||
+ sum [ (30 * t^.cyborgs) `div` (30 + t^.turnsLeft)
|
||||
| t <- gsTroops gs, ownedBy p t ]
|
||||
produced = sum [ f^.production | f <- gsFactories gs, ownedBy p f, f^.turnsLeft == 0 ]
|
||||
factories = count (ownedBy p) (gsFactories gs)
|
||||
bombsLeft = fromMaybe 0 $ M.lookup p (gsBombsLeft gs)
|
||||
numCyborgs = sum [ fromIntegral (f^.cyborgs) | f <- M.elems (gs^.gsFactories), ownedBy p f ]
|
||||
+ sum [ fromIntegral (t^.cyborgs) * (180.0 / (180.0 + fromIntegral (t^.turnsLeft))) | t <- M.elems (gs^.gsTroops), ownedBy p t ]
|
||||
produced = sum [ fromIntegral (f^.production) | f <- M.elems (gs^.gsFactories), ownedBy p f, f^.turnsLeft == 0 ]
|
||||
upgradable = fromIntegral . count (\f -> ownedBy p f && f^.production < 3 && f^.cyborgs >= 10) $ gs^.gsFactories
|
||||
factories = fromIntegral . count (ownedBy p) $ gs^.gsFactories
|
||||
bombsLeft = fromIntegral . fromMaybe 0 . M.lookup p $ gs^.gsBombsLeft
|
||||
|
||||
chooseActions :: GameState -> [(PlayerId, [Action])] -> [Action]
|
||||
chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFactoryActions ++ bombActions)
|
||||
chooseActions :: GameState -> [(PlayerId, [Action])] -> Int -> Int -> [Action]
|
||||
chooseActions gs acts awareness foresight =
|
||||
loop [] (scoreActions []) (allFactoryActions ++ bombActions)
|
||||
where
|
||||
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
|
||||
|
||||
scoreActions as = 3 * scoreGame (simulate (acts++[(ThisPlayer, as)]) 5 gs)
|
||||
+ 2 * scoreGame (simulate (acts++[(ThisPlayer, as)]) 10 gs)
|
||||
+ 1 * scoreGame (simulate (acts++[(ThisPlayer, as)]) foresight gs)
|
||||
scoreActions as = sum $
|
||||
zipWith (\n gs' -> (fromIntegral n)**(0.5) * scoreGame gs')
|
||||
[1..foresight]
|
||||
(simulate (acts ++ [(ThisPlayer, as)]) gs)
|
||||
|
||||
myFactories = filter (ownedBy ThisPlayer) (gsFactories gs)
|
||||
myFactories = M.filter (ownedBy ThisPlayer) (gs^.gsFactories)
|
||||
|
||||
transitMap = M.fromList $ do
|
||||
to <- map (view entityId) (gsFactories gs)
|
||||
let troops = filter ((== to) . view target) (gsTroops gs)
|
||||
let (myTroops, theirTroops) = partition (ownedBy ThisPlayer) troops
|
||||
let mine = sum $ map (view cyborgs) myTroops
|
||||
let theirs = sum $ map (view cyborgs) theirTroops
|
||||
pure (to, (mine, theirs))
|
||||
tgt <- M.keys (gs^.gsFactories)
|
||||
let (Sum mine, Sum theirs) = flip foldMap (gs^.gsTroops) $ \t ->
|
||||
if t^.target /= tgt then mempty else
|
||||
if t^.owner == ThisPlayer
|
||||
then (Sum (t^.cyborgs), mempty)
|
||||
else (mempty, Sum (t^.cyborgs))
|
||||
pure (tgt, (mine, theirs))
|
||||
inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap
|
||||
|
||||
distributeScores src = do
|
||||
dst <- myFactories
|
||||
guard $ src^.cyborgs > 0
|
||||
dst <- M.elems myFactories
|
||||
guard $ dst^.entityId /= src^.entityId
|
||||
let amount' = src^.cyborgs
|
||||
amount <- nub [amount', amount' `div` 3, src^.production]
|
||||
let supply = src^.cyborgs
|
||||
amount <- nub [supply, 2 * supply `div` 3, supply `div` 2, supply `div` 3, src^.production]
|
||||
guard $ amount > 0 && amount <= src^.cyborgs
|
||||
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
|
||||
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gs^.gsLinks)
|
||||
pure $ Move (src^.entityId) (dst^.entityId) amount
|
||||
|
||||
attackScores src = do
|
||||
dst <- filter (not . ownedBy ThisPlayer) (gsFactories gs)
|
||||
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
|
||||
let (mineDefending, theirsAttacking) = inTransitTo (src^.entityId)
|
||||
guard $ src^.cyborgs > 0
|
||||
dst <- M.elems $ gs^.gsFactories
|
||||
guard . not . ownedBy ThisPlayer $ dst
|
||||
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gs^.gsLinks)
|
||||
let (mineAttacking, theirsDefending) = inTransitTo (dst^.entityId)
|
||||
let myTotal = src^.cyborgs - theirsAttacking
|
||||
let theirTotal = dst^.cyborgs + theirsDefending - mineAttacking
|
||||
let theirEstimate
|
||||
| ownedBy Neutral dst = theirTotal
|
||||
| otherwise = theirTotal + dst^.production * (1 + dist)
|
||||
let amount' = theirEstimate + 1
|
||||
amount <- nub [2 * amount', amount', amount' `div` 2, src^.production]
|
||||
amount <- nub [src^.cyborgs, theirEstimate + 10, theirEstimate + 1, src^.production]
|
||||
guard $ amount > 0 && amount <= src^.cyborgs
|
||||
pure $ Move (src^.entityId) (dst^.entityId) amount
|
||||
|
||||
|
|
@ -193,22 +202,20 @@ chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFac
|
|||
, increaseScores
|
||||
]
|
||||
|
||||
allFactoryActions = concatMap factoryActions myFactories
|
||||
allFactoryActions = concatMap factoryActions (M.elems myFactories)
|
||||
|
||||
bombActions = do
|
||||
guard $ fromMaybe 0 (M.lookup ThisPlayer $ gsBombsLeft gs) > 0
|
||||
dst <- gsFactories gs
|
||||
src <- toList $ fmap snd $ safeMinimumBy (compare `on` fst) $ do
|
||||
src' <- myFactories
|
||||
guard $ src'^.entityId /= dst^.entityId
|
||||
dist <- toList $ M.lookup (src'^.entityId, dst^.entityId) (gsLinks gs)
|
||||
pure (dist, src')
|
||||
pure $ SendBomb (src^.entityId) (dst^.entityId)
|
||||
guard $ fromMaybe 0 (M.lookup ThisPlayer $ gs^.gsBombsLeft) > 0
|
||||
tgt <- M.keys $ gs^.gsFactories
|
||||
org <- toList . fmap snd . safeMinimumBy (compare `on` fst) $ do
|
||||
org' <- M.keys myFactories
|
||||
guard $ org' /= tgt
|
||||
dist <- toList . M.lookup (org', tgt) $ gs^.gsLinks
|
||||
pure (dist, org')
|
||||
pure $ SendBomb org tgt
|
||||
|
||||
simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState
|
||||
simulate orders n gs
|
||||
| n > 0 = simulate [] (n-1) (gameTurn orders gs)
|
||||
| otherwise = gs
|
||||
simulate :: [(PlayerId, [Action])] -> GameState -> [GameState]
|
||||
simulate orders gs = iterate (gameTurn []) (gameTurn orders gs)
|
||||
|
||||
gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState
|
||||
gameTurn orders = moveTroops
|
||||
|
|
@ -219,93 +226,96 @@ gameTurn orders = moveTroops
|
|||
>>> explodeBombs
|
||||
|
||||
moveTroops, moveBombs :: GameState -> GameState
|
||||
moveTroops gs0 = gs0 { gsTroops = map (over turnsLeft (subtract 1)) (gsTroops gs0) }
|
||||
moveBombs gs0 = gs0 { gsBombs = map (over turnsLeft (subtract 1)) (gsBombs gs0) }
|
||||
moveTroops = gsTroops . traverse . turnsLeft %~ subtract 1
|
||||
moveBombs = gsBombs . traverse . turnsLeft %~ subtract 1
|
||||
|
||||
processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
|
||||
processOrders orders gs0 = foldl processOrder gs0 orders
|
||||
processOrders = flip (foldl processOrder)
|
||||
where
|
||||
processOrder gs (p, as) = foldl (processAction p) gs as
|
||||
processAction p gs = \case
|
||||
Move from to amt -> processMove p from to amt gs
|
||||
SendBomb from to -> processBomb p from to gs
|
||||
Move org tgt amt -> processMove p org tgt amt gs
|
||||
SendBomb org tgt -> processBomb p org tgt gs
|
||||
Increase factory -> processIncrease p factory gs
|
||||
Wait -> gs
|
||||
processMove p from to amt gs
|
||||
| f:_ <- filter ((== from) . view entityId) (gsFactories gs)
|
||||
processMove p org tgt amt gs
|
||||
| Just f <- M.lookup org (gs^.gsFactories)
|
||||
, ownedBy p f
|
||||
, adjAmt <- min (f^.cyborgs) amt
|
||||
= gs { gsFactories = map (\f -> if f^.entityId /= from then f else
|
||||
over cyborgs (subtract adjAmt) f)
|
||||
(gsFactories gs)
|
||||
, gsTroops = gsTroops gs ++
|
||||
[Troop { troopId = gsNextEntity gs
|
||||
, adjAmt > 0
|
||||
, Just dist <- M.lookup (org, tgt) (gs^.gsLinks)
|
||||
= gs & gsFactories . atKey org . _Just . cyborgs %~ subtract adjAmt
|
||||
& gsTroops %~ M.insert (gs^.gsNextEntity)
|
||||
(Troop { troopId = gs^.gsNextEntity
|
||||
, troopOwner = p
|
||||
, troopOrigin = from
|
||||
, troopTarget = to
|
||||
, troopOrigin = org
|
||||
, troopTarget = tgt
|
||||
, troopCyborgs = adjAmt
|
||||
, troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
||||
}]
|
||||
, gsNextEntity = gsNextEntity gs + 1
|
||||
}
|
||||
, troopTurnsLeft = dist
|
||||
})
|
||||
& gsNextEntity %~ (+1)
|
||||
| otherwise = gs
|
||||
processBomb p from to gs
|
||||
| fromMaybe 0 (M.lookup p (gsBombsLeft gs)) > 0
|
||||
= gs { gsBombs = gsBombs gs ++
|
||||
[Bomb { bombId = gsNextEntity gs
|
||||
| fromMaybe 0 (M.lookup p (gs^.gsBombsLeft)) > 0
|
||||
, Just dist <- M.lookup (from, to) (gs^.gsLinks)
|
||||
= gs & gsBombs %~ M.insert (gs^.gsNextEntity)
|
||||
(Bomb { bombId = gs^.gsNextEntity
|
||||
, bombOwner = p
|
||||
, bombOrigin = from
|
||||
, bombTarget = to
|
||||
, bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
||||
}]
|
||||
, gsBombsLeft = M.update (Just . subtract 1) p $ gsBombsLeft gs
|
||||
, gsNextEntity = gsNextEntity gs + 1
|
||||
}
|
||||
, bombTurnsLeft = dist
|
||||
})
|
||||
& gsBombsLeft . atKey p . _Just %~ subtract 1
|
||||
& gsNextEntity %~ (+1)
|
||||
| otherwise = gs
|
||||
processIncrease p factory gs
|
||||
| Just True <- (\f -> f^.cyborgs >= 10 && f^.owner == p)
|
||||
<$> M.lookup factory (gs^.gsFactories)
|
||||
= gs & gsFactories . atKey factory . _Just %~ over cyborgs (subtract 10)
|
||||
. over production (min 3 . (+1))
|
||||
| otherwise = gs
|
||||
processIncrease p factory gs =
|
||||
gs { gsFactories = map (\f -> if f^.entityId /= factory || f^.cyborgs < 10 then f else
|
||||
f & over cyborgs (subtract 10)
|
||||
& over production (min 3 . (+1)))
|
||||
(gsFactories gs)
|
||||
}
|
||||
|
||||
|
||||
produceCyborgs :: GameState -> GameState
|
||||
produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) }
|
||||
produceCyborgs = gsFactories . traverse %~ produce
|
||||
where
|
||||
produce f
|
||||
| f^.turnsLeft > 0 = over turnsLeft (subtract 1) f
|
||||
| otherwise = over cyborgs (+ f^.production) f
|
||||
| f^.turnsLeft > 0 = f & turnsLeft %~ subtract 1
|
||||
| f^.owner == Neutral = f
|
||||
| otherwise = f & cyborgs %~ (+ f^.production)
|
||||
|
||||
solveBattles :: GameState -> GameState
|
||||
solveBattles gs =
|
||||
gs { gsFactories = map solveFactory (gsFactories gs)
|
||||
, gsTroops = troopsInTransit
|
||||
}
|
||||
gs & gsFactories %~ flip (foldl' (flip (M.adjust solveFactory))) factoriesWithArrivals
|
||||
& gsTroops .~ troopsInTransit
|
||||
where
|
||||
(troopsArriving, troopsInTransit) = partition ((<= 0) . view turnsLeft) (gsTroops gs)
|
||||
(troopsArriving, troopsInTransit) = M.partition ((<= 0) . view turnsLeft) (gs^.gsTroops)
|
||||
factoriesWithArrivals = nub $ foldMap ((:[]) . view target) troopsArriving
|
||||
solveFactory f
|
||||
| attacking > defending = f & set owner attackingPlayer
|
||||
& set cyborgs (attacking - defending)
|
||||
| otherwise = f & set cyborgs (defending - attacking)
|
||||
| attacking > defending = f & owner .~ attackingPlayer
|
||||
& cyborgs .~ attacking - defending
|
||||
| otherwise = f & cyborgs .~ defending - attacking
|
||||
where
|
||||
troopsArrivingHere = filter (\t -> t^.target == f^.entityId) troopsArriving
|
||||
(defendingHere, attackingHere) = partition (ownedBy (f^.owner)) troopsArrivingHere
|
||||
defending = sum (map (view cyborgs) defendingHere) + f^.cyborgs
|
||||
attacking = sum (map (view cyborgs) attackingHere)
|
||||
attackingPlayer = otherPlayer (f^.owner)
|
||||
(Sum defending, Sum mineAttacking, Sum theirsAttacking)
|
||||
= mappend (Sum (f^.cyborgs), mempty, mempty)
|
||||
. flip foldMap troopsArriving $ \t -> case () of
|
||||
_ | t^.target /= f^.entityId -> mempty
|
||||
| t^.owner == f^.owner -> (Sum (t^.cyborgs), mempty, mempty)
|
||||
| t^.owner == ThisPlayer -> (mempty, Sum (t^.cyborgs), mempty)
|
||||
| otherwise -> (mempty, mempty, Sum (t^.cyborgs))
|
||||
attackingPlayer
|
||||
| mineAttacking > theirsAttacking = ThisPlayer
|
||||
| otherwise = Opponent
|
||||
attacking = abs (mineAttacking - theirsAttacking)
|
||||
|
||||
explodeBombs :: GameState -> GameState
|
||||
explodeBombs gs =
|
||||
gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
|
||||
, gsBombs = bombsInTransit
|
||||
}
|
||||
gs & gsFactories %~ flip (M.foldl' explodeBomb) bombsArrived
|
||||
& gsBombs .~ bombsInTransit
|
||||
where
|
||||
(bombsArrived, bombsInTransit) = partition (\b -> b^.turnsLeft <= 0) (gsBombs gs)
|
||||
explodeBomb fs b = flip map fs $ \f ->
|
||||
if f^.entityId /= b^.target then f else
|
||||
f & set cyborgs (max 0 (f^.cyborgs - max 10 (f^.cyborgs `div` 2)))
|
||||
& set turnsLeft 5
|
||||
(bombsArrived, bombsInTransit) = M.partition (\b -> b^.turnsLeft <= 0) (gs^.gsBombs)
|
||||
explodeBomb fs b = ($ fs) . flip M.adjust (b^.target) $ \f ->
|
||||
f & cyborgs %~ max 0 . subtract (max 10 (f^.cyborgs `div` 2))
|
||||
& turnsLeft .~ 5
|
||||
|
||||
safeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
|
||||
safeMinimumBy _ [] = Nothing
|
||||
|
|
@ -315,29 +325,44 @@ safeMaximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
|
|||
safeMaximumBy _ [] = Nothing
|
||||
safeMaximumBy cmp xs = Just (maximumBy cmp xs)
|
||||
|
||||
count :: (a -> Bool) -> [a] -> Int
|
||||
count p = length . filter p
|
||||
count :: Foldable f => (a -> Bool) -> f a -> Int
|
||||
count p = getSum . foldMap (\x -> if p x then Sum 1 else mempty)
|
||||
|
||||
best :: Ord a => Int -> [(a, b)] -> [(a, b)]
|
||||
best n = take n . sortBy (flip compare `on` fst)
|
||||
|
||||
type Getting r s a = (a -> Const r a) -> s -> Const r s
|
||||
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
|
||||
type Lens' s a = Lens s s a a
|
||||
type Getting r s a = (a -> Const r a) -> s -> Const r s
|
||||
type Setter s t a b = (a -> Identity b) -> s -> Identity t
|
||||
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
|
||||
type Lens' s a = Lens s s a a
|
||||
|
||||
view :: Getting a s a -> s -> a
|
||||
view g = getConst . g Const
|
||||
|
||||
over :: Lens s t a b -> (a -> b) -> s -> t
|
||||
over :: Setter s t a b -> (a -> b) -> s -> t
|
||||
over l f = runIdentity . l (Identity . f)
|
||||
|
||||
set :: Lens s t a b -> b -> s -> t
|
||||
set :: Setter s t a b -> b -> s -> t
|
||||
set l = over l . const
|
||||
|
||||
(^.) :: s -> Getting a s a -> a
|
||||
(^.) = flip view
|
||||
infixl 8 ^.
|
||||
|
||||
(.~) :: Setter s t a b -> b -> s -> t
|
||||
(.~) = set
|
||||
infixr 4 .~
|
||||
|
||||
(%~) :: Setter s t a b -> (a -> b) -> s -> t
|
||||
(%~) = over
|
||||
infixr 4 %~
|
||||
|
||||
to :: (s -> a) -> Getting a s a
|
||||
to f g = Const . getConst . g . f
|
||||
|
||||
atKey :: Ord k => k -> Lens' (M.Map k a) (Maybe a)
|
||||
atKey k f s = (\b -> M.alter (const b) k s) <$> f (M.lookup k s)
|
||||
|
||||
class HasEntityId a where entityId :: Lens' a EntityId
|
||||
instance HasEntityId Factory where entityId f s = (\b -> s { factoryId = b }) <$> f (factoryId s)
|
||||
instance HasEntityId Troop where entityId f s = (\b -> s { troopId = b }) <$> f (troopId s)
|
||||
|
|
@ -364,13 +389,33 @@ instance HasTurnsLeft Bomb where turnsLeft f s = (\b -> s { bombTurnsLeft
|
|||
production :: Lens' Factory Int
|
||||
production f s = (\b -> s { factoryProduction = b }) <$> f (factoryProduction s)
|
||||
|
||||
gsLinks :: Lens' GameState (M.Map (FactoryId, FactoryId) Int)
|
||||
gsFactories :: Lens' GameState (M.Map FactoryId Factory)
|
||||
gsTroops :: Lens' GameState (M.Map TroopId Troop)
|
||||
gsBombs :: Lens' GameState (M.Map BombId Bomb)
|
||||
gsBombsLeft :: Lens' GameState (M.Map PlayerId Int)
|
||||
gsNextEntity :: Lens' GameState EntityId
|
||||
gsTurnCount :: Lens' GameState Int
|
||||
|
||||
gsLinks f s = (\b -> s { _gsLinks = b }) <$> f (_gsLinks s)
|
||||
gsFactories f s = (\b -> s { _gsFactories = b }) <$> f (_gsFactories s)
|
||||
gsTroops f s = (\b -> s { _gsTroops = b }) <$> f (_gsTroops s)
|
||||
gsBombs f s = (\b -> s { _gsBombs = b }) <$> f (_gsBombs s)
|
||||
gsBombsLeft f s = (\b -> s { _gsBombsLeft = b }) <$> f (_gsBombsLeft s)
|
||||
gsNextEntity f s = (\b -> s { _gsNextEntity = b }) <$> f (_gsNextEntity s)
|
||||
gsTurnCount f s = (\b -> s { _gsTurnCount = b }) <$> f (_gsTurnCount s)
|
||||
|
||||
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
|
||||
type Traversal' s a = Traversal s s a a
|
||||
|
||||
_Just :: Traversal (Maybe a) (Maybe b) a b
|
||||
_Just = maybe (pure Nothing) . (fmap Just .)
|
||||
|
||||
flipSides :: GameState -> GameState
|
||||
flipSides gs =
|
||||
gs { gsFactories = map flipOwner (gsFactories gs)
|
||||
, gsTroops = map flipOwner (gsTroops gs)
|
||||
, gsBombs = map flipOwner (gsBombs gs)
|
||||
, gsBombsLeft = M.mapKeys otherPlayer (gsBombsLeft gs)
|
||||
}
|
||||
flipSides = gsFactories . traverse %~ flipOwner
|
||||
>>> gsTroops . traverse %~ flipOwner
|
||||
>>> gsBombs . traverse %~ flipOwner
|
||||
>>> gsBombsLeft %~ M.mapKeys otherPlayer
|
||||
where
|
||||
flipOwner :: HasOwner a => a -> a
|
||||
flipOwner = over owner otherPlayer
|
||||
|
|
|
|||
Loading…
Reference in New Issue