diff --git a/Game/Spacegoo.hs b/Game/Spacegoo.hs
--- a/Game/Spacegoo.hs
+++ b/Game/Spacegoo.hs
@@ -9,6 +9,8 @@
module Game.Spacegoo (
-- * The state
+ PlayerId(..),
+ Round(..),
Units(..),
Coord(..),
Player(..),
@@ -20,6 +22,19 @@
Strategy(..),
-- * Writing clients
client,
+ -- * Utilities
+ -- Convenience functions for working with the state
+ me,
+ he,
+ opponentName,
+ battle,
+ winsAgainst,
+ distance,
+ hasMore,
+ ownerAt,
+ linInt,
+ nemesisOf,
+ minimizeUnits,
-- * Example strategies
-- These are some simple strategies, for demonstration purposes.
nop,
@@ -28,6 +43,8 @@
intercept,
) where
+import Data.List (sortBy)
+import Data.Ord
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as T
@@ -56,7 +73,7 @@
data Player = Player
{ itsme :: Bool
- , playerId :: Int
+ , playerId :: PlayerId
, name :: Text
}
deriving Show
@@ -67,13 +84,21 @@
<*> v .: "id"
<*> v .: "name"
+-- | The player (0,1 or 2)
+type PlayerId = Int
+
+-- | A Round count
+type Round = Int
+
-- | A position on the map
type Coord = (Int, Int)
-- | Units, either on a planet, on a fleet, or as a production indication.
type Units = (Int, Int, Int)
+type FUnits = (Double, Double, Double)
+
fleetFromVector :: Monad m => V.Vector Int -> m Units
fleetFromVector v | V.length v /= 3 = fail "Wrong number of elements in array"
| otherwise = return (v V.! 0, v V.! 1, v V.! 2)
@@ -81,7 +106,7 @@
data Fleet = Fleet
{ fleetId :: Int
- , fleetOwner :: Int
+ , fleetOwner :: PlayerId
, origin :: Int
, target :: Int
, fleetShips :: Units
@@ -101,7 +126,7 @@
data Planet = Planet
{ planetId :: Int
, position :: Coord
- , planetOwner :: Int
+ , planetOwner :: PlayerId
, production :: Units
, planetShips :: Units
}
@@ -117,8 +142,8 @@
data State = State
{ gameOver :: Bool
- , round :: Int
- , maxRounds :: Int
+ , currentRound :: Round
+ , maxRounds :: Round
, players :: [Player]
, fleets :: [Fleet]
, planets :: [Planet]
@@ -159,6 +184,7 @@
$= C.decode C.utf8
$= C.lines
$= C.encode C.utf8
+ $= disconnect
$= parseState
-- not $= logState
$= C.iterM (putStrLn . stateSummary)
@@ -171,13 +197,19 @@
=$= C.iterM (F.mapM_ putStrLn . moveSummary)
=$= C.map serializeMove
-nopClient = client 6000 "spacegoo.rent-a-geek.de" "foo" "bar" (const Nothing)
-
logState :: Conduit State IO State
logState = awaitForever $ \s -> do
liftIO $ putStrLn (render (ppDoc s))
yield s
+disconnect :: Conduit ByteString IO ByteString
+disconnect = do
+ v <- await
+ F.forM_ v $ \s ->
+ unless (s == "game is over. please disconnect") $ do
+ yield s
+ disconnect
+
parseState :: Conduit ByteString IO State
parseState = do
awaitForever $ \line ->
@@ -196,13 +228,13 @@
stateSummary :: State -> String
stateSummary State{..} =
- printf "[Round %3d/%3d]" round maxRounds
+ printf "[Round %3d/%3d]" currentRound maxRounds
++ " We: " ++ statsFor me ++ " He: " ++ statsFor he ++ " Neutral: " ++ statsFor 0
where
Just me = playerId <$> find itsme players
he = 3 - me
statsFor i = printf "%2dp" (length ps) ++
- printf " %5dp" (sum (map (unitSum . planetShips) ps) +
+ printf " %5ds" (sum (map (unitSum . planetShips) ps) +
sum (map (unitSum . fleetShips) fs)) ++
(if i == 0 then "" else printf " %2df" (length fs))
where ps = filter (\p -> planetOwner p == i) planets
@@ -227,7 +259,7 @@
sendSomewhere (State {..}) = do
me <- playerId <$> find itsme players
let he = 3 - me
- aPlanet <- find (\p -> planetOwner p == me) planets
+ aPlanet <- find (\p -> planetOwner p == me && planetShips p /= (0,0,0)) planets
otherPlanet <- find (\p -> planetOwner p == he) planets
return (planetId aPlanet, planetId otherPlanet, planetShips aPlanet)
@@ -255,17 +287,105 @@
msum $ flip map planets $ \p -> do
guard $ planetOwner p == me
guard $ planetShips p `hasMore` fleetShips f
- guard $ round + distance p t - eta f `elem` [0,1,2]
+ guard $ currentRound + distance p t - eta f `elem` [1,2]
return $ (planetId p, planetId t, fleetShips f)
+-- | Whether the first player has at least as many ships as the other
hasMore :: Units -> Units -> Bool
hasMore (a,b,c) (a',b',c') = a >= a && b >= b' && c >= c'
-
+
float2 :: (Int, Int) -> (Double, Double)
float2 (a,b) = (fromIntegral a, fromIntegral b)
-float3 :: (Int, Int, Int) -> (Double, Double, Double)
-float3 (a,b,c) = (fromIntegral a, fromIntegral b, fromIntegral c)
+map3 :: (a->b) -> (a,a,a) -> (b,b,b)
+map3 f (a,b,c) = (f a, f b, f c)
+float3 :: Units -> FUnits
+float3 = map3 fromIntegral
+
+floor3 :: FUnits -> Units
+floor3 = map3 floor
+
+nonneg3:: FUnits -> FUnits
+nonneg3 = map3 (max 0)
+
distance :: Planet -> Planet -> Int
distance p1 p2 = ceiling (magnitude (float2 (position p1 ^-^ position p2)))
+
+linInt :: Double -> Units -> Units -> Units
+linInt f u1 u2 = floor3 (lerp (float3 u1) (float3 u2) f)
+
+-- | My id
+me :: State -> Int
+me s = fromJust $ playerId <$> find itsme (players s)
+
+-- | The other players id
+he :: State -> Int
+he s = 3 - me s
+
+-- | The opponent's name; to filter out known bad opponents
+opponentName :: State -> Text
+opponentName s = fromJust $
+ name <$> find (not . itsme) (players s)
+
+damage :: FUnits -> FUnits
+damage (a,b,c) = ( 0.25 * c + (if c > 0 then 2 else 0)
+ + 0.1 * a + (if a > 0 then 1 else 0)
+ + 0.01 * b + (if b > 0 then 1 else 0)
+ , 0.25 * a + (if a > 0 then 2 else 0)
+ + 0.1 * b + (if b > 0 then 1 else 0)
+ + 0.01 * c + (if c > 0 then 1 else 0)
+ , 0.25 * b + (if b > 0 then 2 else 0)
+ + 0.1 * c + (if c > 0 then 1 else 0)
+ + 0.01 * a + (if a > 0 then 1 else 0)
+ )
+
+oneRound :: FUnits -> FUnits -> FUnits
+oneRound att def = nonneg3 $ def ^-^ damage att
+
+-- | Whether the first argument wins against the second, and how many ships are
+-- left
+battle :: Units -> Units -> (Bool, Units)
+battle att def = go (float3 att) (float3 def)
+ where go a d | magnitude a <= 1e-5 = (False, floor3 d)
+ | magnitude d <= 1e-5 = (True, floor3 a)
+ | otherwise = go (oneRound d a) (oneRound a d)
+
+-- | Whether the first fleet wins against the second (defaulting to the second)
+winsAgainst :: Units -> Units -> Bool
+winsAgainst att def = fst (battle att def)
+
+
+-- | Predict the owner and strength of the planet at the given round
+ownerAt :: State -> Int -> Round -> (PlayerId, Units)
+ownerAt s i round = go (currentRound s, planetOwner p, planetShips p) $
+ sortBy (comparing eta) $
+ filter (\f -> target f == i) $
+ filter (\f -> eta f <= round) $
+ fleets s
+ where
+ go (r, o, ships) [] = (o, produce o ships (round - r))
+ go (r, o, ships) (f:fs)
+ | fleetOwner f == o
+ = go (eta f, o, produce o ships (eta f - r) ^+^ fleetShips f) fs
+ | fleetOwner f /= o
+ = case battle (fleetShips f) (produce o ships (eta f - r)) of
+ (True, rest) -> go (eta f, fleetOwner f, rest) fs
+ (False, rest) -> go (eta f, o, rest) fs
+ Just p = find (\p -> planetId p == i) (planets s)
+ produce 0 ships _ = ships
+ produce _ ships n = ships ^+^ n *^ production p
+
+nemesisOf :: Units -> Units
+nemesisOf (a,b,c) = (b,c,a)
+
+
+-- If the attacker wins against the defender, try to find a subset that also wins.
+minimizeUnits :: Units -> Units -> Units
+minimizeUnits a d = go a a
+ where
+ go last a = case battle a d of
+ (True, r) -> let r' = map3 (`div` 3) (a ^-^ r)
+ in if r' /= (0,0,0) then go a (a ^-^ r') else a
+ (False, _) -> last
+
diff --git a/haskell-spacegoo.cabal b/haskell-spacegoo.cabal
--- a/haskell-spacegoo.cabal
+++ b/haskell-spacegoo.cabal
@@ -1,9 +1,9 @@
name: haskell-spacegoo
-version: 0.1
+version: 0.2
synopsis: Client API for Rocket Scissor Spacegoo
description: Using this package you can quickly create code to take
part in a game of Rocket Scissor Spacegoo; see
- for more details on the
+ for more details on the
game.
license: MIT
license-file: LICENSE
@@ -18,7 +18,7 @@
exposed-modules:
Game.Spacegoo
build-depends:
- base ==4.6.*
+ base == 4.*
, vector
, pretty
, pretty-show