Skip to content
Browse files

possibility of adding marks to filter the minimal glueings

  • Loading branch information...
1 parent 717217b commit c8d51f7bc25bfe5ce04ad97d22c1023dcb27db00 @rhz committed Jun 7, 2012
Showing with 135 additions and 125 deletions.
  1. +91 −98 KappaParser.hs
  2. +18 −19 Matching.hs
  3. +26 −8 MinimalGlueings.hs
View
189 KappaParser.hs
@@ -7,7 +7,8 @@ module KappaParser( SiteName, InternalState, BondLabel, BindingState(..), Site(.
, AExpr(..), Unop(..), Duop(..)
, Obs(..), Shape, ShapeName, Init, Expr, Var, VarName, Module(..), emptyModule
, agent, kexpr, rule, aexpr, moduleParser
- , simpleParse, parseAgent, parseKExpr, parseRule, parseModule, parseFromFile, parseKExprsFromFile
+ , fileParse, simpleParse, parseAgent, parseKExpr, parseRule, parseModule, parseFromFile
+ , kappaDef, parens, decimal, naturalOrFloat, comma, commaSep, commaSep1, semiSep1, symbol, reservedOp, reserved, identifier, whiteSpace
) where
import Prelude hiding (init)
@@ -17,7 +18,7 @@ import Data.List (delete)
import Text.Parsec
import Text.Parsec.Expr
-import Text.Parsec.Token
+import qualified Text.Parsec.Token as T
import Text.Parsec.Language
import Text.Parsec.Error
import Text.Parsec.Indent
@@ -52,52 +53,52 @@ data Rule = Rule Bool KExpr KExpr Rate
deriving (Show, Eq)
-- Language definition
-def = emptyDef{ commentStart = "{-"
- , commentEnd = "-}"
- , commentLine = "--"
- , nestedComments = True
- , identStart = letter
- , identLetter = alphaNum <|> oneOf "_'"
- , opStart = oneOf "=<-@+*/^"
- , opLetter = oneOf "=<->@+*/^"
- , reservedOpNames = ["=", "->", "<->", "@", "+", "-", "*", "/", "^"]
- , reservedNames = ["contact-map:", "init:", "obs:", "shape:", "shapes:", "rule:", "rules:", "...",
- "log", "exp", "mod", "sqrt", "sin", "cos", "tan", "int", "inf"]
- }
-
-TokenParser{ parens = m_parens
- , decimal = m_decimal
- , naturalOrFloat = m_naturalOrFloat
- , comma = m_comma
- , commaSep = m_commaSep
- , commaSep1 = m_commaSep1
- , semiSep1 = m_semiSep1 -- only used for parseKExprsFromFile
- , symbol = m_symbol
- , reservedOp = m_reservedOp
- , reserved = m_reserved
- , identifier = m_identifier
- , whiteSpace = m_whiteSpace } = makeTokenParser def
+kappaDef = emptyDef{ T.commentStart = "{-"
+ , T.commentEnd = "-}"
+ , T.commentLine = "--"
+ , T.nestedComments = True
+ , T.identStart = letter
+ , T.identLetter = alphaNum <|> oneOf "_'"
+ , T.opStart = oneOf "=<-@+*/^"
+ , T.opLetter = oneOf "=<->@+*/^"
+ , T.reservedOpNames = ["=", "->", "<->", "@", "+", "-", "*", "/", "^"]
+ , T.reservedNames = ["contact-map:", "init:", "obs:", "shape:", "shapes:", "rule:", "rules:", "...",
+ "log", "exp", "mod", "sqrt", "sin", "cos", "tan", "int", "inf"]
+ }
+
+T.TokenParser{ T.parens = parens
+ , T.decimal = decimal
+ , T.naturalOrFloat = naturalOrFloat
+ , T.comma = comma
+ , T.commaSep = commaSep
+ , T.commaSep1 = commaSep1
+ , T.semiSep1 = semiSep1
+ , T.symbol = symbol
+ , T.reservedOp = reservedOp
+ , T.reserved = reserved
+ , T.identifier = identifier
+ , T.whiteSpace = whiteSpace } = T.makeTokenParser kappaDef
-- Kappa parsers
agent :: Parser Agent
-agent = do name <- m_identifier <?> "agent"
- intf <- m_parens interface <?> "interface"
+agent = do name <- identifier <?> "agent"
+ intf <- parens interface <?> "interface"
return $ Agent name intf
interface :: Parser Interface
-interface = m_commaSep site
+interface = commaSep site
site :: Parser Site
-site = do siteName <- m_identifier <?> "site name"
- internalState <- (m_symbol "~" >> m_identifier) <|> return ""
- bindingState <- (m_symbol "!" >> (bondLabel <|> semiLink))
- <|> (m_symbol "?" >> return Unspecified)
+site = do siteName <- identifier <?> "site name"
+ internalState <- (symbol "~" >> identifier) <|> return ""
+ bindingState <- (symbol "!" >> (bondLabel <|> semiLink))
+ <|> (symbol "?" >> return Unspecified)
<|> return Free
return $! Site siteName internalState bindingState
- where bondLabel = do bondLabel <- m_decimal <?> "bond label"
+ where bondLabel = do bondLabel <- decimal <?> "bond label"
return $ Bound (fromIntegral bondLabel)
- semiLink = m_symbol "_" >> return SemiLink
+ semiLink = symbol "_" >> return SemiLink
createChain :: Agent -> Agent -> Agent -> KExpr
createChain first@(Agent fname fintf) second@(Agent sname sintf) last@(Agent lname lintf)
@@ -135,9 +136,9 @@ createChain first@(Agent fname fintf) second@(Agent sname sintf) last@(Agent lna
hasSameSites i1 i2 = map siteName i1 == map siteName i2
kexpr :: Parser KExpr
-kexpr = reverse . unpackChains [] [] <$> m_commaSep1 (liftM Right agent <|> liftM Left ellipsis) <?> "kappa expression"
+kexpr = reverse . unpackChains [] [] <$> commaSep1 (liftM Right agent <|> liftM Left ellipsis) <?> "kappa expression"
where
- ellipsis = m_reserved "..."
+ ellipsis = reserved "..."
unpackChains :: KExpr -> KExpr -> [Either () Agent] -> KExpr
unpackChains acc [b2,b1] [] = b1:b2:acc
@@ -148,10 +149,10 @@ kexpr = reverse . unpackChains [] [] <$> m_commaSep1 (liftM Right agent <|> lift
rule :: Parser Rule
rule = do lhs <- kexpr
- isReversible <- ((m_reservedOp "->" <?> "arrow") >> return False) <|>
- ((m_reservedOp "<->" <?> "bidirectional arrow") >> return True)
+ isReversible <- ((reservedOp "->" <?> "arrow") >> return False) <|>
+ ((reservedOp "<->" <?> "bidirectional arrow") >> return True)
rhs <- kexpr
- m_reservedOp "@"
+ reservedOp "@"
rate <- aexpr
return $ Rule isReversible lhs rhs rate
@@ -186,32 +187,32 @@ cmBindingStates (CMSite _ _ bss) = bss
-- CM parsers
cmAgent :: Parser CMAgent
-cmAgent = do name <- m_identifier <?> "agent signature"
- intf <- m_parens cmIntf <?> "signature interface"
+cmAgent = do name <- identifier <?> "agent signature"
+ intf <- parens cmIntf <?> "signature interface"
return $ CMAgent name intf
cmIntf :: Parser CMIntf
-cmIntf = m_commaSep cmSite
+cmIntf = commaSep cmSite
states :: Parser a -> String -> Parser [a]
-states stateParser s = (m_symbol s >> stateSet) <|> return []
- where stateSet = do m_symbol "{"
- xs <- m_commaSep1 stateParser
- m_symbol "}"
+states stateParser s = (symbol s >> stateSet) <|> return []
+ where stateSet = do symbol "{"
+ xs <- commaSep1 stateParser
+ symbol "}"
return xs
<|>
do x <- stateParser
return [x]
cmBindingState :: Parser CMBindingState
-cmBindingState = do agentName <- m_identifier
+cmBindingState = do agentName <- identifier
char '.'
- siteName <- m_identifier
+ siteName <- identifier
return $ CMBound agentName siteName
cmSite :: Parser CMSite
-cmSite = do siteName <- m_identifier <?> "site name"
- internalStates <- states m_identifier "~"
+cmSite = do siteName <- identifier <?> "site name"
+ internalStates <- states identifier "~"
bindingStates <- states cmBindingState "!"
return $ CMSite siteName internalStates bindingStates
@@ -227,31 +228,31 @@ data Duop = Add | Sub | Mult | Div | Mod | Pow
aexpr :: Parser AExpr
aexpr = buildExpressionParser table term <?> "algebraic expression"
-table = [ [Prefix (m_reserved "log" >> return (Uno Log)),
- Prefix (m_reserved "exp" >> return (Uno Exp)),
- Prefix (m_reserved "sin" >> return (Uno Sin)),
- Prefix (m_reserved "cos" >> return (Uno Cos)),
- Prefix (m_reserved "tan" >> return (Uno Tan)),
- Prefix (m_reserved "int" >> return (Uno Int)),
- Prefix (m_reserved "sqrt" >> return (Uno Sqrt))]
- , [Infix (m_reservedOp "^" >> return (Duo Pow)) AssocLeft]
- , [Infix (m_reservedOp "*" >> return (Duo Mult)) AssocLeft,
- Infix (m_reservedOp "/" >> return (Duo Div)) AssocLeft,
- Infix (m_reserved "mod" >> return (Duo Mod)) AssocLeft]
- , [Infix (m_reservedOp "+" >> return (Duo Add)) AssocLeft,
- Infix (m_reservedOp "-" >> return (Duo Sub)) AssocLeft]
+table = [ [Prefix (reserved "log" >> return (Uno Log)),
+ Prefix (reserved "exp" >> return (Uno Exp)),
+ Prefix (reserved "sin" >> return (Uno Sin)),
+ Prefix (reserved "cos" >> return (Uno Cos)),
+ Prefix (reserved "tan" >> return (Uno Tan)),
+ Prefix (reserved "int" >> return (Uno Int)),
+ Prefix (reserved "sqrt" >> return (Uno Sqrt))]
+ , [Infix (reservedOp "^" >> return (Duo Pow)) AssocLeft]
+ , [Infix (reservedOp "*" >> return (Duo Mult)) AssocLeft,
+ Infix (reservedOp "/" >> return (Duo Div)) AssocLeft,
+ Infix (reserved "mod" >> return (Duo Mod)) AssocLeft]
+ , [Infix (reservedOp "+" >> return (Duo Add)) AssocLeft,
+ Infix (reservedOp "-" >> return (Duo Sub)) AssocLeft]
]
numParser :: Parser (Either Int Double)
numParser = do s <- char '+' <|> char '-' <|> return '+'
- n <- m_naturalOrFloat
+ n <- naturalOrFloat
return $ toInt (s == '+') n
where toInt isPositive (Left x) = Left . fromInteger $ neg isPositive x
toInt isPositive (Right x) = Right $ neg isPositive x
neg isPositive x | isPositive = x
| otherwise = negate x
-term = m_parens aexpr <|> (m_reservedOp "inf" >> return Infinity) <|> fmap Var m_identifier <|>
+term = parens aexpr <|> (reservedOp "inf" >> return Infinity) <|> fmap Var identifier <|>
do n <- numParser
return $ case n of
Left n -> Integer n
@@ -289,26 +290,26 @@ emptyModule = Module{ contactMap = []
}
initP :: Parser Init
-initP = do m_reserved "init:"
- n <- m_decimal
- m_whiteSpace
+initP = do reserved "init:"
+ n <- decimal
+ whiteSpace
e <- kexpr
return (fromIntegral n, e)
obsP :: Parser Obs
-obsP = do m_reserved "obs:"
+obsP = do reserved "obs:"
getKExprWithName <|> getId
- where getId = m_identifier >>= return . Plot
+ where getId = identifier >>= return . Plot
getKExprWithName = do char '\''
name <- many $ noneOf "'"
char '\''
- m_whiteSpace
+ whiteSpace
ke <- kexpr
return $ KExprWithName name ke
varP :: Parser Var
-varP = do name <- m_identifier
- m_reservedOp "="
+varP = do name <- identifier
+ reservedOp "="
ke <- kexpr
if null ke
then do ae <- aexpr
@@ -317,31 +318,31 @@ varP = do name <- m_identifier
energyShape :: Parser Shape
energyShape = do expr <- kexpr
- m_reservedOp "@"
+ reservedOp "@"
energy <- aexpr
return (expr, energy)
shapeP :: Parser Shape
-shapeP = m_reserved "shape:" >> energyShape
+shapeP = reserved "shape:" >> energyShape
shapesP :: Parser [Shape]
-shapesP = m_reserved "shapes:" >> block energyShape
+shapesP = reserved "shapes:" >> block energyShape
ruleWithName :: Parser RuleWithName
-ruleWithName = do name <- try (m_identifier <* m_reservedOp "=") <|> return ""
+ruleWithName = do name <- try (identifier <* reservedOp "=") <|> return ""
r <- rule
return (name, r)
ruleP :: Parser RuleWithName
-ruleP = m_reserved "rule:" >> ruleWithName
+ruleP = reserved "rule:" >> ruleWithName
rulesP :: Parser [RuleWithName]
-rulesP = m_reserved "rules:" >> block ruleWithName
+rulesP = reserved "rules:" >> block ruleWithName
-- FIXME cmP should be indentation-aware
cmP :: Parser CM
-cmP = m_reserved "contact-map:" >> m_commaSep1 cmAgent
+cmP = reserved "contact-map:" >> commaSep1 cmAgent
data Decl = CMDecl CM
| ShapeDecl Shape
@@ -364,7 +365,7 @@ createModule decls = foldr (flip addDecl) emptyModule decls
addDecl m (VarDecl v) = m{ vars = v : vars m }
moduleParser :: Parser Module
-moduleParser = m_whiteSpace >> kfParser <* eof
+moduleParser = whiteSpace >> kfParser <* eof
where kfParser :: Parser Module
kfParser = do decls <- many declParser
return $ createModule decls
@@ -381,10 +382,13 @@ moduleParser = m_whiteSpace >> kfParser <* eof
-- Helper functions
+fileParse :: String -> Parser a -> String -> a
+fileParse filename p s = case runIndent filename $ runParserT p () filename s of
+ Left e -> error $ show e -- ParseError
+ Right result -> result
+
simpleParse :: Parser a -> String -> a
-simpleParse p s = case runIndent "" $ runParserT p () "" s of
- Left e -> error $ show e -- ParseError
- Right result -> result
+simpleParse = fileParse ""
parseAgent :: String -> Agent
parseAgent = simpleParse agent
@@ -398,17 +402,6 @@ parseRule = simpleParse rule
parseModule :: String -> Module
parseModule = simpleParse moduleParser
-
parseFromFile :: String -> IO Module
-parseFromFile filename = do s <- readFile filename
- case runIndent filename $ runParserT moduleParser () filename s of
- Left e -> error $ show e
- Right kappaModule -> return kappaModule
-
--- This function is only useful for MinimalGlueings.hs
-parseKExprsFromFile :: String -> IO [KExpr]
-parseKExprsFromFile filename = do s <- readFile filename
- case runIndent filename $ runParserT (m_semiSep1 kexpr) () filename s of
- Left e -> error $ show e
- Right kexprs -> return kexprs
+parseFromFile filename = readFile filename >>= return . fileParse filename moduleParser
View
37 Matching.hs
@@ -7,6 +7,7 @@ import Data.List (nub, partition, (\\))
import qualified Mixture as M
import qualified Env as E
+import qualified Types as T -- debug
import Utils
-- The idea here is to find all possible non-isomorphic superpositions of two or more kappa terms
@@ -144,12 +145,12 @@ type TodoMap = Map.Map (M.AgentId, M.AgentId) PendingLinks
-- Returns all possible pull-backs for the two mixtures
-- TODO how could I avoid using nub? why are there so many replicates? (ie, why are there so many ways to create the same intersection?)
-- is it because isomorphisms? if so, why are them all created in a syntacticly equivalent manner?
-intersections :: M.Mixture -> M.Mixture -> [(M.Mixture, (Matching, Matching))]
+intersections :: M.Mixture -> M.Mixture -> [(M.Mixture, Matching, Matching)]
intersections m1 m2 = nub $ do (agents, graph, m1Matching, m2Matching, _, _, _) <- pullbacks [([], Map.empty, [], [], 0, ids1, ids2)]
let m3 = M.Mixture { M.agents = Vec.fromList $ reverse agents
, M.graph = graph
}
- return (m3, (m1Matching, m2Matching))
+ return (m3, m1Matching, m2Matching)
where
ids1 = Set.fromList $ M.agentIds m1
ids2 = Set.fromList $ M.agentIds m2
@@ -223,41 +224,39 @@ type AgentMap = Map.Map M.AgentId M.AgentId
--data LinkInfo = T1 | T2 | T12 | None
data LinkInfo = T1 | T2 | None
--- TODO this should be :: [M.Mixture] -> [(M.Mixture, [AgentMap])]
-minimalGlueings :: M.Mixture -> M.Mixture -> [(M.Mixture, (AgentMap, AgentMap))]
+-- TODO this should be :: [M.Mixture] -> [(M.Mixture, [AgentMap], M.Mixture)]
+minimalGlueings :: M.Mixture -> M.Mixture -> [(M.Mixture, AgentMap, AgentMap, M.Mixture)]
minimalGlueings m1 m2 =
- do (m3 , (m1Matchings, m2Matchings)) <- intersections m1 m2
- (m3', (m1AgentMap , m2AgentMap )) <- refine m3 m1Matchings m2Matchings
- let (m3'' , m1AgentMap') = addAndExtend m1 (m3' , m1AgentMap)
- (m3''', m2AgentMap') = addAndExtend m2 (m3'', m2AgentMap)
- return (m3''', (m1AgentMap', m2AgentMap'))
+ do (m0, m1Matchings, m2Matchings) <- intersections m1 m2
+ (m3, m1AgentMap , m2AgentMap ) <- refine m0 m1Matchings m2Matchings
+ let (m3' , m1AgentMap') = addAndExtend m1 (m3 , m1AgentMap)
+ (m3'', m2AgentMap') = addAndExtend m2 (m3', m2AgentMap)
+ return (m0, m1AgentMap', m2AgentMap', m3'')
where
- refine :: M.Mixture -> Matching -> Matching -> [(M.Mixture, (AgentMap, AgentMap))]
- refine m3 m1Matchings m2Matchings = foldM refineAgent (m3, (m1AgentMap, m2AgentMap)) (M.agentIds m3)
+ refine :: M.Mixture -> Matching -> Matching -> [(M.Mixture, AgentMap, AgentMap)]
+ refine m0 m1Matchings m2Matchings = foldM refineAgent (m0, m1AgentMap, m2AgentMap) (M.agentIds m0)
where
m1AgentMap = Map.fromList m1Matchings
m2AgentMap = Map.fromList m2Matchings
bwdMap = Map.fromList [ (id3, (id1, id2)) | [(id1, id3), (id2, _)] <- groupWith snd (m1Matchings ++ m2Matchings) ]
- refineAgent :: (M.Mixture, (AgentMap, AgentMap)) -> M.AgentId -> [(M.Mixture, (AgentMap, AgentMap))]
+ refineAgent :: (M.Mixture, AgentMap, AgentMap) -> M.AgentId -> [(M.Mixture, AgentMap, AgentMap)]
refineAgent mg id3 = foldM refineSite' mg (M.siteIds a1) -- note that M.siteIds a1 == M.siteIds a2 == M.siteIds a3
where
(id1, id2) = bwdMap Map.! id3
a1 = M.agents m1 Vec.! id1
a2 = M.agents m2 Vec.! id2
- refineSite' :: (M.Mixture, (AgentMap, AgentMap)) -> M.SiteId -> [(M.Mixture, (AgentMap, AgentMap))]
- refineSite' (m3, (m1AgentMap, m2AgentMap)) sId =
+ refineSite' :: (M.Mixture, AgentMap, AgentMap) -> M.SiteId -> [(M.Mixture, AgentMap, AgentMap)]
+ refineSite' (m3, m1AgentMap, m2AgentMap) sId =
do s3' <- toList $ siteUnify s1 s2
let a3' = a3{ M.interface = M.interface a3 Vec.// [(sId, s3')] }
m3' = m3{ M.agents = M.agents m3 Vec.// [(id3, a3')] }
case linkInfo s1 s2 s3 of
- T1 -> let (m3'', m1AgentMap') = extend m1 [(id1, id3, sId)] (m3', m1AgentMap)
- in return (m3'', (m1AgentMap', m2AgentMap))
- T2 -> let (m3'', m2AgentMap') = extend m2 [(id2, id3, sId)] (m3', m2AgentMap)
- in return (m3'', (m1AgentMap, m2AgentMap'))
+ T1 -> let (m3'', m1AgentMap') = extend m1 [(id1, id3, sId)] (m3', m1AgentMap) in return (m3'', m1AgentMap', m2AgentMap)
+ T2 -> let (m3'', m2AgentMap') = extend m2 [(id2, id3, sId)] (m3', m2AgentMap) in return (m3'', m1AgentMap, m2AgentMap')
--T12 -> [] -- TODO is this the best way to handle the semilink creation when two sites are bound to different ends? probably I should not create the semilink in the first place
- None -> return (m3', (m1AgentMap, m2AgentMap))
+ None -> return (m3', m1AgentMap, m2AgentMap)
where
a3 = M.agents m3 Vec.! id3
s1 = M.interface a1 Vec.! sId
View
34 MinimalGlueings.hs
@@ -17,27 +17,45 @@ import System.FilePath (dropExtension)
main :: IO ()
main = do inputFilename : _ <- getArgs
- kexprs <- KP.parseKExprsFromFile inputFilename
- let cm = T.inferCM kexprs
+ fileContents <- readFile inputFilename
+ let (fileContents', marks, _, _) = foldr star ("", [], 0, 0) fileContents
+ kexprs = KP.fileParse inputFilename (KP.semiSep1 KP.kexpr) fileContents'
+ cm = T.inferCM kexprs
env = E.createEnv KP.emptyModule{ KP.contactMap = cm }
m1 : m2 : _ = map (M.evalKExpr env True) kexprs
m3s = minimalGlueings m1 m2
- cDot = condensedDot env m1 m2 m3s
- dDots = map (detailedDot env m1 m2) m3s
+ m3s' | null marks = m3s
+ | length marks == 2 = let [mark2, mark1] = marks in filter (inPullback mark1 mark2) m3s
+ | otherwise = error "MinimalGlueings.main: the numbers of marks (*) should be either zero or two"
+
+ cDot = condensedDot env m1 m2 m3s'
+ dDots = map (detailedDot env m1 m2) m3s'
basename = dropExtension inputFilename
outputFilenames = map makeOutFn [1..length dDots]
makeOutFn n = basename ++ "-" ++ show n ++ ".dot"
writeFile (basename ++ ".dot") cDot
zipWithM_ writeFile outputFilenames dDots
+ where
+ star :: Char -> (String, [Int], Int, Int) -> (String, [Int], Int, Int)
+ star '*' (s, marks, n, nesting) = (s, n:marks, n, nesting) -- skip the * and add the position to the marks
+ star c@',' (s, marks, n, 0) = (c:s, marks, n+1, 0) -- increment the counter
+ star c@',' (s, marks, n, nesting) = (c:s, marks, n, nesting)
+ star c@'(' (s, marks, n, nesting) = (c:s, marks, n, nesting+1) -- increment the nesting level
+ star c@')' (s, marks, n, nesting) = (c:s, marks, n, nesting-1) -- decrement the nesting level
+ star c@';' (s, marks, n, nesting) = (c:s, marks, 0, nesting) -- reset the mark counter
+ star c (s, marks, n, nesting) = (c:s, marks, n, nesting)
+
+ inPullback :: M.AgentId -> M.AgentId -> (M.Mixture, AgentMap, AgentMap, M.Mixture) -> Bool
+ inPullback mark1 mark2 (_, m1AgentMap, m2AgentMap, _) = m1AgentMap Map.! mark1 == m2AgentMap Map.! mark2
-- GraphViz
-condensedDot :: E.Env -> M.Mixture -> M.Mixture -> [(M.Mixture, (AgentMap, AgentMap))] -> String
+condensedDot :: E.Env -> M.Mixture -> M.Mixture -> [(M.Mixture, AgentMap, AgentMap, M.Mixture)] -> String
condensedDot env m1 m2 m3s =
"digraph {\n" ++
" overlap = \"prism\";\n" ++
@@ -46,13 +64,13 @@ condensedDot env m1 m2 m3s =
" m2 [ label = \"" ++ M.toKappa env m2 ++ "\" ];\n\n" ++
intercalate "\n" (zipWith m3Dot [3..] m3s) ++
"}\n"
- where m3Dot i (m3, (m1AgentMap, m2AgentMap)) =
+ where m3Dot i (_, m1AgentMap, m2AgentMap, m3) =
" m" ++ show i ++ " [ label = \"" ++ M.toKappa env m3 ++ "\" ];\n" ++
" m1 -> m" ++ show i ++ " [ label = \"" ++ show (Map.toList m1AgentMap) ++ "\", color = \"firebrick3\", fontcolor = \"firebrick3\" ];\n" ++
" m2 -> m" ++ show i ++ " [ label = \"" ++ show (Map.toList m2AgentMap) ++ "\", color = \"dodgerblue3\", fontcolor = \"dodgerblue3\" ];\n"
-detailedDot :: E.Env -> M.Mixture -> M.Mixture -> (M.Mixture, (AgentMap, AgentMap)) -> String
-detailedDot env m1 m2 (m3, (m1AgentMap, m2AgentMap)) =
+detailedDot :: E.Env -> M.Mixture -> M.Mixture -> (M.Mixture, AgentMap, AgentMap, M.Mixture) -> String
+detailedDot env m1 m2 (_, m1AgentMap, m2AgentMap, m3) =
"digraph {\n" ++
" overlap = \"scale\";\n" ++
" sep = \"1\";\n" ++

0 comments on commit c8d51f7

Please sign in to comment.
Something went wrong with that request. Please try again.