module AiVsAi.AIUtil where
import Prelude
import AiVsAi.GameData
import Control.Applicative
import AiVsAi.Util
import AiVsAi.UnitProperties
import Data.Map ((!), elems, keys, fromList, toList)
import Debug.Trace (trace)
import Data.Graph.Inductive.Query.BFS
import Data.Graph.Inductive.Graph
import Control.Applicative
import Data.Maybe (fromJust, mapMaybe )
import Data.Graph.Inductive.PatriciaTree
import Data.List (minimumBy)
import Control.Exception (assert)
endsWithGoal :: (Eq a) => a -> (Maybe [a]) -> Bool
endsWithGoal _goal Nothing = True
endsWithGoal goal (Just l) = goal == (last l)
aStarWithGoal :: TileID -> a -> GameState -> TileID -> Maybe [TileID]
aStarWithGoal goal _heuristic gs start = assert (endsWithGoal goal ret) $
ret
where
ret = maybeEmpty $ map (fromJust . lab graph) path
graph :: Gr TileID (TileID, TileID)
(graph, nodeNum) = mapGraph start gs
path :: [Node]
path =
esp (nodeNum start) (nodeNum goal) graph
validPath gs (Just (h:t)) = stepsNotEmpty t
where
stepsNotEmpty [] = True
stepsNotEmpty [end] = True
stepsNotEmpty (h : t) = (occupantAt h gs == Empty) && stepsNotEmpty t
validPath _gs _ = True
distanceToUnit :: GameState -> UnitID -> UnitID -> Maybe Int
distanceToUnit gs uid target = distanceToTile gs uid (getUnitPos gs target)
euclidDistanceToUnit :: GameState -> UnitID -> UnitID -> Maybe Double
euclidDistanceToUnit gs uid target = Just $ euclidDist (getUnitPos gs uid) (getUnitPos gs target)
distanceToTile :: GameState -> UnitID -> TileID -> Maybe Int
distanceToTile gs uid tid = case path of
Just l@(_:_) -> Just $ length l 1
_ -> Nothing
where
upos = getUnitPos gs uid
path = shortestPath gs upos tid
shortestPath :: GameState ->TileID -> TileID -> Maybe [TileID]
shortestPath gs start end =
--Precond
--Postcond
assert (validPath gs ret) $
ret
where ret = aStarWithGoal end (euclidDist end) gs start
nearestEnemy :: GameState -> UnitID -> Maybe UnitID
nearestEnemy gs uid = case (nearestEnemy' (unitTeam ustate) gs (pos ustate)) of
Nothing -> trace "No nearest enemy" $ Nothing
Just [] -> Nothing
Just l -> case (occupantAt (last l) gs ) of
TileUnit enem -> Just enem
_ -> error "Sanity check: found path to enemy that wasn't ending at enemy"
where ustate = (gameUnits gs) ! uid
hasUnit gs tile = case (occupantAt tile gs) of
TileUnit u -> True
_ -> False
getJust [] = []
getJust (Just a : t) = a : (getJust t)
getJust (Nothing: t) = getJust t
nearestEnemy' :: Team -> GameState -> TileID -> Maybe [TileID]
nearestEnemy' team gs start = assert (and $ map (hasUnit gs) posList) $
fmap (minimumBy lcomp) $ maybeEmpty $ mapMaybe paths posList
where
lcomp l1 l2
| n1 < n2 = LT
| n1 == n2 = EQ
| otherwise = GT
where (n1, n2) = (length l1, length l2)
uidIsEnemy uid = (getUnitTeam gs uid) /= team
heuristic a = 0
enemies = filter (uidIsEnemy) ((keys . gameUnits) gs)
posList = map (getUnitPos gs) enemies
paths end = aStarWithGoal end heuristic gs start
graphDistanceTo :: GameState -> TileID -> TileID -> Maybe Int
graphDistanceTo gs start end = length <$> (shortestPath gs start end)
tileIsEmpty gs tile = case occupantAt tile gs of
Empty -> True
_ -> False
mapGraph :: TileID -> GameState -> (Gr TileID (TileID, TileID), TileID -> Node)
mapGraph start gs = (graph, nodeNum)
where
graph ::Gr TileID (TileID, TileID)
graph = mkGraph nodes edges
numNodes = length $ (keys . gameTiles) gs
edgeDict = fromList $ zip ( (keys . gameTiles) gs) [1 .. numNodes ]
nodeNum tid = edgeDict ! tid
allNeighbours :: TileID -> [TileID]
allNeighbours (x,y) = [(x+1,y), (x1,y), (x+1,y1), (x,y1), (x1,y1), (x+1,y+1), (x,y+1), (x1,y+1) ]
tileInRange :: TileID -> Bool
tileInRange (x,y) = x > 0 && x <= (gameMapWidth gs) && y <= (gameMapHeight gs) && y > 0
edgesLeaving :: TileID -> [LEdge (TileID, TileID)]
edgesLeaving v = if (v == start) then map (toEdge v) $ filter tileInRange $ filter (tileIsEmpty gs) $ allNeighbours v
else
case (occupantAt v gs) of
Empty ->
map (toEdge v) $ filter tileInRange $ allNeighbours v
_ -> []
toEdge :: TileID -> TileID -> LEdge (TileID, TileID)
toEdge v x = (nodeNum v, nodeNum x, (v,x))
nodes :: [LNode TileID]
nodes = map (\(x,y) -> (y,x)) $ toList edgeDict
toNode:: TileID -> LNode TileID
toNode v = (nodeNum v, v)
edges :: [LEdge (TileID, TileID)]
edges = concat [edgesLeaving v | v <- keys edgeDict]