diff --git a/BioHMM.cabal b/BioHMM.cabal --- a/BioHMM.cabal +++ b/BioHMM.cabal @@ -1,5 +1,5 @@ name: BioHMM -version: 1.0.5 +version: 1.0.6 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 @@ -20,8 +20,8 @@ source-repository this type: git - location: https://github.com/eggzilla/BioHMM/tree/1.0.5 - tag: 1.0.5 + location: https://github.com/eggzilla/BioHMM/tree/1.0.6 + tag: 1.0.6 library -- Modules exported by the library. diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,4 +1,7 @@ -*-change-log-*- +1.0.6 Florian Eggenhofer 15. March 2017 + * Added cutoff for displayed transition probabilities + * Improvements for detailed node layout 1.0.5 Florian Eggenhofer 26. February 2017 * Added labels and text to simple and minimal node vis * Flat detail is now minimal detail corresponding to cmvis diff --git a/src/Bio/HMMDraw.hs b/src/Bio/HMMDraw.hs --- a/src/Bio/HMMDraw.hs +++ b/src/Bio/HMMDraw.hs @@ -32,12 +32,12 @@ import Graphics.SVGFonts import Bio.StockholmFont -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 == "minimal" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype nameColorVector) zippedInput - | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype nameColorVector) zippedInput - | modelDetail == "detailed" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype nameColorVector) zippedInput - | otherwise = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype nameColorVector) zippedInput +drawSingleHMMComparison :: String -> Int -> Double -> String -> Double -> Double -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [HMMCompareResult] -> [(QDiagram Cairo V2 Double Any,QDiagram Cairo V2 Double Any)] +drawSingleHMMComparison modelDetail entryNumberCutoff transitionCutoff emissiontype maxWidth scalef hmms alns comparisons + | modelDetail == "minimal" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype nameColorVector) zippedInput + | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype nameColorVector) zippedInput + | modelDetail == "detailed" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype nameColorVector) zippedInput + | otherwise = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype nameColorVector) zippedInput where zippedInput = zip4 hmms alns comparisonNodeLabels (V.toList colorVector) colorVector = makeColorVector modelNumber modelNumber = length hmms @@ -45,20 +45,20 @@ nameColorVector = V.zipWith (\a b -> (a,b)) modelNames colorVector comparisonNodeLabels = map (getComparisonNodeLabels comparisons nameColorVector) hmms -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 == "minimal" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput - | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput - | modelDetail == "detailed" = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput - | otherwise = map (drawHMMER3 modelDetail entryNumberCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput +drawSingleHMMER3s :: String -> Int -> Double -> Double -> Double -> String -> [HM.HMMER3] -> [Maybe S.StockholmAlignment] -> [(QDiagram Cairo V2 Double Any,QDiagram Cairo V2 Double Any)] +drawSingleHMMER3s modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype hmms alns + | modelDetail == "minimal" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput + | modelDetail == "simple" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput + | modelDetail == "detailed" = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput + | otherwise = map (drawHMMER3 modelDetail entryNumberCutoff transitionCutoff maxWidth scalef emissiontype emptyColorNameVector) zippedInput where zippedInput = zip4 hmms alns blankComparisonNodeLabels colorList blankComparisonNodeLabels = map getBlankComparisonNodeLabels hmms colorList = replicate (length hmms) white emptyColorNameVector = V.empty -- | -drawHMMER3 :: String -> Int -> Double -> Double -> String -> V.Vector (String,Colour Double) -> (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 nameColorVector (model,aln,comparisonNodeLabels,modelColor) +drawHMMER3 :: String -> Int -> Double -> Double -> Double -> String -> V.Vector (String,Colour Double) -> (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 transitionCutoff maxWidth scalef emissiontype nameColorVector (model,aln,comparisonNodeLabels,modelColor) | modelDetail == "minimal" = ((applyAll ([bg white]) minimalNodesHeader) # scale scalef,alignmentDiagram) | modelDetail == "simple" = ((applyAll ([bg white]) simpleNodesHeader) # scale scalef,alignmentDiagram) | modelDetail == "detailed" = ((applyAll ([bg white]) verboseNodesHeader) # scale scalef,alignmentDiagram) @@ -69,13 +69,13 @@ nodeAlignmentColIndices = V.map (fromJust . HM.nma) currentNodes alphabet = HM.alpha model alphabetSymbols = HM.alphabetToSymbols alphabet - boxlength = (fromIntegral (length alphabetSymbols)) * 1.15 + 1 + boxlength = (fromIntegral (length alphabetSymbols)) * 1.25 + 0.3 nodeWidth = 6.0 :: Double nodeNumberPerRow = floor (maxWidth / nodeWidth - 2) nodesIntervals = makeNodeIntervals nodeNumberPerRow nodeNumber minimalNodes = hcat (V.toList (V.map (drawHMMNodeMinimal comparisonNodeLabels)currentNodes)) # scale scalef simpleNodes = hcat (V.toList (V.map (drawHMMNodeSimple alphabetSymbols emissiontype boxlength comparisonNodeLabels) currentNodes)) # scale scalef - verboseNodes = vcat' with { _sep = 3 } (V.toList (V.map (drawDetailedNodeRow alphabetSymbols emissiontype boxlength nodeNumber currentNodes comparisonNodeLabels) nodesIntervals)) + verboseNodes = vcat' with { _sep = 3 } (V.toList (V.map (drawDetailedNodeRow alphabetSymbols emissiontype boxlength transitionCutoff nodeNumber currentNodes comparisonNodeLabels) nodesIntervals)) minimalNodesHeader = alignTL (vcat' with { _sep = 5 } [modelHeader,minimalNodes]) simpleNodesHeader = alignTL (vcat' with { _sep = 5 } [modelHeader,simpleNodes]) verboseNodesHeader = alignTL (vcat' with { _sep = 5 } [modelHeader,verboseNodes]) @@ -83,7 +83,7 @@ alignmentDiagram = maybe mempty (drawStockholmLines entriesNumberCutoff maxWidth nodeAlignmentColIndices comparisonNodeLabels) aln makeModelHeader :: String -> Colour Double -> V.Vector (String,Colour Double) -> QDiagram Cairo V2 Double Any -makeModelHeader mName modelColor nameColorVector = strutX 2 ||| setModelName mName ||| strutX 1 ||| rect 12 12 # lw 0.1 # fc modelColor # translate (r2 (negate 0, 5)) ||| strutX 30 ||| modelLegend +makeModelHeader mName modelColor nameColorVector = strutX 2 ||| setModelName mName ||| strutX 1 ||| rect 6 6 # lw 0.1 # fc modelColor # translate (r2 (negate 0, 3)) ||| strutX 30 ||| modelLegend where modelLegend = makeModelLegend otherModelsNameColorVector otherModelsNameColorVector = V.filter ((/=mName) . fst) nameColorVector @@ -120,16 +120,18 @@ rowLength = nodeNumberPerRow safeLength = if rowStart + rowLength >= nodeNumber then nodeNumber - rowStart else rowLength -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 +drawDetailedNodeRow :: String -> String -> Double -> Double -> Int -> V.Vector HM.HMMER3Node -> V.Vector (Int,V.Vector (Colour Double)) -> (Int, Int) -> QDiagram Cairo V2 Double Any +drawDetailedNodeRow alphabetSymbols emissiontype transitionCutoff 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 = currentNodes - connectedNodes = makeConnections boxLength arrowNodes - selfConnectedNodes = makeSelfConnections boxLength arrowNodes + allConnectedNodes = makeConnections boxLength arrowNodes + connectedNodes = V.filter (\(_,_,weight,_) -> weight >= transitionCutoff) allConnectedNodes + allSelfConnectedNodes = makeSelfConnections boxLength arrowNodes + selfConnectedNodes = V.filter (\(_,_,weight,_) -> weight >= transitionCutoff) allSelfConnectedNodes arrowList = V.toList (V.map makeArrow connectedNodes V.++ V.map makeSelfArrow selfConnectedNodes) labelList = V.toList (V.map makeLabel connectedNodes V.++ V.map makeSelfLabel selfConnectedNodes) --add arrows and labels for transitions from previous row @@ -138,13 +140,13 @@ lastRowList = V.toList (V.map makeArrow lastRowConnections V.++ V.map makeLabel lastRowConnections) setLabelLetter :: String -> QDiagram Cairo V2 Double Any -setLabelLetter t = textWithSize' t 2.0 +setLabelLetter t = textWithSize' t 1.8 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 md1A = V.map (makemd1A boxlength) currentnodes - im1A = V.map makeim1A currentnodes + im1A = V.map (makeim1A boxlength) currentnodes dm1A = V.map (makedm1A boxlength) currentnodes dd1A = V.map makedd1A currentnodes @@ -153,7 +155,7 @@ where mm1A = V.map makemm1A currentnodes miA = V.map (makemiA boxlength) currentnodes md1A = V.map (makemd1A boxlength) currentnodes - im1A = V.map makeim1A currentnodes + im1A = V.map (makeim1A boxlength) currentnodes dm1A = V.map (makedm1A boxlength) currentnodes dd1A = V.map makedd1A currentnodes @@ -161,25 +163,31 @@ 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.1,negate 0.3)) 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)) 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)) -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.1)) +makemd1A _ currentNode = (show (HM.nodeId currentNode) ++ "m", show (HM.nodeId currentNode + 1) ++ "d", maybe 0 (roundPos 2 . exp . negate) (HM.m2d currentNode),(0.3,1.7)) +makeim1A :: Double -> HM.HMMER3Node -> (String, String, Double, (Double, Double)) +makeim1A boxlength currentNode = (show (HM.nodeId currentNode) ++ "i", show (HM.nodeId currentNode + 1) ++ "m", maybe 0 (roundPos 2 . exp . negate) (HM.i2m currentNode),(negate 0.1,setim1AOffset boxlength)) + where 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)) 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)) 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),(0,1)) +makedd1A currentNode = (show (HM.nodeId currentNode) ++ "d", show (HM.nodeId currentNode + 1) ++ "d", maybe 0 (roundPos 2 . exp . negate) (HM.d2d currentNode),(negate 0.6,1)) setiayOffset :: Double -> Double setiayOffset boxlength | boxlength <= 10 = 0.6 - | otherwise = 5 + | otherwise = 5.9 +setim1AOffset :: Double -> Double +setim1AOffset boxlength + | boxlength <= 10 = negate 0.3 + | otherwise = negate 2.3 + 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) @@ -251,7 +259,7 @@ emptyIdBox = rect 1.5 1.5 # lw 0 rowStartBox :: Int -> Double -> QDiagram Cairo V2 Double Any -rowStartBox idNumber boxlength = rect 0 1.5 #lw 0.0 === rect 0 6 # lw 0.1 # named (nid ++ "d") === rect 0 6 # lw 0.1 #named (nid ++ "i") === rect 0 (boxlength + 2) # lw 0.1 # named (nid ++ "m") ||| strutX 7 +rowStartBox idNumber boxlength = rect 0 1.5 #lw 0.0 === rect 0 6 # lw 0.1 # named (nid ++ "d") === rect 0 8 # lw 0.1 #named (nid ++ "i") === rect 0 (boxlength + 2) # lw 0.1 # named (nid ++ "m") ||| strutX 7 where nid = show (idNumber - 1) rowEndBox :: Int -> Double -> QDiagram Cairo V2 Double Any @@ -271,13 +279,18 @@ emptyInsertions = rect 4.2426 4.2426 # lw 0 # rotateBy (1/8) # fc white 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 +matches alphabetSymbols emissiontype boxlength node = entries # translate (r2 (negate 2.5,(boxlength/2)- matchesOffset boxlength)) <> outerbox # named (nid ++ "m") + where outerbox = rect 6 (boxlength * 1.1) # lw 0.1 # fc white entries = vcat (map (emissionEntry emissiontype) symbolsAndEmissions) symbolsAndEmissions = zip (map wrap alphabetSymbols) (V.toList emissionEntries) emissionEntries = setEmissions emissiontype (HM.matchEmissions node) nid = show $ HM.nodeId node +matchesOffset :: Double -> Double +matchesOffset boxlength + | boxlength <= 10 = 0.5 + | otherwise = 0 + wheel :: [Colour Double] -> QDiagram Cairo V2 Double Any wheel colors = wheel' # rotate r where @@ -290,12 +303,12 @@ -- 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 --beginState boxlength nid = alignedText 0.5 0.5 "BEGIN" <> outerbox # named (nid ++ "m") <> rect 6 boxlength # named (nid ++ "d") # lw 0.1 -beginState boxlength nid = textWithSize' "BEGIN" 1.5 # translate (r2 (negate 1.5,0)) <> outerbox # named (nid ++ "m") <> rect 6 boxlength # named (nid ++ "d") # lw 0.1 - where outerbox = rect 6 boxlength # lw 0.1 # fc white +beginState boxlength nid = textWithSize' "BEGIN" 1.5 # translate (r2 (negate 1.5,0)) <> outerbox # named (nid ++ "m") <> rect 5 (boxlength + 2) # named (nid ++ "d") # lw 0.1 + where outerbox = rect 5 (boxlength + 2) # lw 0.1 # fc white endState :: Double -> Int -> QDiagram Cairo V2 Double Any --endState boxlength idNumber = alignedText 0.5 0.5 "END" <> outerbox # named (nid ++ "m") <> rect 6 boxlength # named (nid ++ "d") # lw 0.1 <> rect 6 boxlength # named (nid ++ "i") # lw 0.1 -endState boxlength idNumber = textWithSize' "END" 2 <> outerbox # named (nid ++ "m") <> rect 6 boxlength # named (nid ++ "d") # lw 0.1 <> rect 6 boxlength # named (nid ++ "i") # lw 0.1 +endState boxlength idNumber = strutX 0.5 ||| (textWithSize' "END" 2 <> outerbox # named (nid ++ "m") <> rect 6 boxlength # named (nid ++ "d") # lw 0.1 <> rect 6 boxlength # named (nid ++ "i") # lw 0.1) where outerbox = rect 6 boxlength # lw 0.1 # fc white nid = show (idNumber + 1) @@ -325,7 +338,7 @@ textentry = textWithSize' (symbol ++ " " ++ printf "%.3f" emission) 1 --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 - barentry = (textWithSize' symbol 0.9 <> (rect 1 1 # lw 0 )) ||| strutX 1 ||| bar emission + barentry = (textWithSize' symbol 1.1 # translate (r2 (0.4,0.0)) <> (rect 1.3 1.1 # lw 0 )) ||| strutX 0.5 ||| 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