Taxonomy 1.0.1 → 1.0.2

raw patch · 3 files changed

+97/−46 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Taxonomy.cabal +3/−3
• src/Bio/Taxonomy.hs +85/−35
• src/Bio/TaxonomyData.hs +9/−8

@@ -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.

@@ -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.

@@ -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)