diff --git a/Taxonomy.cabal b/Taxonomy.cabal --- a/Taxonomy.cabal +++ b/Taxonomy.cabal @@ -5,7 +5,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 1.0.1 +version: 1.0.2 synopsis: Libary for parsing, processing and vizualization of taxonomy data description: Haskell cabal Taxonomy libary contains tools, parsers, datastructures and visualisation for the NCBI (National Center for Biotechnology Information) Taxonomy datasources. @@ -40,8 +40,8 @@ source-repository this type: git - location: https://github.com/eggzilla/Taxonomy/tree/v1.0.1 - tag: v1.0.1 + location: https://github.com/eggzilla/Taxonomy/tree/v1.0.2 + tag: v1.0.2 library -- Modules exported by the library. diff --git a/src/Bio/Taxonomy.hs b/src/Bio/Taxonomy.hs --- a/src/Bio/Taxonomy.hs +++ b/src/Bio/Taxonomy.hs @@ -40,11 +40,12 @@ -- * Processing compareSubTrees, extractTaxonomySubTreebyLevel, + extractTaxonomySubTreebyLevelNew, extractTaxonomySubTreebyRank, safeNodePath, getParentbyRank, -- * Visualization - drawTreeComparison, + drawTaxonomyComparison, drawTaxonomy, writeTree, writeDotTree, @@ -65,10 +66,11 @@ import qualified Data.GraphViz.Printing as GVP import qualified Data.GraphViz.Attributes.Colors as GVAC import qualified Data.GraphViz.Attributes.Complete as GVA -import qualified Data.Text.Lazy as TL -import qualified Data.ByteString.Char8 as B +--import qualified Data.Text.Lazy as TL +--import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Aeson.Encode as AE +import qualified Data.Text.Lazy as T -------------------------------------------------------- --------------------------------------- @@ -78,14 +80,17 @@ readNamedTaxonomy :: String -> IO (Either ParseError (Gr SimpleTaxon Double)) readNamedTaxonomy directoryPath = do nodeNames <- readNCBITaxNames (directoryPath ++ "names.dmp") - let scientificNameBS = B.pack "scientific name" if E.isLeft nodeNames then return (Left (E.fromLeft nodeNames)) else do - let nodeNamesVector = V.fromList (E.fromRight nodeNames) - let filteredNodeNames = V.filter (\a -> nameClass a == scientificNameBS) nodeNamesVector + let rightNodeNames = V.fromList (E.fromRight nodeNames) + let filteredNodeNames = V.filter isScientificName rightNodeNames parseFromFileEncISO88591 (genParserNamedTaxonomyGraph filteredNodeNames) (directoryPath ++ "nodes.dmp") +isScientificName :: TaxName -> Bool +isScientificName name = nameClass name == scientificNameT + where scientificNameT = T.pack "scientific name" + -- | NCBI taxonomy dump nodes and names in the input directory path are parsed and a SimpleTaxon tree is generated. readTaxonomy :: String -> IO (Either ParseError (Gr SimpleTaxon Double)) readTaxonomy = parseFromFileEncISO88591 genParserTaxonomyGraph @@ -99,26 +104,35 @@ nodesEdges <- many1 (try genParserGraphNodeEdge) optional eof let (nodesList,edgesList) = unzip nodesEdges - let taxedges = filter (\(a,b,_) -> a /= b) edgesList + --let taxedges = filter (\(a,b,_) -> a /= b) edgesList + let taxedges = filter notLoopEdge edgesList --let taxnodes = concat nodesList --return (mkGraph taxnodes taxedges) return $! mkGraph nodesList taxedges + +notLoopEdge :: (Int,Int,a) -> Bool +notLoopEdge (a,b,_) = a /= b + genParserNamedTaxonomyGraph :: V.Vector TaxName -> GenParser Char st (Gr SimpleTaxon Double) genParserNamedTaxonomyGraph filteredNodeNames = do - nodesEdges <- many1 (try genParserGraphNodeEdge) + nodesEdges <- (many1 (try genParserGraphNodeEdge)) optional eof - let (nodesList,edgesList) = unzip nodesEdges - let taxedges = filter (\(a,b,_) -> a /= b) edgesList - let taxnamednodes = map (setNodeScientificName filteredNodeNames) nodesList - return $! mkGraph taxnamednodes taxedges + let (nodesList,edgesList) = V.unzip (V.fromList nodesEdges) + let taxedges = V.filter notLoopEdge edgesList + let taxnamednodes = V.map (setNodeScientificName filteredNodeNames) nodesList + return $! mkGraph (V.toList taxnamednodes) (V.toList taxedges) setNodeScientificName :: V.Vector TaxName -> (t, SimpleTaxon) -> (t, SimpleTaxon) setNodeScientificName inputTaxNames (inputNode,inputTaxon) = outputNode - where maybeRetrievedName = V.find (\a -> nameTaxId a == simpleTaxId inputTaxon) inputTaxNames - retrievedName = maybe (B.pack "no name") nameTxt maybeRetrievedName + where maybeRetrievedName = V.find (isTaxNameIdSimpleTaxid inputTaxon) inputTaxNames + retrievedName = maybe (T.pack "no name") nameTxt maybeRetrievedName outputNode = (inputNode,inputTaxon{simpleScientificName = retrievedName}) +isTaxNameIdSimpleTaxid :: SimpleTaxon -> TaxName -> Bool +isTaxNameIdSimpleTaxid inputTaxon inputTaxName = nameTaxId inputTaxName == simpleTaxId inputTaxon + + genParserGraphNodeEdge :: GenParser Char st ((Int,SimpleTaxon),(Int,Int,Double)) genParserGraphNodeEdge = do _simpleTaxId <- many1 digit @@ -130,7 +144,7 @@ char '\n' let _simpleTaxIdInt = readInt _simpleTaxId let _simpleParentTaxIdInt = readInt _simpleParentTaxId - return ((_simpleTaxIdInt,SimpleTaxon _simpleTaxIdInt B.empty _simpleParentTaxIdInt (readRank _simpleRank)),(_simpleTaxIdInt,_simpleParentTaxIdInt,1 :: Double)) + return ((_simpleTaxIdInt,SimpleTaxon _simpleTaxIdInt T.empty _simpleParentTaxIdInt (readRank _simpleRank)),(_simpleTaxIdInt,_simpleParentTaxIdInt,1 :: Double)) -- | parse NCBITaxCitations from input string parseNCBITaxCitations :: String -> Either ParseError [TaxCitation] @@ -317,7 +331,7 @@ tab char '|' newline - return $! TaxName (readInt _taxId) (B.pack _nameTxt) (maybe B.empty B.pack _uniqueName) (B.pack _nameClass) + return $! TaxName (readInt _taxId) (T.pack _nameTxt) (maybe T.empty T.pack _uniqueName) (T.pack _nameClass) genParserNCBISimpleTaxon :: GenParser Char st SimpleTaxon genParserNCBISimpleTaxon = do @@ -328,7 +342,7 @@ _simpleRank <- many1 (noneOf "\t") many1 (noneOf "\n") char '\n' - return $! SimpleTaxon (readInt _simpleTaxId) B.empty (readInt _simpleParentTaxId) (readRank _simpleRank) + return $! SimpleTaxon (readInt _simpleTaxId) T.empty (readInt _simpleParentTaxId) (readRank _simpleRank) genParserNCBITaxNode :: GenParser Char st TaxNode genParserNCBITaxNode = do @@ -399,6 +413,23 @@ filteredledges = nub (concatMap (out graph . fst) filteredLNodes) taxonomySubTree = mkGraph filteredLNodes filteredledges :: Gr SimpleTaxon Double +-- | Extract a subtree corresponding to input node paths to root. Only nodes in level number distance to root are included. Used in Ids2Tree tool. +extractTaxonomySubTreebyLevelNew :: [Node] -> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double +extractTaxonomySubTreebyLevelNew inputNodes graph levelNumber = taxonomySubTree + where inputNodeVector = V.fromList inputNodes + paths = V.concatMap (getVectorPath (1 :: Node) graph) inputNodeVector + contexts = V.map (context graph) paths + vlnodes = V.map labNode' contexts + ledges = concatMap (out graph . fst) lnodes + lnodes = V.toList vlnodes + --ledges = V.toList vledges + unfilteredTaxonomySubTree = mkGraph lnodes ledges :: Gr SimpleTaxon Double + filteredLNodes = filterNodesByLevel levelNumber lnodes unfilteredTaxonomySubTree + --filteredLNodesVector = V.fromList filteredLNodes + filteredledges = concatMap (out graph . fst) filteredLNodes + --filteredledges = V.toList filteredledgesVector + taxonomySubTree = mkGraph filteredLNodes filteredledges :: Gr SimpleTaxon Double + -- | Extract a subtree corresponding to input node paths to root. If a Rank is provided, all node that are less or equal are omitted extractTaxonomySubTreebyRank :: [Node] -> Gr SimpleTaxon Double -> Maybe Rank -> Gr SimpleTaxon Double extractTaxonomySubTreebyRank inputNodes graph highestRank = taxonomySubTree @@ -409,9 +440,12 @@ filteredledges = nub (concatMap (out graph . fst) filteredLNodes) taxonomySubTree = mkGraph filteredLNodes filteredledges :: Gr SimpleTaxon Double +getVectorPath :: Node -> Gr SimpleTaxon Double -> Node -> V.Vector Node +getVectorPath root graph node = V.fromList (sp node root graph) + getPath :: Node -> Gr SimpleTaxon Double -> Node -> Path getPath root graph node = sp node root graph - + -- | Extract parent node with specified Rank getParentbyRank :: Node -> Gr SimpleTaxon Double -> Maybe Rank -> Maybe (Node, SimpleTaxon) getParentbyRank inputNode graph requestedRank = filteredLNode @@ -465,32 +499,48 @@ -- Visualisation functions -- | Draw graph in dot format. Used in Ids2Tree tool. -drawTaxonomy :: Gr SimpleTaxon Double -> String -drawTaxonomy inputGraph = do +drawTaxonomy :: Bool -> Gr SimpleTaxon Double -> String +drawTaxonomy withRank inputGraph = do + let nodeFormating = if withRank then nodeFormatWithRank else nodeFormatWithoutRank let params = GV.nonClusteredParams {GV.isDirected = True , GV.globalAttributes = [GV.GraphAttrs [GVA.Size (GVA.GSize (20 :: Double) (Just (20 :: Double)) False)]] , GV.isDotCluster = const True - , GV.fmtNode = \ (_,l) -> [GV.textLabel (TL.pack (show (simpleRank l) ++ "\n" ++ B.unpack (simpleScientificName l)))] + --, GV.fmtNode = \ (_,l) -> [GV.textLabel (TL.pack (show (simpleRank l) ++ "\n" ++ T.unpack (simpleScientificName l)))] + , GV.fmtNode = nodeFormating , GV.fmtEdge = const [] } let dotFormat = GV.graphToDot params inputGraph let dottext = GVP.renderDot $ GVP.toDot dotFormat - TL.unpack dottext + T.unpack dottext +nodeFormatWithRank :: (t, SimpleTaxon) -> [GVA.Attribute] +nodeFormatWithRank (_,l) = [GV.textLabel (T.concat [T.pack (show (simpleRank l)), T.pack ("\n") , simpleScientificName l])] + +nodeFormatWithoutRank :: (t, SimpleTaxon) -> [GVA.Attribute] +nodeFormatWithoutRank (_,l) = [GV.textLabel (simpleScientificName l)] + -- | Draw tree comparison graph in dot format. Used in Ids2TreeCompare tool. -drawTreeComparison :: (Int,Gr CompareTaxon Double) -> String -drawTreeComparison (treeNumber,inputGraph) = do - let cList = makeColorList treeNumber +drawTaxonomyComparison :: Bool -> (Int,Gr CompareTaxon Double) -> String +drawTaxonomyComparison withRank (treeNumber,inputGraph) = do + let cList = makeColorList treeNumber + let nodeFormating = if withRank then (compareNodeFormatWithRank cList) else (compareNodeFormatWithoutRank cList) let params = GV.nonClusteredParams {GV.isDirected = True - , GV.globalAttributes = [] + , GV.globalAttributes = [] , GV.isDotCluster = const True - , GV.fmtNode = \ (_,l) -> [GV.textLabel (TL.pack (show (compareRank l) ++ "\n" ++ B.unpack (compareScientificName l))), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)] + --, GV.fmtNode = \ (_,l) -> [GV.textLabel (TL.pack (show (compareRank l) ++ "\n" ++ B.unpack (compareScientificName l))), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)] + , GV.fmtNode = nodeFormating , GV.fmtEdge = const [] } let dotFormat = GV.graphToDot params (grev inputGraph) let dottext = GVP.renderDot $ GVP.toDot dotFormat - TL.unpack dottext + T.unpack dottext +compareNodeFormatWithRank :: [GVA.Color] -> (t, CompareTaxon) -> [GVA.Attribute] +compareNodeFormatWithRank cList (_,l) = [GV.textLabel (T.concat [T.pack (show (compareRank l) ++ "\n"),compareScientificName l]), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)] + +compareNodeFormatWithoutRank :: [GVA.Color] -> (t, CompareTaxon) -> [GVA.Attribute] +compareNodeFormatWithoutRank cList (_,l) = [GV.textLabel (compareScientificName l), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)] + -- | Colors from color list are selected according to in which of the compared trees the node is contained. selectColors :: [Int] -> [GVA.Color] -> GVAC.ColorList selectColors inTrees currentColorList = GVAC.toColorList (map (\i -> currentColorList !! i) inTrees) @@ -502,18 +552,18 @@ neededColors = treeNumber - 1 -- | Write tree representation either as dot or json to provided file path -writeTree :: String -> String -> Gr SimpleTaxon Double -> IO () -writeTree requestedFormat outputDirectoryPath inputGraph = do +writeTree :: String -> String -> Bool -> Gr SimpleTaxon Double -> IO () +writeTree requestedFormat outputDirectoryPath withRank inputGraph = do case requestedFormat of - "dot" -> writeDotTree outputDirectoryPath inputGraph + "dot" -> writeDotTree outputDirectoryPath withRank inputGraph "json"-> writeJsonTree outputDirectoryPath inputGraph - _ -> writeDotTree outputDirectoryPath inputGraph + _ -> writeDotTree outputDirectoryPath withRank inputGraph -- | Write tree representation as dot to provided file path. -- Graphviz tools like dot can be applied to the written .dot file to generate e.g. svg-format images. -writeDotTree :: String -> Gr SimpleTaxon Double -> IO () -writeDotTree outputDirectoryPath inputGraph = do - let diagram = drawTaxonomy (grev inputGraph) +writeDotTree :: String -> Bool -> Gr SimpleTaxon Double -> IO () +writeDotTree outputDirectoryPath withRank inputGraph = do + let diagram = drawTaxonomy withRank (grev inputGraph) writeFile (outputDirectoryPath ++ "taxonomy.dot") diagram -- | Write tree representation as json to provided file path. diff --git a/src/Bio/TaxonomyData.hs b/src/Bio/TaxonomyData.hs --- a/src/Bio/TaxonomyData.hs +++ b/src/Bio/TaxonomyData.hs @@ -5,12 +5,13 @@ module Bio.TaxonomyData where import Prelude -import qualified Data.ByteString as B +--import qualified Data.ByteString as B import qualified Data.Aeson as A import qualified Data.Vector as V import Data.Graph.Inductive import qualified Data.Text as T -import qualified Data.Text.Encoding +import qualified Data.Text.Lazy as TL +--import qualified Data.Text.Encoding -- | SimpleTaxon only contains the most relevant fields of a taxonomy entry. -- For all annotaded fields use the Taxon datatype and its associated functions @@ -18,7 +19,7 @@ { -- node id in GenBank simpleTaxId :: Int, - simpleScientificName :: B.ByteString, + simpleScientificName :: TL.Text, -- parent node id in GenBank taxonomy database simpleParentTaxId :: Int, -- rank of this node (superkingdom, kingdom, ...) @@ -29,7 +30,7 @@ -- | Datastructure for tree comparisons data CompareTaxon = CompareTaxon { - compareScientificName :: B.ByteString, + compareScientificName :: TL.Text, compareRank :: Rank, -- number indicating in which trees, inTree :: [Int] @@ -157,11 +158,11 @@ -- the id of node associated with this name nameTaxId :: Int, -- name itself - nameTxt :: B.ByteString, + nameTxt :: TL.Text, -- the unique variant of this name if name not unique - uniqueName :: B.ByteString, + uniqueName :: TL.Text, -- (synonym, common name, ...) - nameClass :: B.ByteString + nameClass :: TL.Text } deriving (Show, Read, Eq) @@ -282,7 +283,7 @@ where jsonValue = A.object [currentScientificName,T.pack "children" A..= children] childNodes = suc inputGraph node currentLabel = lab inputGraph node - currentScientificName = T.pack "name" A..= maybe (T.pack "notFound") (Data.Text.Encoding.decodeUtf8 . simpleScientificName) currentLabel + currentScientificName = T.pack "name" A..= maybe (T.pack "notFound") (TL.toStrict . simpleScientificName) currentLabel children = A.Array (V.fromList (map (simpleTaxonJSONValue inputGraph) childNodes)) --jsonValue = A.object [currentScientificName,currentId,currentRank,(T.pack "children") A..= children] --currentId = (T.pack "id") A..= (maybe (T.pack "notFound") (\a -> T.pack (show (simpleTaxId a))) currentLabel)