diff --git a/BioHMM.cabal b/BioHMM.cabal --- a/BioHMM.cabal +++ b/BioHMM.cabal @@ -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 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,4 +1,7 @@ -*-change-log-*- +1.0.4 Florian Eggenhofer 13. February 2017 + * Enabled separate output of stockholm alignment visualisation + * Removed concatenated model visualisation 1.0.3 Florian Eggenhofer 29. December 2016 * Bugfix - reverted broken setting of svgsize 1.0.2 Florian Eggenhofer 29. December 2016 diff --git a/src/Bio/HMMCompareResult.hs b/src/Bio/HMMCompareResult.hs --- a/src/Bio/HMMCompareResult.hs +++ b/src/Bio/HMMCompareResult.hs @@ -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] diff --git a/src/Bio/HMMData.hs b/src/Bio/HMMData.hs --- a/src/Bio/HMMData.hs +++ b/src/Bio/HMMData.hs @@ -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, diff --git a/src/Bio/HMMDraw.hs b/src/Bio/HMMDraw.hs --- a/src/Bio/HMMDraw.hs +++ b/src/Bio/HMMDraw.hs @@ -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