diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/World/Types.hs | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/src/World/Types.hs b/src/World/Types.hs index 32e4df6..cf66dd9 100644 --- a/src/World/Types.hs +++ b/src/World/Types.hs @@ -4,10 +4,14 @@ module World.Types , LatticeProposal (..) , LatticePropList (..) , AgentProposal (..) + , AgentPropList (..) , Proposal (..) ) where +import Data.Maybe + + class Combinable a where -- the "identity" element of the class is combinable with all others -- and (naturally) results in those others when combined @@ -64,10 +68,37 @@ instance (Combinable a, Combinable b) => Combinable (LatticePropList a b) where -- agent proposals data AgentProposal a = AgentProposal - { id :: Int - , agentPos :: Pos + { agentId :: Int + , agentPos :: Maybe Pos , agentFlags :: a } deriving (Show, Eq) +newtype AgentPropList a = AgentPropList [AgentProposal a] deriving (Show, Eq) + +instance (Combinable a) => Combinable (AgentPropList a) where + identity = AgentPropList [] + + combinable (AgentPropList xs) (AgentPropList ys) = + let + pairIsCombinable (x, y) = + if (agentId x) == (agentId y) + -- same agent + then if + combinable (agentPos x) (agentPos y) && + combinable (agentFlags x) (agentFlags y) + then True else False + -- different agents + else if + (isJust $ agentPos x) && + (isJust $ agentPos y) && + (fromJust $ agentPos x) == (fromJust $ agentPos y) + then False -- agents moving to the same location + else True -- c: + pairs = [ (x, y) | x <- xs, y <- ys ] + in + all pairIsCombinable pairs + + combine (AgentPropList xs) (AgentPropList ys) = AgentPropList $ xs ++ ys + newtype Proposal a b c = Proposal ([LatticeProposal a b], [AgentProposal c]) deriving (Show, Eq) |