Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

uploading scripts for Seba

  • Loading branch information...
commit 473b046e37f74548afe2aaac83095b47321a802b 1 parent 89a001c
@rhz authored
View
57 Graphviz.hs
@@ -0,0 +1,57 @@
+module Main where
+
+import qualified KappaParser as KP
+import qualified Types as T
+import qualified Mixture as M
+import qualified Env as E
+import Utils
+
+import qualified Data.Vector as Vec
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.List (nub)
+import Control.Monad (zipWithM_)
+import System.Environment (getArgs)
+import System.FilePath (dropExtension)
+
+
+toDot :: E.Env -> M.Mixture -> String
+toDot env mix =
+ "graph {\n" ++
+ " overlap = \"scale\";\n" ++
+ " sep = \"1\";\n" ++
+ " node [ shape = \"circle\" ];\n\n" ++
+ concatMap nodeDot (M.agentsWithId mix) ++
+ concatMap linkDot links ++
+ "}\n"
+ where nodes = Vec.imap nodeName $ M.agents mix
+ nodeName i agent = agentName agent ++ show i
+ nodeDot (i, agent) = " " ++ nodeName i agent ++ " [ label = \"" ++ agentName agent ++ "\" ];\n"
+
+ links = Set.toList $ M.links mix
+ linkDot ((aId1, sId1), (aId2, sId2)) =
+ " " ++ (nodes Vec.! aId1) ++
+ " -- " ++ (nodes Vec.! aId2) ++
+ " [ headlabel = \"" ++ siteName aId1 sId1 ++ "\"" ++
+ " , taillabel = \"" ++ siteName aId2 sId2 ++ "\" ];\n"
+
+ agentName agent = E.agentOfId env (M.agentName agent) ? "Matching.detailedDot: missing agent name id"
+ siteName aId sId = E.siteOfId env (M.agentName (M.agents mix Vec.! aId), sId) ? "Matching.detailedDot: missing site id"
+
+main :: IO ()
+main = do inputFilename : _ <- getArgs
+ m <- KP.parseFromFile inputFilename
+ let kexprs = map snd $ KP.inits m
+ cm = T.inferCM kexprs
+ env = E.createEnv KP.emptyModule{ KP.contactMap = cm }
+ mixs = map (M.evalKExpr env False) kexprs
+ dots = map (toDot env) mixs
+
+ basename = dropExtension inputFilename
+ outputFilenames = map makeOutFn [1..length dots]
+ makeOutFn n = basename ++ "-" ++ show n ++ ".dot"
+
+ zipWithM_ writeFile outputFilenames dots
+
+
+
View
71 Histogram.hs
@@ -0,0 +1,71 @@
+module Main where
+
+import qualified KappaParser as KP
+import qualified Types as T
+import qualified Mixture as M
+import qualified Env as E
+import Utils
+
+import qualified Data.Vector as Vec
+import qualified Data.Map as Map
+import Data.List (intercalate)
+import Control.Monad (zipWithM_)
+import System.Environment (getArgs)
+import System.FilePath (dropExtension)
+
+type Depth = Int
+type Histogram = Map.Map Depth Int
+
+histogram :: E.AgentNameId -> E.SiteNameId -> E.SiteNameId -> E.SiteNameId -> M.Mixture -> (Histogram, Histogram)
+histogram glucose c1 c4 c6 mix = (toHist . depth 1 |.| toHist . branch 1 . Just) (findRoot 0)
+ where depth :: Int -> M.AgentId -> [Depth]
+ depth n aId = case (nb4, nb6) of
+ (Nothing, Nothing) -> [n]
+ (Nothing, Just nb6Id) -> n : depth (n+1) nb6Id
+ (Just nb4Id, Nothing) -> depth (n+1) nb4Id
+ (Just nb4Id, Just nb6Id) -> depth (n+1) nb4Id ++ depth (n+1) nb6Id
+ where nb4 = fst <$> M.follow mix (aId, c4)
+ nb6 = fst <$> M.follow mix (aId, c6)
+
+ branch :: Int -> Maybe M.AgentId -> [Depth]
+ branch _ Nothing = []
+ branch n (Just aId) = case nb6 of
+ Nothing -> branch (n+1) nb4
+ _ -> n : branch 1 nb6 ++ branch 1 nb4
+ where nb4 = fst <$> M.follow mix (aId, c4)
+ nb6 = fst <$> M.follow mix (aId, c6)
+
+ toHist = Map.fromList . frequencies
+
+ findRoot :: M.AgentId -> M.AgentId
+ findRoot possibleRootId -- the root needs to be a glucose and have the C1 site free
+ | name == glucose && M.isFree (intf Vec.! c1) = possibleRootId
+ | otherwise = findRoot nbId
+ where M.Agent{ M.agentName = name, M.interface = intf } = M.agents mix Vec.! possibleRootId
+ (nbId, _) = M.follow mix (possibleRootId, c1) ? "Histogram: site C1 is not free nor bound"
+
+toTable :: Histogram -> String
+toTable hist = intercalate "\n" . map toRow $ Map.toAscList hist
+ where toRow (x, freq) = show x ++ " " ++ show freq
+
+main :: IO ()
+main = do inputFilename : glucose : c1 : c4 : c6 : _ <- getArgs
+ m <- KP.parseFromFile inputFilename
+ let kexprs = map snd $ KP.inits m
+ cm = T.inferCM kexprs
+ env = E.createEnv KP.emptyModule{ KP.contactMap = cm }
+
+ glucoseId = E.idOfAgent env glucose ? "Histogram: no '" ++ glucose ++ "' agent"
+ c1Id = E.idOfSite env (glucoseId, c1) ? "Histogram: no '" ++ c1 ++ "' site in '" ++ glucose ++ "' agent"
+ c4Id = E.idOfSite env (glucoseId, c4) ? "Histogram: no '" ++ c4 ++ "' site in '" ++ glucose ++ "' agent"
+ c6Id = E.idOfSite env (glucoseId, c6) ? "Histogram: no '" ++ c6 ++ "' site in '" ++ glucose ++ "' agent"
+
+ (depths, branchs) = unzip $ map (histogram glucoseId c1Id c4Id c6Id . M.evalKExpr env False) kexprs
+
+ basename = dropExtension inputFilename
+ outputFilenames suffix = map (makeOutFn suffix) [1..length kexprs]
+ makeOutFn suffix n = basename ++ "-" ++ show n ++ "-" ++ suffix ++ ".hist"
+
+ zipWithM_ writeFile (outputFilenames "depth") (map toTable depths)
+ zipWithM_ writeFile (outputFilenames "branch") (map toTable branchs)
+
View
2  KappaParser.hs
@@ -145,7 +145,7 @@ chainExpr = do first <- agent
return $ createChain first second last
kexpr :: Parser KExpr
-kexpr = do xs <- m_commaSep (try chainExpr <|> singleAgentExpr) <?> "kappa expression"
+kexpr = do xs <- m_commaSep1 (try chainExpr <|> singleAgentExpr) <?> "kappa expression"
return $ concat xs
where singleAgentExpr = do a <- agent
return [a]
View
14 MinimalGlueings.hs
@@ -29,7 +29,8 @@ main = do inputFilename : _ <- getArgs
dDots = map (detailedDot env m1 m2) m3s
basename = dropExtension inputFilename
- outputFilenames = map (++ ".dot") . map ((basename ++ "-") ++) $ map show [1..length m3s]
+ outputFilenames = map makeOutFn [1..length dDots]
+ makeOutFn n = basename ++ "-" ++ show n ++ ".dot"
writeFile (basename ++ ".dot") cDot
zipWithM_ writeFile outputFilenames dDots
@@ -67,14 +68,11 @@ detailedDot env m1 m2 (m3, (m1AgentMap, m2AgentMap)) =
concatMap linkDot links ++
" }\n"
where nodes = Vec.imap nodeName $ M.agents mix
- nodeName i agent = prefix ++ agentName agent ++ show i
+ nodeName i agent = prefix ++ agentName agent ++ show i
+ nodeDot (i, agent) = " " ++ nodeName i agent ++ " [ label = \"" ++ agentName agent ++ "\" ];\n"
- nodeDot (i, agent) = " " ++ nodeName i agent ++ " [ label = \"" ++ agentName agent ++ "\" ];\n"
-
- links = map Set.toList . nub . map toSet . Map.toList $ M.graph mix
- toSet (a, b) = Set.insert a $ Set.singleton b
-
- linkDot [(aId1, sId1), (aId2, sId2)] =
+ links = Set.toList $ M.links mix
+ linkDot ((aId1, sId1), (aId2, sId2)) =
" " ++ (nodes Vec.!? aId1 ? "Matching.detailedDot: " ++ show aId1 ++ ", " ++ show nodes ++ ", " ++ show (M.toKappa env mix)) ++
" -> " ++ (nodes Vec.!? aId2 ? "Matching.detailedDot: " ++ show aId2 ++ ", " ++ show nodes ++ ", " ++ show (M.toKappa env mix)) ++
" [ headlabel = \"" ++ siteName aId1 sId1 mix ++ "\"" ++
View
16 Mixture.hs
@@ -39,6 +39,10 @@ isBound :: Site -> Bool
isBound Site{ bindingState = Bound } = True
isBound _ = False
+isFree :: Site -> Bool
+isFree Site{ bindingState = Free } = True
+isFree _ = False
+
isUnspecified :: Site -> Bool
isUnspecified site = site == unspecifiedSite
@@ -139,13 +143,17 @@ follow = flip Map.lookup . graph
addLink :: Endpoint -> Endpoint -> Graph -> Graph
addLink ep1 ep2 = Map.insert ep1 ep2 . Map.insert ep2 ep1
+links :: Mixture -> Set.Set (Endpoint, Endpoint)
+links mix = Map.foldrWithKey add Set.empty (graph mix)
+ where add ep1 ep2 linkSet
+ | (ep2, ep1) `Set.member` linkSet = linkSet
+ | otherwise = Set.insert (ep1, ep2) linkSet
toKappa :: E.Env -> Mixture -> String
-toKappa env mix = intercalate ", " . Vec.toList . Vec.imap agentStr $ agents mix
+toKappa env mix = intercalate ", " . Vec.toList $ Vec.imap agentStr (agents mix)
where
- (linkMap, _) = Map.foldrWithKey addLink (Map.empty, 1) (graph mix)
- addLink ep1 ep2 (linkMap, n) | Map.member ep1 linkMap = (linkMap, n)
- | otherwise = (Map.insert ep1 n $ Map.insert ep2 n linkMap, n + 1)
+ linkSet = Set.toList $ links mix
+ linkMap = zipmap (map fst linkSet) [1..] `Map.union` zipmap (map snd linkSet) [1..]
agentStr :: AgentId -> Agent -> String
agentStr agentId agent = agentNameStr ++ "(" ++ intercalate ", " sites ++ ")"
View
66 Smiles.hs
@@ -1,47 +1,51 @@
module Main where
-import KappaParser
+import qualified KappaParser as KP
+import qualified Types as T
+import qualified Mixture as M
+import qualified Env as E
import Utils
-import Misc
-import qualified Data.Map as Map
-import Data.List (find)
+import qualified Data.Vector as Vec
import Control.Monad (zipWithM_)
import System.Environment (getArgs)
import System.FilePath (dropExtension)
-glucopyranose :: String -> String -> String
-glucopyranose c4 c6 = "C1C(O)C(O)C(C(CO" ++ c6 ++ ")O1)O" ++ c4
-
--- TODO a better way is to take any agent and go to the agent at C1
-findFirst :: AgentName -> SiteName -> KExpr -> Maybe Agent
-findFirst glucose c1 = find isFirst
- where isFirst (Agent agentName intf) = agentName == glucose && any isFreeOnC1 intf
- isFreeOnC1 (Site siteName _ Free) = siteName == c1
- isFreeOnC1 _ = False
-
-toSmiles :: AgentName -> SiteName -> SiteName -> SiteName -> KExpr -> String
-toSmiles glucose c1 c4 c6 kexpr = "O" ++ smile (Just anchor)
- where lm = linkMap kexpr
- anchor = findFirst glucose c1 kexpr ? "Smiles.toSmiles: could not find a free site '" ++ c1 ++ "'"
-
- smile :: Maybe Agent -> String
- smile Nothing = ""
- smile (Just (Agent _ intf)) = glucopyranose (smile $ neighbourAt c4) (smile $ neighbourAt c6)
- where neighbourAt sn = do (Site _ _ (Bound bl)) <- find ((== sn) . siteName) intf
- (a1, sn1, sn2, a2) <- Map.lookup bl lm
- if sn1 == sn
- then return a2
- else return a1
+glucopyranose :: Int -> String -> String -> String
+glucopyranose _ c4 c6 = "C1C(O)C(O)C(C(O1)CO" ++ c6 ++ ")O" ++ c4
+
+toSmiles :: E.AgentNameId -> E.SiteNameId -> E.SiteNameId -> E.SiteNameId -> M.Mixture -> String
+toSmiles glucose c1 c4 c6 mix = "O" ++ smile 1 (findRoot 0)
+ where smile :: Int -> Maybe M.AgentId -> String
+ smile _ Nothing = ""
+ smile n (Just aId) = glucopyranose n (smile n nb4) (smile (n+1) nb6)
+ where nb4 = fst <$> M.follow mix (aId, c4)
+ nb6 = fst <$> M.follow mix (aId, c6)
+
+ findRoot :: M.AgentId -> Maybe M.AgentId
+ findRoot possibleRootId -- the root needs to be a glucose and have the C1 site free
+ | name == glucose && M.isFree (intf Vec.! c1) = Just possibleRootId
+ | otherwise = do (nbId, _) <- M.follow mix (possibleRootId, c1)
+ findRoot nbId
+ where M.Agent{ M.agentName = name, M.interface = intf } = M.agents mix Vec.! possibleRootId
main :: IO ()
main = do inputFilename : glucose : c1 : c4 : c6 : _ <- getArgs
- m <- parseFromFile inputFilename
- let kexprs = map snd $ inits m
- smiles = map (toSmiles glucose c1 c4 c6) kexprs
+ m <- KP.parseFromFile inputFilename
+ let kexprs = map snd $ KP.inits m
+ cm = T.inferCM kexprs
+ env = E.createEnv KP.emptyModule{ KP.contactMap = cm }
+
+ glucoseId = E.idOfAgent env glucose ? "Smiles: no '" ++ glucose ++ "' agent"
+ c1Id = E.idOfSite env (glucoseId, c1) ? "Smiles: no '" ++ c1 ++ "' site in '" ++ glucose ++ "' agent"
+ c4Id = E.idOfSite env (glucoseId, c4) ? "Smiles: no '" ++ c4 ++ "' site in '" ++ glucose ++ "' agent"
+ c6Id = E.idOfSite env (glucoseId, c6) ? "Smiles: no '" ++ c6 ++ "' site in '" ++ glucose ++ "' agent"
+
+ smiles = map (toSmiles glucoseId c1Id c4Id c6Id . M.evalKExpr env False) kexprs
basename = dropExtension inputFilename
- outputFilenames = map (++ ".smi") . map ((basename ++ "-") ++) $ map show [1..length smiles]
+ outputFilenames = map makeOutFn [1..length smiles]
+ makeOutFn n = basename ++ "-" ++ show n ++ ".smi"
zipWithM_ writeFile outputFilenames smiles
Please sign in to comment.
Something went wrong with that request. Please try again.