-- -- | -- Module : CopPlan -- Authors : Sean Seefried (http://www.cse.unsw.edu.au/~sseefried) -- Copyright : (c) 2005 -- License : GPL version 2 or later -- Created : 27 Jun 2005 -- module CopPlan where import Data.List import Data.Maybe -- local imports import CR import Syntax import CopState import KnowledgeBase import Syntax import Graph import Utils import Logging ------------------------------------------------------------------------ -- -- Generate a plan for the other cops -- Also, we get some FromInforms, which we have to set for vote generation -- planMessage fi = do setOtherLocs fi kb <- getKB let foot = kb_footMap kb car = kb_carMap kb footsp = kb_footSPs kb carsp = kb_carSPs kb cops = kb_cops kb w = kb_worldCount kb -- current world robbed_raw = kb_robbedbanks kb robbed_bs = filter (\b -> (w - (fromJust (bank_lastTimeRobbed b))) < 6) robbed_raw info "plan1" nexts <- do if (not $ null robbed_bs) then do info "plan2a" let most_recent = bank_node . head $ sortBy mostRecentlyRobbed robbed_bs sequence [ do let g = if ty == ByFoot then foot else car sp = if ty == ByFoot then footsp else carsp path = map fst $ fastShortestPath here most_recent sp case path of -- take a random step [] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns [_] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns (_:b:_) -> return (simpleNode2node g b) | (Cop _ here ty dirty) <- cops ] -- else send mcgruffs each to a bank. else do info ("plan2b: " ++ show cops) s <- getState let locs = yourLocs s -- if null locs || True -- then do let bs = kb_bankNodes kb cbs = zip cops (take (length cops) bs) info $ show cbs sequence [ do let sp = if ty == ByFoot then footsp else carsp g = if ty == ByFoot then foot else car path = map fst $ fastShortestPath here bnode sp case path of -- take a random step [] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns [_] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns (_:b:_) -> return (simpleNode2node g b) | (Cop _ here ty dirty, bnode) <- cbs] {- then sequence [ do let ns = gsucc (if ty == ByFoot then foot else car) here liftIO $ stdGetRandItem ns | (Cop _ here ty) <- cops ] -} {- -- should go a bank. else sequence [ do let newest = fst . head $ sortBy (\(_,a) (_,b) -> a `compare` b) locs evidence = lookupNode newest kb g = if ty == ByFoot then foot else car sp = if ty == ByFoot then footsp else carsp path = map fst $ fastShortestPath here evidence sp case path of -- take a random step [] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns [_] -> do let ns = gsucc g here liftIO $ stdGetRandItem ns (_:b:_) -> return (simpleNode2node g b) | (Cop _ here ty) <- cops ] -} info "plan3" return $ PlanMsg [ Plan nm (locOfNode node) (cop2Player typ) ((kb_worldCount kb) + 1) | (node, (Cop nm _ typ dirty)) <- zip nexts cops ] where mostRecentlyRobbed (Bank { bank_lastTimeRobbed = b1 } ) (Bank { bank_lastTimeRobbed = b2 } ) = b1 `compare` b2 ------------------------------------------------------------------------ ------------------------------------------------------------------------ locTooOld = 10 -- number of time steps until a location reported by -- another players is considered too old minCert = 0 setOtherLocs :: FromInform -> CR () setOtherLocs (FromInform fromInforms) = do kb <- getKB copState <- getState let wc = kb_worldCount kb ownName = kb_ownName kb oldLocs = otherLocs copState filteredOldLocs = map (filterOutOld wc) oldLocs locPairs = [ (bot, (loc,w)) | (FromMsgI bot is) <- fromInforms , (Inform _ loc Robber w cert) <- is, cert > minCert ] otherCopNames = delete (kb_ownName kb) (kb_copNames kb) newLocs = foldr addLoc [ (name, []) | name <- otherCopNames ] locPairs filteredNewLocs = map (filterOutOld wc) newLocs let oldOwnLocs = yourLocs copState filteredOldOwnLocs = filter (\(_, w) -> abs (wc - w) < locTooOld) oldOwnLocs newOwnLocs <- getOwnLocs let totalLocs = foldr addToLocs filteredOldLocs filteredNewLocs let totalOwnLocs = newOwnLocs ++ filteredOldOwnLocs debug $ "New locs of other cops are: " ++ show filteredNewLocs debug $ "Your new locs are: " ++ show newOwnLocs debug $ "Total other locs are: " ++ show totalLocs debug $ "Total own locs are: " ++ show totalOwnLocs setState copState { otherLocs = totalLocs, yourLocs = totalOwnLocs } where filterOutOld :: WorldNum -> (Name, [(Location, WorldNum)]) -> (Name, [(Location, WorldNum)]) filterOutOld wc (name, locTimes) = (name, filter (\lt -> not (tooOld wc lt)) locTimes) tooOld wc (_,w) = abs (wc - w) > locTooOld -- -- Add robbing of banks, evidence and smells -- getOwnLocs :: CR [(Location, WorldNum)] getOwnLocs = do kb <- getKB let evs = kb_evidences kb wc = kb_worldCount kb evLocTimes <- do if null evs then do return [] else do let evLocTimes' = map mkEvPair (filter (\ev -> abs (wc - ev_world ev) < locTooOld) evs) return evLocTimes' let bs = kb_robbedbanks kb let bankFilter bank = case bank_lastTimeRobbed bank of Just t -> abs (wc - t) < locTooOld Nothing -> False bankLocTimes <- do if null bs then return [] else do let bsLocTimes = map mkBankPair (filter bankFilter bs) return bsLocTimes -- -- FIXME: What if you were a car cop? -- let graph = kb_footMap kb toLocTime node = (locOfNode node, wc) ownLocs = map snd (kb_ownLoc kb) smellLocTimes = case kb_smell kb of Just (Smell d) -> let nodes = concat (map (\nod -> nodesWithin graph nod d) ownLocs) in map toLocTime nodes Nothing -> [] return (evLocTimes ++ bankLocTimes ++ smellLocTimes) where mkEvPair ev = (locOfNode (ev_node ev), ev_world ev) mkBankPair bank = (locOfNode (bank_node bank) , fromJust (bank_lastTimeRobbed bank)) ---------------------------------------------------------------------- {- evidenceTooOld = 5 -- number of time steps until evidence too old -- -- Uses the inform messages to set the trust -- setTrust :: FromInform -> CR () setTrust (FromInform fromInforms) = do kb <- getKB copState <- getState -- -- Check for overlaps -- let wc = kb_worldCount kb graphFoot = kb_footMap kb let trustTriples = map trustFromOverlap [ (f1, f2) | f1 <- fromInforms, f2 <- fromInforms ] trustTable = copTrust copState oldOtherLoc = otherLoc copState trustTable2 = foldl updateTrust trustTable trustTriples -- -- If you've found evidence check that it overlaps with -- what others are saying -- let recentEvidences = filter notTooOld (kb_evidences kb) notTooOld ev = not (wc - ev_world ev >= evidenceTooOld) informEvidencePairs = [ (i,e) | i <- fromInforms, e <- recentEvidences ] evidenceAgrees (FromMsgI name informs, ev) | agreeWithCircle informs graphFoot (ev_node ev) (wc - ev_world ev) wc = Just name | otherwise = Nothing evidenceAgreers = map fromJust (filter isJust (map evidenceAgrees informEvidencePairs)) -- They all get one point of trust trustTable3 = foldl update trustTable2 (map (\n -> (n,1)) evidenceAgreers) let newLocs = [ (loc,w) | (FromMsgI bot is) <- fromInforms , (Inform _ loc Robber w cert) <- is, cert > 20 ] -- set cop state setState copState { copTrust = trustTable3 , otherLoc = newLocs ++ (filter (tooOld wc) oldOtherLoc) } where tooOld wc (_,w) = (wc - w) > 2 -- -- Checks whether an inform at least partially agrees with a circle -- you know about -- agreeWithCircle :: [Inform] -> Graph -> GNode -> Int -> WorldNum -> Bool agreeWithCircle informs graph node dist wc = let circle = map locOfNode (nodesWithin graph node dist) sameWc (Inform _ _ _ iwc _) = abs (iwc - wc) <= 2 getLoc (Inform _ loc _ _ _) = loc locationsAboutNow = map getLoc (filter sameWc informs) n = length $ circle `intersect` locationsAboutNow in n > 0 -- -- Trust is given out as follows -- < 1/3 overlap = 0 points -- 1/3 - 2/3 overlap = 1 points -- > 2/3 overlap = 2 points -- -- The function returns the names of the people of who to trust trustFromOverlap :: (FromMsgI,FromMsgI) -> (Name, Name, Trust) trustFromOverlap (FromMsgI name informs, FromMsgI name' informs') = let n = length (intersectBy sameInform informs informs') sz = max (length informs) (length informs') frac = fromIntegral n / fromIntegral sz trust = case () of _| frac < 1/3 -> 0 | frac < 2/3 -> 1 | otherwise -> 2 in (name, name', trust) where sameInform (Inform name loc ptype wnum _) (Inform name' loc' ptype' wnum' _) = name == name' && loc == loc' && ptype == ptype' && wnum == wnum' updateTrust :: [(Name, Trust)] -> (Name, Name, Trust) -> [(Name, Trust)] updateTrust trustTable (name, name', trust) = update (update trustTable (name, trust)) (name', trust) update :: Eq a => [(a,b)] -> (a,b) -> [(a,b)] update [] p = [p] update (p@(a,_):rest) p'@(a',_) | a == a' = p' : rest | otherwise = p : update rest p' -}