-- -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons -- Sean Seefried -- Stefan Wehr -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) -- module KnowledgeBase where import Monad ( msum ) import List ( nub, find, delete, elemIndex ) import Data.Maybe import qualified Data.Map as M import Graph import Syntax import Logging data KnowledgeBase = KnowledgeBase { kb_static :: KnowledgeBaseStatic , kb_dynamic :: Maybe KnowledgeBaseDynamic } deriving (Show) data KnowledgeBaseStatic = KnowledgeBaseStatic { kbs_ownName :: Name , kbs_robberName :: Name , kbs_copNames :: [Name] , kbs_footMap :: Graph , kbs_carMap :: Graph , kbs_loc2node :: GNodeMap , kbs_robberStart :: GNode , kbs_hq :: GNode , kbs_bankNodes :: [GNode] , kbs_footSPs :: SPMap , kbs_carSPs :: SPMap } deriving (Show) data KnowledgeBaseDynamic = KnowledgeBaseDynamic { kbd_ownLoc :: [(Name, GNode)] , kbd_worldCount :: WorldNum , kbd_banks :: [Bank] , kbd_cops :: [Cop] , kbd_robber :: Maybe GNode , kbd_robberLoot :: Loot , kbd_evidences :: [KBEvidence] , kbd_smell :: Maybe Smell , kbd_falseAccuses :: [FAccuse] } deriving (Show,Eq) instance NM KnowledgeBaseStatic where lookupNode loc kb = lookupNode loc (kbs_loc2node kb) instance NM KnowledgeBase where lookupNode loc kb = lookupNode loc (kb_static kb) kb_ownName = kbs_ownName . kb_static kb_robberName = kbs_robberName . kb_static kb_copNames = kbs_copNames . kb_static kb_footMap = kbs_footMap . kb_static kb_carMap = kbs_carMap . kb_static kb_loc2node = kbs_loc2node . kb_static kb_robberStart = kbs_robberStart . kb_static kb_hq = kbs_hq . kb_static kb_bankNodes = kbs_bankNodes . kb_static kb_footSPs = kbs_footSPs . kb_static kb_carSPs = kbs_carSPs . kb_static kb_ownLoc = kbd_ownLoc . dynKB kb_worldCount = kbd_worldCount . dynKB kb_banks = kbd_banks . dynKB kb_cops = kbd_cops . dynKB kb_robber = kbd_robber . dynKB kb_robberLoot = kbd_robberLoot . dynKB kb_evidences = kbd_evidences . dynKB kb_smell = kbd_smell . dynKB kb_falseAccuses = kbd_falseAccuses . dynKB dynKB :: KnowledgeBase -> KnowledgeBaseDynamic dynKB (KnowledgeBase _ (Just dynkb)) = dynkb dynKB _ = niceError ("dynamic part of KB not yet initialized") data Bank = Bank { bank_node :: GNode , bank_money :: Money , bank_lastTimeRobbed :: Maybe WorldNum } deriving (Show,Eq) kb_robbedbanks kb = filter (\b -> bank_lastTimeRobbed b /= Nothing) (kb_banks kb) data MaybeDirtyFlag = DirtyForSure | MaybeDirty | NotDirtyForSure deriving (Show,Eq) data Cop = Cop { cop_name :: Name , cop_node :: GNode , cop_type :: CopType , cop_dirty :: MaybeDirtyFlag } deriving (Show,Eq) findCop :: Name -> [Cop] -> Maybe Cop findCop _ [] = Nothing findCop n (c:cs) | cop_name c == n = Just c | otherwise = findCop n cs copIndex :: Name -> [Cop] -> Int copIndex name cops = case findCop name cops of Nothing -> niceError ("cannot find " ++ show name ++ " in the list of cops") Just c -> case elemIndex c cops of Nothing -> niceError ("should never happen") Just i -> i data CopType = ByFoot | ByCar deriving (Show,Eq) cop2Player :: CopType -> PlayerType cop2Player ByFoot = CopFoot cop2Player ByCar = CopCar data MyPlayer = MyRobber | MyCop Cop deriving (Show,Eq) whoami :: KnowledgeBase -> MyPlayer whoami kb = let n = kb_ownName kb in if kb_robberName kb == n then MyRobber else case findCop n (kb_cops kb) of Nothing -> niceError ("no such player: " ++ n) Just c -> MyCop c data KBEvidence = KBEvidence { ev_node :: GNode , ev_world :: WorldNum } deriving (Show,Eq) data KBConfig = KBConfig { wc_ignoreCarStreets :: Bool } deriving (Show,Eq) kbRobberCfg = KBConfig False kbCopCfg = KBConfig False -- building the static part of the KB mkInitialKnowledge :: WorldSkeleton -> KBConfig -> KnowledgeBase mkInitialKnowledge (WorldSkeleton ownName rname cnames nodes edges) wc = -- first build a node map let gnodemap = M.fromList (map mkassoc (zip [1..] nodes)) -- now build a list of graph nodes gnodes = M.elems gnodemap -- and a list of edges (footEdges, carEdges) = let (l1, l2) = unzip $ map (mkEdge gnodemap) edges in (nub $ concat l1, nub $ concat l2) -- now build a graph footGraph = mkGraph gnodes footEdges carGraph = if wc_ignoreCarStreets wc then gempty else mkGraph gnodes carEdges -- now compute all shortest paths for footGraph and carGraph footSPs = allShortestPaths footGraph carSPs = allShortestPaths carGraph -- find hq, banks, robber-start (hq, banks, robberStart) = case findSpecialNodes gnodemap nodes (Nothing,[],Nothing) of (Just hq, banks, Just robberStart) -> (hq, banks, robberStart) _ -> niceError ("world-skeleton doesn't contain headquarter " ++ "or robber-start") in footSPs `seq` carSPs `seq` KnowledgeBase { kb_static = KnowledgeBaseStatic { kbs_ownName = ownName , kbs_robberName = rname , kbs_copNames = cnames , kbs_footMap = footGraph , kbs_carMap = carGraph , kbs_loc2node = gnodemap , kbs_robberStart = robberStart , kbs_hq = hq , kbs_bankNodes = banks , kbs_footSPs = footSPs , kbs_carSPs = carSPs } , kb_dynamic = Nothing } where mkassoc :: (Int,Node) -> (Location,GNode) mkassoc (i,Node l _ _) = (l, (i,l)) mkEdge :: GNodeMap -> Edge -> ([GEdge], -- foot edges [GEdge]) -- car edges mkEdge m (Edge l1 l2 typ) = let (n1,_) = lookupNode l1 m (n2,_) = lookupNode l2 m in case () of _| typ == Foot -> ([(n1,n2,gedgeLabel), (n2,n1,gedgeLabel)], [(n1,n2,gedgeLabel)]) | typ == Car -> ([], [(n1,n2,gedgeLabel)]) findSpecialNodes :: GNodeMap -> [Node] -> (Maybe GNode, [GNode], Maybe GNode) -> (Maybe GNode, [GNode], Maybe GNode) findSpecialNodes m [] acc = acc findSpecialNodes m (Node loc HqTag _ : rest) (_, banks, rstart) = case M.lookup loc m of Just gn -> findSpecialNodes m rest (Just gn, banks, rstart) Nothing -> niceError ("lookup failed for " ++ show loc) findSpecialNodes m (Node loc BankTag _ : rest) (hq, banks, rstart) = case M.lookup loc m of Just gn -> findSpecialNodes m rest (hq, gn:banks, rstart) Nothing -> niceError ("lookup failed for " ++ show loc) findSpecialNodes m (Node loc RobberStartTag _ : rest) (hq, banks, _) = case M.lookup loc m of Just gn -> findSpecialNodes m rest (hq, banks, Just gn) Nothing -> niceError ("lookup failed for " ++ show loc) findSpecialNodes m (_:rest) acc = findSpecialNodes m rest acc -- updates the dynamic part of the knowledge base according to the given -- world message and the location of the player updateKnowledge :: KnowledgeBase -> World -> KnowledgeBase updateKnowledge kb@(KnowledgeBase _ (Just dynkb)) (World num loot mdcs controlled faccuses bvs evs smell pls) = let banks = map updateBank (kbd_banks dynkb) cops = map updateCop (kbd_cops dynkb) robber = updateRobber (kbd_robber dynkb) evidences = map updateEvidence evs dynkb' = dynkb { kbd_ownLoc = findOwnNodes kb controlled pls , kbd_worldCount = num , kbd_banks = banks , kbd_cops = cops , kbd_robber = robber , kbd_robberLoot = loot , kbd_evidences = evidences , kbd_smell = smell , kbd_falseAccuses = faccuses } in kb { kb_dynamic = Just dynkb' } where updateBank b = case findBankValue (locOfNode . bank_node $ b) bvs of Nothing -> b Just (BankValue _ m) -- it's not possible to find out the correct value for -- bank_lastTimeRobbed, so we use a little heuristics here: -- if the new money is zero but the old money not, then -- the bank was robbed in the last step | m == 0 && bank_money b /= 0 -> b { bank_money = m, bank_lastTimeRobbed = Just $ num - 1 } | otherwise -> b { bank_money = m } updateCop c = let dirtyFlag n = computeDirtyFlag (kb_ownName kb) n mdcs controlled in case findPlayer (cop_name c) pls of Nothing -> niceError ("cop " ++ show (cop_name c) ++ " no longer present?!!?") Just (Player n loc CopFoot) -> c { cop_node = lookupNode loc kb , cop_type = ByFoot , cop_dirty = dirtyFlag n } Just (Player n loc CopCar) -> c { cop_node = lookupNode loc kb , cop_type = ByCar , cop_dirty = dirtyFlag n } Just (Player _ _ Robber) -> niceError ("player " ++ show (cop_name c) ++ " was a cop and is now a robber?!!?") updateRobber r = case findRobber pls of Nothing -> Nothing Just (Player _ loc _) -> Just (lookupNode loc kb) updateEvidence (Evidence loc n) = KBEvidence (lookupNode loc kb) n updateKnowledge kb (World num loot mdcs controlled faccuses bvs evs smell pls) = let banks = map mkBank bvs cops = catMaybes (map mkCop pls) robber = msum (map mkRobber pls) evidences = map mkEvidence evs dynkb = KnowledgeBaseDynamic { kbd_ownLoc = findOwnNodes kb controlled pls , kbd_worldCount = num , kbd_banks = banks , kbd_cops = cops , kbd_robber = robber , kbd_robberLoot = loot , kbd_evidences = evidences , kbd_smell = smell , kbd_falseAccuses = faccuses } in kb { kb_dynamic = Just dynkb } where mkBank (BankValue loc money) = Bank (lookupNode loc kb) money Nothing mkCop (Player _ _ Robber) = Nothing mkCop (Player name loc typ) = let dirtyFlag = computeDirtyFlag (kb_ownName kb) name mdcs controlled typ' = case typ of CopFoot -> ByFoot CopCar -> ByCar in Just $ Cop name (lookupNode loc kb) typ' dirtyFlag mkRobber (Player name loc Robber) = Just $ lookupNode loc kb mkRobber _ = Nothing mkEvidence (Evidence loc n) = KBEvidence (lookupNode loc kb) n findOwnNodes :: KnowledgeBase -> [(Name, Name)] -> Players -> [(Name, GNode)] findOwnNodes kb controlled pls = let name = kb_ownName kb in mapMaybe process ((name, name) : controlled) where process (master, slave) | master == kb_ownName kb = case findPlayer slave pls of Just (Player _ loc _) -> Just $ (slave, lookupNode loc kb) Nothing -> niceError ("Own player not in players list, ownName=" ++ show (kb_ownName kb) ++ ", playersList=" ++ show pls) | otherwise = Nothing computeDirtyFlag :: Name -> Name -> (Maybe [Name]) -> [(Name, Name)] -> MaybeDirtyFlag computeDirtyFlag ownName copName mdcs controlled = case mdcs of Nothing -> -- we are clean if controlledBy ownName copName then NotDirtyForSure else MaybeDirty Just ns -> -- we are dirty if copName `elem` ns then DirtyForSure else NotDirtyForSure where controlledBy n1 n2 = (n1,n2) `elem` controlled -- `robberMove kb s t' makes a robber move from s to t robberMove :: KnowledgeBase -> GNode -> GNode -> KnowledgeBase robberMove kb src tgt = let gr = kb_footMap kb wc = kb_worldCount kb + 1 banks = bankTransfer $ map robBank (kb_banks kb) evs = filter (not . removeEvidence) (kb_evidences kb) ++ placeEvidence smell = updateSmell ownLoc = updateOwnLoc newRobberLoot = kb_robberLoot kb + sum (map lootFromBank (kb_banks kb)) dynkb = (dynKB kb) { kbd_ownLoc = ownLoc , kbd_worldCount = wc , kbd_banks = banks , kbd_robber = Just tgt , kbd_evidences = evs , kbd_smell = smell , kbd_robberLoot = newRobberLoot } in case () of _| odd (kb_worldCount kb) -> niceError ("making robber move from odd numbered world") | not (tgt `elem` (gsucc gr src) || tgt == src) -> niceError ("cannot make robber move because target " ++ show tgt ++ " is not reachable from source " ++ show src) | otherwise -> kb { kb_dynamic = Just dynkb } where robBank :: Bank -> Bank robBank b = if bank_node b == tgt then b { bank_money = 0, bank_lastTimeRobbed = Just $ kb_worldCount kb } else b lootFromBank :: Bank -> Int lootFromBank b = if bank_node b == tgt then bank_money b else 0 bankTransfer :: [Bank] -> [Bank] bankTransfer bs = case find (\b -> bank_lastTimeRobbed b == Just (kb_worldCount kb - 8)) bs of Nothing -> bs Just b -> let restBs = delete b bs l = map (\b -> let mon = bank_money b contrib = mon `div` 6 in (b { bank_money = mon-contrib }, contrib)) restBs (restBs', ms) = unzip l in (b { bank_money = sum ms } ) : restBs' placeEvidence :: [KBEvidence] placeEvidence | kb_worldCount kb `mod` 8 == 0 = [KBEvidence src (kb_worldCount kb)] | otherwise = [] removeEvidence :: KBEvidence -> Bool removeEvidence ev = ev_world ev == (kb_worldCount kb - 24) updateSmell :: Maybe Smell updateSmell = case whoami kb of MyCop c -> canSmell kb c tgt MyRobber -> kb_smell kb -- useless for robber, using old value updateOwnLoc :: [(Name, GNode)] updateOwnLoc = case whoami kb of MyCop _ -> kb_ownLoc kb MyRobber -> [(kb_ownName kb, tgt)] copMove :: KnowledgeBase -> [GNode] -> KnowledgeBase copMove kb tgts = let cs = kb_cops kb cs' = if length cs == length tgts then map (\ (c,n) -> c { cop_node = n } ) (zip cs tgts) else niceError ("invalid number of targets for copMove: " ++ "there are " ++ show (length cs) ++ " cops, but " ++ show (length tgts) ++ " targets") dynkb = (dynKB kb) { kbd_cops = cs', kbd_worldCount = kb_worldCount kb + 1} in kb { kb_dynamic = Just dynkb } -- `canSmell kb c n' returns the smell for cop c and the robber at node n canSmell :: KnowledgeBase -> Cop -> GNode -> Maybe Smell canSmell kb c n | cop_type c == ByCar = if n `elem` (gsucc (kb_carMap kb) (cop_node c)) then Just (Smell 1) else Nothing canSmell kb c n | otherwise = let gr = kb_footMap kb succs1 = gsucc gr (cop_node c) succs2 = concatMap (gsucc gr) succs1 in if n `elem` succs1 then Just (Smell 1) else if n `elem` succs2 then Just (Smell 2) else Nothing -- get the places a cop could possibly go to. copSuccs :: KnowledgeBase -> Cop -> [GNode] copSuccs kb c | cop_type c == ByCar = let g = kb_carMap kb in gsucc g (cop_node c) copSuccs kb c | cop_type c == ByFoot = let g = kb_footMap kb in gsucc g (cop_node c)