summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorsanine <sanine.not@pm.me>2023-12-04 11:44:09 -0600
committersanine <sanine.not@pm.me>2023-12-04 11:44:09 -0600
commit1a3814b5ead29e1bbfb2ccfa56b2b2bb76c71994 (patch)
tree96faad29f08a8869f31d9aa9ce8286ec2bd813a2 /src
parent135ce23bd188c9351c8e9dde783a713b72dff8f3 (diff)
implement Combinable for AgentPropList
Diffstat (limited to 'src')
-rw-r--r--src/World/Types.hs35
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)