BioHMM 1.0.3 → 1.0.4

raw patch · 5 files changed

+97/−116 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• BioHMM.cabal +1/−1
• changelog +3/−0
• src/Bio/HMMCompareResult.hs +14/−15
• src/Bio/HMMData.hs +2/−2
• src/Bio/HMMDraw.hs +77/−98

@@ -1,5 +1,5 @@ name:                BioHMM-version:             1.0.3+version:             1.0.4 synopsis:            Libary for Hidden Markov Models in HMMER3 format.  description:         Libary containing parsing and visualisation functions and datastructures for Hidden Markov Models in HMMER3 format.   license:             GPL-3

@@ -1,4 +1,7 @@ -*-change-log-*-+1.0.4 Florian Eggenhofer <egg@informatik.uni-freiburg.de> 13. February 2017+        * Enabled separate output of stockholm alignment visualisation+	* Removed concatenated model visualisation 1.0.3 Florian Eggenhofer <egg@informatik.uni-freiburg.de> 29. December 2016         * Bugfix - reverted broken setting of svgsize 1.0.2 Florian Eggenhofer <egg@informatik.uni-freiburg.de> 29. December 2016

@@ -7,7 +7,7 @@      readHMMCompareResult,      model1Name,      model2Name,-     linkscore1, +     linkscore1,      linkscore2,      linksequence,      model1matchednodes,@@ -17,11 +17,11 @@      getModelNames     ) where -import Text.ParserCombinators.Parsec     -import Control.Monad+import Text.ParserCombinators.Parsec+--import Control.Monad  -- | Datastructure for result strings of comparisons between covariance models by HMMCompare-data HMMCompareResult = HMMCompareResult           +data HMMCompareResult = HMMCompareResult   { model1Name :: String,     model2Name :: String,     linkscore1 :: Double,@@ -32,14 +32,13 @@   } deriving (Show)  -- | parse HMMCompareResult model from input string-parseHMMCompareResult :: [Char] -> Either ParseError [HMMCompareResult]+parseHMMCompareResult :: String -> Either ParseError [HMMCompareResult] parseHMMCompareResult input = parse genParseHMMCompareResults "HMMCompareResult" input  -- | parse HMMCompareResult from input filePath                      -readHMMCompareResult :: String -> IO (Either ParseError [HMMCompareResult])                  -readHMMCompareResult filePath = do -  parsedFile <- parseFromFile genParseHMMCompareResults filePath-  return parsedFile+readHMMCompareResult :: String -> IO (Either ParseError [HMMCompareResult])+readHMMCompareResult filePath = do+  parseFromFile genParseHMMCompareResults filePath  -- | Parse the input as HMMCompareResult datatype genParseHMMCompareResults :: GenParser Char st [HMMCompareResult]@@ -49,7 +48,7 @@   return hmmcs  readDouble :: String -> Double-readDouble = read              +readDouble = read  readInt :: String -> Int readInt = read@@ -78,14 +77,14 @@     return $ HMMCompareResult name1 name2 (readDouble score1) (readDouble score2) linkseq nodes1 nodes2  -- | Parse indices of matched nodes between models as integers-parseMatchedNodes :: GenParser Char st Int +parseMatchedNodes :: GenParser Char st Int parseMatchedNodes = do     nodeNumber <- many1 digit     optional (char ',')-    return $ (readInt nodeNumber)+    return (readInt nodeNumber)  -- | Parser for HMMCompare result strings-getHMMCompareResults :: FilePath -> IO [Either ParseError HMMCompareResult]    +getHMMCompareResults :: FilePath -> IO [Either ParseError HMMCompareResult] getHMMCompareResults filePath = let         fp = filePath         doParseLine' = parse genParseHMMCompareResult "genParseHMMCompareResults"@@ -93,11 +92,11 @@         --    Right x -> x         --    Left _  -> error "Failed to parse line"     in do-        fileContent <- liftM lines $ readFile fp+        fileContent <- fmap lines $ readFile fp         return $ map doParseLine' fileContent  getModelsNames :: [HMMCompareResult] -> [String]-getModelsNames models = concat (map getModelNames models)+getModelsNames models = concatMap getModelNames models  getModelNames :: HMMCompareResult -> [String] getModelNames model = [model1Name model,model2Name model]

@@ -68,7 +68,7 @@     nodes :: V.Vector HMMER3Node   }   deriving (Show, Eq)-  + -- | Data structure for the HMMER3 node data HMMER3Node = HMMER3Node   {@@ -88,7 +88,7 @@     -- insert emission score, one per symbol in the alphabet     insertEmissions :: V.Vector Double,     -- Transistion scores, m->m m->i m->d i->m i->i d->m d->d-    m2m :: Maybe Double, +    m2m :: Maybe Double,     m2i :: Maybe Double,     m2d :: Maybe Double,     i2m :: Maybe Double,

@@ -6,17 +6,17 @@  module Bio.HMMDraw     (-      drawHMMER3s,+      --drawHMMER3s,       drawHMMER3,       drawSingleHMMER3s,       svgsize,       diagramName,       printHMM,       getComparisonsHighlightParameters,-      drawHMMComparison,+      --drawHMMComparison,       drawSingleHMMComparison     ) where-  + import Diagrams.Prelude import Diagrams.Backend.Cairo import qualified Bio.HMMParser as HM@@ -32,20 +32,7 @@ import Graphics.SVGFonts import Bio.StockholmFont -drawHMMComparison :: String -> Int -> String -> Double -> Double -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [HMMCompareResult] -> QDiagram Cairo V2 Double Any-drawHMMComparison modelDetail entryNumberCutoff emissiontype maxWidth scalef hmms alns comparisons-   | modelDetail == "flat" = alignTL (vcat' with { _sep = 8 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-   | modelDetail == "simple" = alignTL (vcat' with { _sep = 8 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-   | modelDetail == "detailed" = alignTL (vcat' with { _sep = 40 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-   | otherwise = alignTL (vcat' with { _sep = 40 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-     where zippedInput = zip4 hmms alns comparisonNodeLabels (V.toList colorVector)-           colorVector = makeColorVector modelNumber-           modelNumber = length hmms-           modelNames = V.fromList (map HM.name hmms)-           nameColorVector = V.zipWith (\a b -> (a,b)) modelNames colorVector-           comparisonNodeLabels = map (getComparisonNodeLabels comparisons nameColorVector) hmms--drawSingleHMMComparison :: String -> Int -> String -> Double -> Double -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [HMMCompareResult] -> [QDiagram Cairo V2 Double Any]+drawSingleHMMComparison :: String -> Int -> String -> Double -> Double -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [HMMCompareResult] -> [(QDiagram Cairo V2 Double Any,QDiagram Cairo V2 Double Any)] drawSingleHMMComparison modelDetail entryNumberCutoff emissiontype maxWidth scalef hmms alns comparisons    | modelDetail == "flat" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput    | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput@@ -57,20 +44,9 @@            modelNames = V.fromList (map HM.name hmms)            nameColorVector = V.zipWith (\a b -> (a,b)) modelNames colorVector            comparisonNodeLabels = map (getComparisonNodeLabels comparisons nameColorVector) hmms-                        --- | -drawHMMER3s :: String -> Int -> Double -> Double -> String -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> QDiagram Cairo V2 Double Any-drawHMMER3s modelDetail entryNumberCutoff maxWidth scalef emissiontype hmms alns -  | modelDetail == "flat" = alignTL (vcat' with { _sep = 8 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-  | modelDetail == "simple" = alignTL (vcat' with { _sep = 8 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-  | modelDetail == "detailed" = alignTL (vcat' with { _sep = 40 * scalef} (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-  | otherwise = alignTL (vcat' with { _sep = 40 } (map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput))-    where zippedInput = zip4 hmms alns blankComparisonNodeLabels colorList-          blankComparisonNodeLabels = map getBlankComparisonNodeLabels hmms-          colorList = replicate (length hmms) white -drawSingleHMMER3s :: String -> Int -> Double -> Double -> String -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [QDiagram Cairo V2 Double Any]-drawSingleHMMER3s modelDetail entryNumberCutoff maxWidth scalef emissiontype hmms alns +drawSingleHMMER3s :: String -> Int -> Double -> Double -> String -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [(QDiagram Cairo V2 Double Any,QDiagram Cairo V2 Double Any)]+drawSingleHMMER3s modelDetail entryNumberCutoff maxWidth scalef emissiontype hmms alns   | modelDetail == "flat" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput   | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput   | modelDetail == "detailed" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype) zippedInput@@ -79,28 +55,31 @@           blankComparisonNodeLabels = map getBlankComparisonNodeLabels hmms           colorList = replicate (length hmms) white - -- |-drawHMMER3 :: String -> Int -> Double -> Double -> String -> (HM.HMMER3,Maybe S.StockholmAlignment, V.Vector (Int,V.Vector (Colour Double)), Colour Double) -> QDiagram Cairo V2 Double Any+drawHMMER3 :: String -> Int -> Double -> Double -> String -> (HM.HMMER3,Maybe S.StockholmAlignment, V.Vector (Int,V.Vector (Colour Double)), Colour Double) -> (QDiagram Cairo V2 Double Any,QDiagram Cairo V2 Double Any) drawHMMER3 modelDetail entriesNumberCutoff maxWidth scalef emissiontype (model,aln,comparisonNodeLabels,modelColor)-   | modelDetail == "flat" = (hcat $ V.toList (V.map drawHMMNodeFlat currentNodes)) # scale scalef -   | modelDetail == "simple" = (hcat $ V.toList (V.map drawHMMNodeSimple currentNodes)) # scale scalef-   | modelDetail == "detailed" = (applyAll ([bg white]) verboseNodesAlignment) # scale scalef-   | otherwise = hcat $ V.toList (V.map drawHMMNodeSimple currentNodes)-     where nodeNumber = fromIntegral $ length currentNodes+   | modelDetail == "flat" = ((applyAll ([bg white]) flatNodesHeader) # scale scalef,alignmentDiagram)+   | modelDetail == "simple" = ((applyAll ([bg white]) simpleNodesHeader) # scale scalef,alignmentDiagram)+   | modelDetail == "detailed" = ((applyAll ([bg white]) verboseNodesHeader) # scale scalef,alignmentDiagram)+   | otherwise = ((applyAll ([bg white]) verboseNodesHeader) # scale scalef,alignmentDiagram)+     where nodeNumber = fromIntegral $ V.length currentNodes            --nodes with begin node            currentNodes = HM.begin model `V.cons` HM.nodes model            nodeAlignmentColIndices =  V.map (fromJust . HM.nma) currentNodes            alphabet = HM.alpha model-           alphabetSymbols = HM.alphabetToSymbols alphabet           -           boxlength = (fromIntegral (length alphabetSymbols)) + 1-           nodeWidth = (6.0 :: Double)+           alphabetSymbols = HM.alphabetToSymbols alphabet+           boxlength = fromIntegral (length alphabetSymbols) + 1+           nodeWidth = 6.0 :: Double            nodeNumberPerRow = floor (maxWidth / nodeWidth - 2)            nodesIntervals = makeNodeIntervals nodeNumberPerRow nodeNumber+           flatNodes = hcat (V.toList (V.map drawHMMNodeFlat currentNodes)) # scale scalef+           simpleNodes = hcat (V.toList (V.map drawHMMNodeSimple currentNodes)) # scale scalef            verboseNodes = vcat' with { _sep = 3 } (V.toList (V.map (drawDetailedNodeRow alphabetSymbols emissiontype boxlength nodeNumber currentNodes comparisonNodeLabels) nodesIntervals))-           verboseNodesAlignment = (alignTL (vcat' with { _sep = 5 }  [modelHeader,verboseNodes,alignmentDiagram])) +           flatNodesHeader = alignTL (vcat' with { _sep = 5 }  [modelHeader,flatNodes])+           simpleNodesHeader = alignTL (vcat' with { _sep = 5 }  [modelHeader,simpleNodes])+           verboseNodesHeader = alignTL (vcat' with { _sep = 5 }  [modelHeader,verboseNodes])            modelHeader = makeModelHeader (HM.name model) modelColor-           alignmentDiagram = if isJust aln then drawStockholmLines entriesNumberCutoff maxWidth nodeAlignmentColIndices comparisonNodeLabels (fromJust aln) else mempty+           alignmentDiagram = maybe mempty (drawStockholmLines entriesNumberCutoff maxWidth nodeAlignmentColIndices comparisonNodeLabels) aln            --connectedNodes = makeConnections boxlength currentNodes            --selfconnectedNodes = makeSelfConnections boxlength currentNodes            --arrowList = map makeArrow connectedNodes ++ map makeSelfArrow selfconnectedNodes@@ -111,7 +90,7 @@  makeNodeIntervals :: Int -> Int -> V.Vector (Int,Int) makeNodeIntervals nodeNumberPerRow nodeNumber = rowIntervals-  where rowVector = V.iterateN rowNumber (1+) 0 +  where rowVector = V.iterateN rowNumber (1+) 0         rowNumber = ceiling $ (fromIntegral nodeNumber :: Double) / (fromIntegral nodeNumberPerRow :: Double)         rowIntervals = V.map (setRowInterval nodeNumberPerRow nodeNumber) rowVector @@ -120,17 +99,17 @@ setRowInterval :: Int -> Int -> Int -> (Int,Int) setRowInterval nodeNumberPerRow nodeNumber nodeIndex = (rowStart,safeLength)   where rowStart = nodeIndex*nodeNumberPerRow-        rowLength = nodeNumberPerRow -        safeLength = if rowStart + rowLength >= nodeNumber then (nodeNumber - rowStart) else rowLength+        rowLength = nodeNumberPerRow+        safeLength = if rowStart + rowLength >= nodeNumber then nodeNumber - rowStart else rowLength -drawDetailedNodeRow :: [Char] -> String -> Double -> Int -> V.Vector HM.HMMER3Node -> V.Vector (Int,V.Vector (Colour Double)) -> (Int, Int) -> QDiagram Cairo V2 Double Any+drawDetailedNodeRow :: String -> String -> Double -> Int -> V.Vector HM.HMMER3Node -> V.Vector (Int,V.Vector (Colour Double)) -> (Int, Int) -> QDiagram Cairo V2 Double Any drawDetailedNodeRow alphabetSymbols emissiontype boxLength lastIndex allNodes comparisonNodeLabels (currentIndex,nodeSliceLength) = detailedRow   where currentNodes = V.slice currentIndex nodeSliceLength allNodes         --withLastRowNodes = V.slice (currentIndex -1) (nodeSliceLength +1) allNodes         detailedRow = applyAll (lastRowList ++ arrowList ++ labelList) detailedNodes         nextIndex = currentIndex + nodeSliceLength         detailedNodes = hcat (V.toList (V.map (drawHMMNodeVerbose alphabetSymbols emissiontype boxLength currentIndex nextIndex lastIndex comparisonNodeLabels) currentNodes))-        arrowNodes = if currentIndex > 1 then currentNodes else currentNodes+        arrowNodes = currentNodes         connectedNodes = makeConnections boxLength arrowNodes         selfConnectedNodes = makeSelfConnections boxLength arrowNodes         arrowList = V.toList (V.map makeArrow connectedNodes V.++ V.map makeSelfArrow selfConnectedNodes)@@ -138,7 +117,7 @@         --add arrows and labels for transitions from previous row         lastNode = if currentIndex > 1 then V.slice (currentIndex -1) 1 allNodes else V.empty         lastRowConnections = makeLastRowConnections boxLength lastNode-        lastRowList = V.toList (V.map makeArrow lastRowConnections V.++ V.map makeLabel lastRowConnections)   +        lastRowList = V.toList (V.map makeArrow lastRowConnections V.++ V.map makeLabel lastRowConnections)  --setLetter :: String -> QDiagram Cairo V2 Double Any  --setLetter echar = alignedText 0.5 0.5 [echar] # fontSize 2 <> rect 1.0 1.0 # lw 0 -- # translate (r2 (negate 0.5, 0))@@ -150,40 +129,40 @@ --setTitelLetter echar = alignedText 0.5 0.5 [echar] # fontSize 4.0 <> rect 4.0 4.0 # lw 0 setTitelLetter t = textWithSize' t 4.0 -makeLastRowConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector ([Char], [Char], Double, (Double, Double))+makeLastRowConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector (String, String, Double, (Double, Double)) makeLastRowConnections boxlength currentnodes =  mm1A V.++ md1A V.++ im1A V.++ dm1A V.++ dd1A-  where mm1A = V.map makemm1A currentnodes +  where mm1A = V.map makemm1A currentnodes         md1A = V.map (makemd1A boxlength) currentnodes         im1A = V.map makeim1A currentnodes         dm1A = V.map (makedm1A boxlength) currentnodes         dd1A = V.map makedd1A currentnodes -makeConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector ([Char], [Char], Double, (Double, Double))+makeConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector (String, String, Double, (Double, Double)) makeConnections boxlength currentnodes =  mm1A V.++ miA V.++ md1A V.++ im1A V.++ dm1A V.++ dd1A-  where mm1A = V.map makemm1A currentnodes +  where mm1A = V.map makemm1A currentnodes         miA = V.map (makemiA boxlength) currentnodes         md1A = V.map (makemd1A boxlength) currentnodes         im1A = V.map makeim1A currentnodes         dm1A = V.map (makedm1A boxlength) currentnodes         dd1A = V.map makedd1A currentnodes -makeSelfConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector ([Char], [Char], Double, (Double, Double))+makeSelfConnections :: Double -> V.Vector HM.HMMER3Node -> V.Vector (String, String, Double, (Double, Double)) makeSelfConnections boxlength currentnodes = V.map (makeiiA boxlength) currentnodes  makemm1A :: HM.HMMER3Node -> (String, String, Double, (Double, Double))-makemm1A currentNode = (show ((HM.nodeId) currentNode) ++ "m", show ((HM.nodeId currentNode) + 1) ++ "m", maybe 0 ((roundPos 2) . exp . negate) (HM.m2m currentNode),(0,0.5))+makemm1A currentNode = (show (HM.nodeId currentNode) ++ "m", show (HM.nodeId currentNode + 1) ++ "m", maybe 0 (roundPos 2 . exp . negate) (HM.m2m currentNode),(0,0.5)) makemiA :: Double -> HM.HMMER3Node -> (String, String, Double, (Double, Double))-makemiA boxlength currentNode = (show ((HM.nodeId) currentNode) ++ "m", show ((HM.nodeId currentNode)) ++ "i",  maybe 0 ((roundPos 2) . exp . negate) (HM.m2i currentNode),(0,setiayOffset boxlength))+makemiA boxlength currentNode = (show (HM.nodeId currentNode) ++ "m", show (HM.nodeId currentNode) ++ "i",  maybe 0 (roundPos 2 . exp . negate) (HM.m2i currentNode),(0,setiayOffset boxlength)) makemd1A :: Double -> HM.HMMER3Node -> (String, String, Double, (Double, Double))-makemd1A _ currentNode = (show ((HM.nodeId) currentNode) ++ "m", show ((HM.nodeId currentNode) + 1) ++ "d", maybe 0 ((roundPos 2) . exp . negate) (HM.m2d currentNode),(1.5,2.0))+makemd1A _ currentNode = (show (HM.nodeId currentNode) ++ "m", show (HM.nodeId currentNode + 1) ++ "d", maybe 0 (roundPos 2 . exp . negate) (HM.m2d currentNode),(1.5,2.0)) makeim1A :: HM.HMMER3Node -> (String, String, Double, (Double, Double))-makeim1A currentNode = (show ((HM.nodeId) currentNode) ++ "i", show ((HM.nodeId currentNode) + 1) ++ "m", maybe 0 ((roundPos 2) . exp . negate) (HM.i2m currentNode),(0,negate 0.5))+makeim1A currentNode = (show (HM.nodeId currentNode) ++ "i", show (HM.nodeId currentNode + 1) ++ "m", maybe 0 (roundPos 2 . exp . negate) (HM.i2m currentNode),(0,negate 0.5)) makeiiA :: Double -> HM.HMMER3Node -> (String, String, Double, (Double, Double))-makeiiA _ currentNode = (show ((HM.nodeId) currentNode) ++ "i", show ((HM.nodeId currentNode)) ++ "i", maybe 0 ((roundPos 2) . exp . negate) (HM.i2i currentNode),(0,4.7))+makeiiA _ currentNode = (show (HM.nodeId currentNode) ++ "i", show (HM.nodeId currentNode) ++ "i", maybe 0 (roundPos 2 . exp . negate) (HM.i2i currentNode),(0,4.7)) makedm1A :: Double -> HM.HMMER3Node -> (String, String, Double, (Double, Double))-makedm1A _ currentNode = (show ((HM.nodeId) currentNode) ++ "d", show ((HM.nodeId currentNode) + 1) ++ "m", maybe 0 ((roundPos 2) . exp . negate) (HM.d2m currentNode),(negate 1.5,3.0))+makedm1A _ currentNode = (show (HM.nodeId currentNode) ++ "d", show (HM.nodeId currentNode + 1) ++ "m", maybe 0 (roundPos 2 . exp . negate) (HM.d2m currentNode),(negate 1.5,3.0)) makedd1A :: HM.HMMER3Node -> (String, String, Double, (Double, Double))-makedd1A currentNode = (show ((HM.nodeId) currentNode) ++ "d", show ((HM.nodeId currentNode) + 1) ++ "d", maybe 0 ((roundPos 2) . exp . negate) (HM.d2d currentNode),(negate 1,1))+makedd1A currentNode = (show (HM.nodeId currentNode) ++ "d", show (HM.nodeId currentNode + 1) ++ "d", maybe 0 (roundPos 2 . exp . negate) (HM.d2d currentNode),(negate 1,1))  setiayOffset :: Double -> Double setiayOffset boxlength@@ -191,13 +170,13 @@   | otherwise = 3.5  makeArrow :: (String,String,Double,(Double,Double)) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any-makeArrow (lab1,lab2,weight,_) = connectOutside' arrowStyle1 (lab1) (lab2) -  where arrowStyle1 = with & arrowHead .~ spike & shaftStyle %~ lw (local (0.1)) & headLength .~ local 0.001 & shaftStyle %~ dashingG [weight, 0.1] 0 & headStyle %~ fc black . opacity (weight * 2)+makeArrow (lab1,lab2,weight,_) = connectOutside' arrowStyle1 lab1 lab2+  where arrowStyle1 = with & arrowHead .~ spike & shaftStyle %~ lw (local 0.1) & headLength .~ local 0.001 & shaftStyle %~ dashingG [weight, 0.1] 0 & headStyle %~ fc black . opacity (weight * 2)  makeSelfArrow :: (String,String,Double,(Double,Double)) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any makeSelfArrow (lab1,_,weight,_) = connectPerim' arrowStyle lab1 lab1 (4/12 @@ turn) (2/12 @@ turn)-  where arrowStyle = with  & arrowHead .~ spike & arrowShaft .~ shaft' & arrowTail .~ lineTail & tailTexture .~ solid black  & shaftStyle %~ lw (local (0.1)) & headLength .~ local 0.001  & tailLength .~ 0.9 & shaftStyle %~ dashingG [weight, 0.1] 0 & headStyle %~ fc black . opacity (weight * 2)-        shaft' = arc xDir (-2.7/5 @@ turn) +  where arrowStyle = with  & arrowHead .~ spike & arrowShaft .~ shaft' & arrowTail .~ lineTail & tailTexture .~ solid black  & shaftStyle %~ lw (local 0.1) & headLength .~ local 0.001  & tailLength .~ 0.9 & shaftStyle %~ dashingG [weight, 0.1] 0 & headStyle %~ fc black . opacity (weight * 2)+        shaft' = arc xDir (-2.7/5 @@ turn)  -- %~ lw (local (0.1 * weight)) @@ -208,7 +187,7 @@     let v = location b2 .-. location b1         midpoint = location b1 .+^ (v ^/ 2)     in-      atop (position [((midpoint # translateX (negate 0.25 + xOffset) # translateY (0 + yOffset)), setLabelLetter (show weight)) ])+      atop (position [(midpoint # translateX (negate 0.25 + xOffset) # translateY (0 + yOffset), setLabelLetter (show weight)) ])  makeSelfLabel :: (String, String,Double,(Double,Double)) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any makeSelfLabel (n1,n2,weight,(xOffset,yOffset))=@@ -221,7 +200,7 @@  -- |  drawHMMNodeFlat :: HM.HMMER3Node -> QDiagram Cairo V2 Double Any-drawHMMNodeFlat _ = rect 2 2 # lw 0.1  +drawHMMNodeFlat _ = rect 2 2 # lw 0.1  -- |  drawHMMNodeSimple :: HM.HMMER3Node -> QDiagram Cairo V2 Double Any@@ -229,23 +208,23 @@  -- |  drawHMMNodeVerbose :: String -> String -> Double -> Int -> Int -> Int -> V.Vector (Int, V.Vector (Colour Double))-> HM.HMMER3Node -> QDiagram Cairo V2 Double Any-drawHMMNodeVerbose alphabetSymbols emissiontype boxlength rowStart rowEnd lastIndex comparisonNodeLabels node +drawHMMNodeVerbose alphabetSymbols emissiontype boxlength rowStart rowEnd lastIndex comparisonNodeLabels node   | idNumber == 0 = beginBox   | idNumber == (lastIndex - 1) = nodeBox ||| endBox   | idNumber == rowStart = rowStartBox idNumber boxlength ||| nodeBox-  | idNumber == rowEnd - 1 = nodeBox ||| rowEndBox idNumber boxlength         -  | otherwise = nodeBox +  | idNumber == rowEnd - 1 = nodeBox ||| rowEndBox idNumber boxlength+  | otherwise = nodeBox   where idNumber = HM.nodeId node         nodeLabels = V.toList (snd (comparisonNodeLabels V.! idNumber))         nid  = show idNumber-        beginBox = strutX 7 ||| (idBox nid nodeLabels === strutY 0.5 === emptyDeletions === strutY 1.5 === insertions nid === strutY 1.5 === beginState boxlength nid) ||| (strutX  4)-        nodeBox = idBox nid nodeLabels === strutY 0.5 === deletions nid === strutY 2.5 === insertions nid  === strutY 1.5 === matches alphabetSymbols emissiontype boxlength node ||| (strutX 4)+        beginBox = strutX 7 ||| (idBox nid nodeLabels === strutY 0.5 === emptyDeletions === strutY 1.5 === insertions nid === strutY 1.5 === beginState boxlength nid) ||| strutX  4+        nodeBox = idBox nid nodeLabels === strutY 0.5 === deletions nid === strutY 2.5 === insertions nid  === strutY 1.5 === matches alphabetSymbols emissiontype boxlength node ||| strutX 4         endBox = emptyIdBox === strutY 0.5 === emptyDeletions === strutY 1.5 === emptyInsertions  === strutY 1.5 === endState boxlength idNumber ||| strutX 4  -- | idBox associates the node with its index and a tupel of  a list of modelidentifiers and the total model number --idBox nid nodeLabels = alignedText 0 0 nid # fontSize 2  # translate (r2 ((negate ((fromIntegral ((length nid) * 2))/2)), negate 1.25)) idBox :: String -> [Colour Double] -> QDiagram Cairo V2 Double Any-idBox nid nodeLabels = text' nid # translate (r2 ((negate ((fromIntegral ((length nid) * 2))/2)), negate 1.25)) <>  wheel nodeLabels <> rect 1.5 3 # lw 0+idBox nid nodeLabels = text' nid # translate (r2 (negate ((fromIntegral ((length nid) * 2))/2), negate 1.25)) <>  wheel nodeLabels <> rect 1.5 3 # lw 0  emptyIdBox :: QDiagram Cairo V2 Double Any emptyIdBox = rect 1.5 1.5 # lw 0@@ -268,7 +247,7 @@ emptyInsertions :: QDiagram Cairo V2 Double Any emptyInsertions = rect 4.2426 4.2426 # lw 0 # rotateBy (1/8) # fc white -matches :: [Char] -> String -> Double -> HM.HMMER3Node -> QDiagram Cairo V2 Double Any+matches :: String -> String -> Double -> HM.HMMER3Node -> QDiagram Cairo V2 Double Any matches alphabetSymbols emissiontype boxlength node = entries # translate (r2 (negate 2.5,boxlength/2 -1)) <> outerbox # named (nid ++ "m")   where outerbox = rect 6 boxlength # lw 0.1 # fc white         entries = vcat (map (emissionEntry emissiontype) symbolsAndEmissions)@@ -281,9 +260,9 @@    where      wheel' = mconcat $ zipWith fc colors (iterateN n (rotate a) w)      n = length colors-     a = 1 / (fromIntegral n) @@ turn+     a = 1 / fromIntegral n @@ turn      w = wedge 3 xDir a # lwG 0-     r = (1/4 @@ turn)  ^-^  (1/(2*(fromIntegral n)) @@ turn)+     r = (1/4 @@ turn)  ^-^  (1/(2*fromIntegral n) @@ turn)  -- B → M 1 , B → I 0 , B → D 1 ; I 0 → M 1 , I 0 → I 0 beginState :: Double -> String -> QDiagram Cairo V2 Double Any@@ -304,25 +283,25 @@   | emissiontype == "probability" = propentries   | emissiontype == "bar" = barentries   | otherwise = barentries-    where scoreentries = emissions      +    where scoreentries = emissions           propentries = V.map (exp . negate) emissions           barentries = V.map (exp . negate) emissions  wrap :: t -> [t] wrap x = [x]-         + emissionEntry :: String -> (String,Double) -> QDiagram Cairo V2 Double Any-emissionEntry emissiontype (symbol,emission) +emissionEntry emissiontype (symbol,emission)   | emissiontype == "probability" = textentry   | emissiontype == "score" = textentry   | emissiontype == "bar" = barentry   | otherwise = barentry-    where textentry = alignedText 0 0.1 (symbol ++ " " ++ printf "%.3f" emission) # translate (r2 (negate 0.5,0)) <> (rect 2 1 # lw 0 ) +    where textentry = alignedText 0 0.1 (symbol ++ " " ++ printf "%.3f" emission) # translate (r2 (negate 0.5,0)) <> (rect 2 1 # lw 0 )           --barentry =  stroke (textSVG symbol 2) ||| bar emission           barentry = (alignedText 0 0.01 symbol  # translate (r2 (negate 0.25,negate 0.3)) <> (rect 2 1 # lw 0 )) ||| bar emission  bar :: Double -> QDiagram Cairo V2 Double Any-bar emission = (rect (4 * emission) 1 # lw 0 # fc black # translate (r2 (negate (2 - (4 * emission/2)),0)) <> rect 4 1 # lw 0.03 )+bar emission = rect (4 * emission) 1 # lw 0 # fc black # translate (r2 (negate (2 - (4 * emission/2)),0)) <> rect 4 1 # lw 0.03  svgsize :: SizeSpec V2 Double svgsize = mkSizeSpec2D Nothing Nothing@@ -334,13 +313,13 @@   | fileformat == "svg" = Right (filename ++ "." ++ fileformat )   | fileformat == "png" = Right (filename ++ "." ++ fileformat )   | fileformat == "ps" = Right (filename ++ "." ++ fileformat )-  | otherwise = Left "Unsupported output format requested (use svg, pdf, ps, png)"                     +  | otherwise = Left "Unsupported output format requested (use svg, pdf, ps, png)"  printHMM :: String -> SizeSpec V2 Double -> QDiagram Cairo V2 Double Any -> IO () printHMM outputName = renderCairo outputName  roundPos :: (RealFrac a) => Int -> a -> a-roundPos positions number  = (fromInteger $ round $ number * (10^positions)) / (10.0^^positions)+roundPos positions number  = fromInteger (round $ number * (10^positions)) / (10.0^^positions)  getComparisonsHighlightParameters :: [HM.HMMER3] -> [HMMCompareResult] -> [(Int,Int,Int,Int,Int,Int,Int,Int)] getComparisonsHighlightParameters sortedmodels comp = map (getComparisonHighlightParameters sortedmodels) comp@@ -357,21 +336,21 @@  getComparisonNodeLabels :: [HMMCompareResult] -> V.Vector (String, Colour Double) -> HM.HMMER3 -> V.Vector (Int, V.Vector (Colour Double)) getComparisonNodeLabels comparsionResults colorVector model = comparisonNodeLabels-   where modelName = HM.name model +   where modelName = HM.name model          relevantComparisons1 = filter ((modelName==) . model1Name) comparsionResults-         modelNodeInterval1 = map (\a -> (model2Name a,model2matchednodes a))  relevantComparisons1 +         modelNodeInterval1 = map (\a -> (model2Name a,model2matchednodes a)) relevantComparisons1          relevantComparisons2 = filter ((modelName==) . model2Name) comparsionResults-         modelNodeInterval2 = map (\a -> (model1Name a,model1matchednodes a))  relevantComparisons2+         modelNodeInterval2 = map (\a -> (model1Name a,model1matchednodes a)) relevantComparisons2          modelNodeIntervals =  V.fromList (modelNodeInterval1 ++ modelNodeInterval2)          colorNodeIntervals = V.map (modelToColor colorVector) modelNodeIntervals-         nodeNumber = length (HM.nodes model)+         nodeNumber = V.length (HM.nodes model)          comparisonNodeLabels = V.generate (nodeNumber +1) (makeComparisonNodeLabel colorNodeIntervals)          --nodeColorLabels = map model colorNodeIntervals  getBlankComparisonNodeLabels :: HM.HMMER3 -> V.Vector (Int, V.Vector (Colour Double)) getBlankComparisonNodeLabels model = comparisonNodeLabels    where comparisonNodeLabels = V.generate (nodeNumber +1 )  makeBlankComparisonNodeLabel-         nodeNumber = length (HM.nodes model) +         nodeNumber = V.length (HM.nodes model)  modelToColor :: V.Vector (String,Colour Double) ->  (String,[Int]) -> (Colour Double,[Int]) modelToColor colorVector (mName,nInterval) = nColorInterval@@ -379,37 +358,37 @@         --nColorInterval = maybe Nothing (\a -> Just (snd a,nInterval)) entry         entry = V.find (\(a,_)-> mName == a) colorVector -makeComparisonNodeLabel :: V.Vector (Colour Double,[Int]) -> Int -> (Int,(V.Vector (Colour Double)))+makeComparisonNodeLabel :: V.Vector (Colour Double,[Int]) -> Int -> (Int,V.Vector (Colour Double)) makeComparisonNodeLabel colorNodeIntervals nodeNumber = comparisonNodeLabel   where relevantColorNodeIntervals = V.filter (\(_,b) -> elem nodeNumber b) colorNodeIntervals         modelColors = V.map fst relevantColorNodeIntervals-        comparisonNodeLabel = if (null modelColors) then (nodeNumber,V.singleton white) else (nodeNumber,modelColors)+        comparisonNodeLabel = if V.null modelColors then (nodeNumber,V.singleton white) else (nodeNumber,modelColors) -makeBlankComparisonNodeLabel :: Int -> (Int,(V.Vector (Colour Double)))+makeBlankComparisonNodeLabel :: Int -> (Int,V.Vector (Colour Double)) makeBlankComparisonNodeLabel nodeNumber = (nodeNumber,V.singleton white)  makeColorVector :: Int -> V.Vector (Colour Double) makeColorVector modelNumber = V.map (\(a,b,c) -> R.rgb a b c) modelRGBTupel-   where indexVector = V.iterateN (modelNumber) (1+) 0-         stepSize = (765 :: Double) / (fromIntegral modelNumber)+   where indexVector = V.iterateN modelNumber (1+) 0+         stepSize = (765 :: Double) / fromIntegral modelNumber          modelRGBTupel = V.map (makeRGBTupel stepSize) indexVector  makeRGBTupel :: Double -> Int -> (Double,Double,Double) makeRGBTupel stepSize modelNumber = (a,b,c)-  where  totalSize = (fromIntegral modelNumber) * stepSize -         a = (rgbBoundries (totalSize  - 255))/255-         b = (rgbBoundries (totalSize - a - 255))/255-         c = (rgbBoundries (totalSize - a - b))/255+  where  totalSize = fromIntegral modelNumber * stepSize+         a = rgbBoundries (totalSize  - 255)/255+         b = rgbBoundries (totalSize - a - 255)/255+         c = rgbBoundries (totalSize - a - b)/255  rgbBoundries :: Double -> Double rgbBoundries rgbValue   | rgbValue>210 = 210   | rgbValue<50 = 50-  | otherwise = rgbValue        +  | otherwise = rgbValue  text' :: String -> QDiagram Cairo V2 Double Any text' t = textSVG_ (TextOpts linLibertineFont INSIDE_H KERN False 3 3) t # fc black # fillRule EvenOdd # lw 0.0 # translate (r2 (negate 0.75, negate 0.75))  textWithSize' :: String -> Double -> QDiagram Cairo V2 Double Any-textWithSize' t si = textSVG_ (TextOpts linLibertineFont INSIDE_H KERN False si si) t # fc black # fillRule EvenOdd # lw 0.0 # translate (r2 (negate siOffset, negate siOffset)) +textWithSize' t si = textSVG_ (TextOpts linLibertineFont INSIDE_H KERN False si si) t # fc black # fillRule EvenOdd # lw 0.0 # translate (r2 (negate siOffset, negate siOffset))   where siOffset = si/2