diff options
Diffstat (limited to 'src/World')
-rw-r--r-- | src/World/.Types.hs.swo | bin | 12288 -> 0 bytes | |||
-rw-r--r-- | src/World/Types.hs | 50 |
2 files changed, 38 insertions, 12 deletions
diff --git a/src/World/.Types.hs.swo b/src/World/.Types.hs.swo Binary files differdeleted file mode 100644 index 29646f7..0000000 --- a/src/World/.Types.hs.swo +++ /dev/null diff --git a/src/World/Types.hs b/src/World/Types.hs index f69bfa1..f5a410e 100644 --- a/src/World/Types.hs +++ b/src/World/Types.hs @@ -3,6 +3,7 @@ module World.Types , Compatible (..) , Pos , LatticeProposal (..) + , LatticePropList (..) , AgentProposal (..) , Proposal (..) ) where @@ -18,8 +19,6 @@ class Compatible a where instance (Merge a) => Merge (Maybe a) where mergable (Just x) (Just y) = mergable x y mergable _ _ = True - mergable (Just x) (Just y) = mergable x y - mergable _ _ = True merge (Just x) (Just y) = Just $ merge x y merge Nothing (Just y) = Just $ y merge (Just x) (Nothing) = Just $ x @@ -39,6 +38,8 @@ instance (Eq a) => MergeEq (Maybe a) where type Pos = (Int, Int) + +-- lattice proposals data LatticeProposal a b = LatticeProposal { cellPos :: Pos , from :: Maybe a @@ -46,16 +47,7 @@ data LatticeProposal a b = LatticeProposal , cellFlags :: Maybe b } deriving (Show, Eq) - -data AgentProposal a = AgentProposal - { id :: Int - , agentPos :: Pos - , agentFlags :: a - } - deriving (Show, Eq) - -newtype Proposal a b c = Proposal ([LatticeProposal a b], [AgentProposal c]) deriving (Show, Eq) - +newtype LatticePropList a b = LatticePropList [LatticeProposal a b] deriving (Show, Eq) instance (Eq a, Merge b) => Merge (LatticeProposal a b) where mergable x y = @@ -75,3 +67,37 @@ instance (Eq a, Merge b) => Merge (LatticeProposal a b) where instance (Eq a, Merge b) => Compatible (LatticeProposal a b) where compatible x y = (cellPos x /= cellPos y) || (mergable x y) + +instance (Eq a, Merge b) => Merge (LatticePropList a b) where + mergable _ _ = True + merge xs (LatticePropList ys) = + let + mergeAcross as b = foldl + (\(valid, LatticePropList list) x -> if valid + then + let + b' = head list + rest = tail list + in if mergable b' x + then (True, LatticePropList $ (merge b' x):rest) + else if compatible b' x then (True, LatticePropList $ b':x:rest) else (False, LatticePropList []) + else (False, LatticePropList list) + ) + (True, LatticePropList [b]) + as + in snd $ foldl (\(valid, LatticePropList list) x -> if valid then mergeAcross list x else (False, LatticePropList [])) (True, xs) ys + + + +-- agent proposals +data AgentProposal a = AgentProposal + { id :: Int + , agentPos :: Pos + , agentFlags :: a + } + deriving (Show, Eq) + +newtype Proposal a b c = Proposal ([LatticeProposal a b], [AgentProposal c]) deriving (Show, Eq) + + + |