-- | Functions for processing of taxonomy data.
--
module Biobase.Taxonomy.Utils (  -- * Datatypes
                       -- Datatypes used to represent taxonomy data
                       module Biobase.Taxonomy.Types,
                       -- * Processing
                       compareSubTrees,
                       extractTaxonomySubTreebyLevel,
                       extractTaxonomySubTreebyLevelNew,
                       extractTaxonomySubTreebyRank,
                       safeNodePath,
                       getParentbyRank,
                      ) where
import Prelude
import Biobase.Taxonomy.Types
import Data.List
import qualified Data.Vector as V
import Data.Maybe
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.SP (sp)
import Data.Graph.Inductive.Query.BFS (level)
import Data.Graph.Inductive.Tree
import Data.Graph.Inductive.Basic

---------------------------------------
-- Processing functions

-- | Extract a subtree correpsonding to input node paths to root. Only nodes in level number distance to root are included. Used in Ids2TreeCompare tool.
compareSubTrees :: [Gr SimpleTaxon Double] -> (Int,Gr CompareTaxon Double)
compareSubTrees :: [Gr SimpleTaxon Double] -> (Int, Gr CompareTaxon Double)
compareSubTrees [Gr SimpleTaxon Double]
graphs = ([Gr SimpleTaxon Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Gr SimpleTaxon Double]
graphs,Gr CompareTaxon Double
resultGraph)
  where treesLabNodes :: [[LNode SimpleTaxon]]
treesLabNodes = (Gr SimpleTaxon Double -> [LNode SimpleTaxon])
-> [Gr SimpleTaxon Double] -> [[LNode SimpleTaxon]]
forall a b. (a -> b) -> [a] -> [b]
map Gr SimpleTaxon Double -> [LNode SimpleTaxon]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes [Gr SimpleTaxon Double]
graphs
        treesLabEdges :: [[LEdge Double]]
treesLabEdges = (Gr SimpleTaxon Double -> [LEdge Double])
-> [Gr SimpleTaxon Double] -> [[LEdge Double]]
forall a b. (a -> b) -> [a] -> [b]
map Gr SimpleTaxon Double -> [LEdge Double]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges [Gr SimpleTaxon Double]
graphs
        mergedNodes :: [LNode SimpleTaxon]
mergedNodes = [LNode SimpleTaxon] -> [LNode SimpleTaxon]
forall a. Eq a => [a] -> [a]
nub ([[LNode SimpleTaxon]] -> [LNode SimpleTaxon]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LNode SimpleTaxon]]
treesLabNodes)
        mergedEdges :: [LEdge Double]
mergedEdges = [LEdge Double] -> [LEdge Double]
forall a. Eq a => [a] -> [a]
nub ([[LEdge Double]] -> [LEdge Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LEdge Double]]
treesLabEdges)
        --annotate node in which of the compared trees they are present
        comparedNodes :: [LNode CompareTaxon]
comparedNodes = [[LNode SimpleTaxon]]
-> [LNode SimpleTaxon] -> [LNode CompareTaxon]
annotateTaxonsDifference [[LNode SimpleTaxon]]
treesLabNodes [LNode SimpleTaxon]
mergedNodes
        resultGraph :: Gr CompareTaxon Double
resultGraph = [LNode CompareTaxon] -> [LEdge Double] -> Gr CompareTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode CompareTaxon]
comparedNodes [LEdge Double]
mergedEdges :: Gr CompareTaxon Double

annotateTaxonsDifference  :: [[LNode SimpleTaxon]] -> [LNode SimpleTaxon] -> [LNode CompareTaxon]
annotateTaxonsDifference :: [[LNode SimpleTaxon]]
-> [LNode SimpleTaxon] -> [LNode CompareTaxon]
annotateTaxonsDifference  [[LNode SimpleTaxon]]
treesNodes [LNode SimpleTaxon]
mergedtreeNodes = [LNode CompareTaxon]
comparedNodes
  where comparedNodes :: [LNode CompareTaxon]
comparedNodes = (LNode SimpleTaxon -> LNode CompareTaxon)
-> [LNode SimpleTaxon] -> [LNode CompareTaxon]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, [LNode SimpleTaxon])]
-> LNode SimpleTaxon -> LNode CompareTaxon
annotateTaxonDifference [(Int, [LNode SimpleTaxon])]
indexedTreesNodes) [LNode SimpleTaxon]
mergedtreeNodes
        indexedTreesNodes :: [(Int, [LNode SimpleTaxon])]
indexedTreesNodes = [Int] -> [[LNode SimpleTaxon]] -> [(Int, [LNode SimpleTaxon])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..([[LNode SimpleTaxon]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[LNode SimpleTaxon]]
treesNodes)] [[LNode SimpleTaxon]]
treesNodes


annotateTaxonDifference :: [(Int,[LNode SimpleTaxon])] -> LNode SimpleTaxon -> LNode CompareTaxon
annotateTaxonDifference :: [(Int, [LNode SimpleTaxon])]
-> LNode SimpleTaxon -> LNode CompareTaxon
annotateTaxonDifference [(Int, [LNode SimpleTaxon])]
indexedTreesNodes LNode SimpleTaxon
mergedtreeNode = LNode CompareTaxon
comparedNode
  where comparedNode :: LNode CompareTaxon
comparedNode = (SimpleTaxon -> Int
simpleTaxId (LNode SimpleTaxon -> SimpleTaxon
forall a b. (a, b) -> b
snd LNode SimpleTaxon
mergedtreeNode),Text -> Rank -> [Int] -> CompareTaxon
CompareTaxon (SimpleTaxon -> Text
simpleScientificName (LNode SimpleTaxon -> SimpleTaxon
forall a b. (a, b) -> b
snd LNode SimpleTaxon
mergedtreeNode)) (SimpleTaxon -> Rank
simpleRank (LNode SimpleTaxon -> SimpleTaxon
forall a b. (a, b) -> b
snd LNode SimpleTaxon
mergedtreeNode)) [Int]
currentInTree)
        currentInTree :: [Int]
currentInTree = ((Int, [LNode SimpleTaxon]) -> [Int])
-> [(Int, [LNode SimpleTaxon])] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
i,[LNode SimpleTaxon]
treeNodes) -> [Int
i | LNode SimpleTaxon
mergedtreeNode LNode SimpleTaxon -> [LNode SimpleTaxon] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LNode SimpleTaxon]
treeNodes]) [(Int, [LNode SimpleTaxon])]
indexedTreesNodes

-- | Extract a subtree corresponding to input node paths to root. Only nodes in level number distance to root are included. Used in Ids2Tree tool.
extractTaxonomySubTreebyLevel :: [Node] -> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double
extractTaxonomySubTreebyLevel :: [Int]
-> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double
extractTaxonomySubTreebyLevel [Int]
inputNodes Gr SimpleTaxon Double
graph Maybe Int
levelNumber = Gr SimpleTaxon Double
taxonomySubTree
  where paths :: [Int]
paths = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ((Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Gr SimpleTaxon Double -> Int -> [Int]
getPath (Int
1 :: Node) Gr SimpleTaxon Double
graph) [Int]
inputNodes)
        contexts :: [Context SimpleTaxon Double]
contexts = (Int -> Context SimpleTaxon Double)
-> [Int] -> [Context SimpleTaxon Double]
forall a b. (a -> b) -> [a] -> [b]
map (Gr SimpleTaxon Double -> Int -> Context SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context Gr SimpleTaxon Double
graph) [Int]
paths
        lnodes :: [LNode SimpleTaxon]
lnodes = (Context SimpleTaxon Double -> LNode SimpleTaxon)
-> [Context SimpleTaxon Double] -> [LNode SimpleTaxon]
forall a b. (a -> b) -> [a] -> [b]
map Context SimpleTaxon Double -> LNode SimpleTaxon
forall a b. Context a b -> LNode a
labNode' [Context SimpleTaxon Double]
contexts
        ledges :: [LEdge Double]
ledges = [LEdge Double] -> [LEdge Double]
forall a. Eq a => [a] -> [a]
nub ((LNode SimpleTaxon -> [LEdge Double])
-> [LNode SimpleTaxon] -> [LEdge Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Gr SimpleTaxon Double -> Int -> [LEdge Double]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out Gr SimpleTaxon Double
graph (Int -> [LEdge Double])
-> (LNode SimpleTaxon -> Int)
-> LNode SimpleTaxon
-> [LEdge Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode SimpleTaxon -> Int
forall a b. (a, b) -> a
fst) [LNode SimpleTaxon]
lnodes)
        unfilteredTaxonomySubTree :: Gr SimpleTaxon Double
unfilteredTaxonomySubTree = [LNode SimpleTaxon] -> [LEdge Double] -> Gr SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode SimpleTaxon]
lnodes [LEdge Double]
ledges :: Gr SimpleTaxon Double
        filteredLNodes :: [LNode SimpleTaxon]
filteredLNodes = Maybe Int
-> [LNode SimpleTaxon]
-> Gr SimpleTaxon Double
-> [LNode SimpleTaxon]
filterNodesByLevel Maybe Int
levelNumber [LNode SimpleTaxon]
lnodes Gr SimpleTaxon Double
unfilteredTaxonomySubTree
        filteredledges :: [LEdge Double]
filteredledges = [LEdge Double] -> [LEdge Double]
forall a. Eq a => [a] -> [a]
nub ((LNode SimpleTaxon -> [LEdge Double])
-> [LNode SimpleTaxon] -> [LEdge Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Gr SimpleTaxon Double -> Int -> [LEdge Double]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out Gr SimpleTaxon Double
graph (Int -> [LEdge Double])
-> (LNode SimpleTaxon -> Int)
-> LNode SimpleTaxon
-> [LEdge Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode SimpleTaxon -> Int
forall a b. (a, b) -> a
fst) [LNode SimpleTaxon]
filteredLNodes)
        taxonomySubTree :: Gr SimpleTaxon Double
taxonomySubTree = [LNode SimpleTaxon] -> [LEdge Double] -> Gr SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode SimpleTaxon]
filteredLNodes [LEdge Double]
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 :: [Int]
-> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double
extractTaxonomySubTreebyLevelNew [Int]
inputNodes Gr SimpleTaxon Double
graph Maybe Int
levelNumber = Gr SimpleTaxon Double
taxonomySubTree
  where inputNodeVector :: Vector Int
inputNodeVector = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int]
inputNodes
        paths :: Vector Int
paths = (Int -> Vector Int) -> Vector Int -> Vector Int
forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap (Int -> Gr SimpleTaxon Double -> Int -> Vector Int
getVectorPath (Int
1 :: Node) Gr SimpleTaxon Double
graph) Vector Int
inputNodeVector
        contexts :: Vector (Context SimpleTaxon Double)
contexts = (Int -> Context SimpleTaxon Double)
-> Vector Int -> Vector (Context SimpleTaxon Double)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Gr SimpleTaxon Double -> Int -> Context SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context Gr SimpleTaxon Double
graph) Vector Int
paths
        vlnodes :: Vector (LNode SimpleTaxon)
vlnodes = (Context SimpleTaxon Double -> LNode SimpleTaxon)
-> Vector (Context SimpleTaxon Double)
-> Vector (LNode SimpleTaxon)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Context SimpleTaxon Double -> LNode SimpleTaxon
forall a b. Context a b -> LNode a
labNode' Vector (Context SimpleTaxon Double)
contexts
        ledges :: [LEdge Double]
ledges = (LNode SimpleTaxon -> [LEdge Double])
-> [LNode SimpleTaxon] -> [LEdge Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Gr SimpleTaxon Double -> Int -> [LEdge Double]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out Gr SimpleTaxon Double
graph (Int -> [LEdge Double])
-> (LNode SimpleTaxon -> Int)
-> LNode SimpleTaxon
-> [LEdge Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode SimpleTaxon -> Int
forall a b. (a, b) -> a
fst) [LNode SimpleTaxon]
lnodes
        lnodes :: [LNode SimpleTaxon]
lnodes = Vector (LNode SimpleTaxon) -> [LNode SimpleTaxon]
forall a. Vector a -> [a]
V.toList Vector (LNode SimpleTaxon)
vlnodes
        --ledges = V.toList vledges
        unfilteredTaxonomySubTree :: Gr SimpleTaxon Double
unfilteredTaxonomySubTree = [LNode SimpleTaxon] -> [LEdge Double] -> Gr SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode SimpleTaxon]
lnodes [LEdge Double]
ledges :: Gr SimpleTaxon Double
        filteredLNodes :: [LNode SimpleTaxon]
filteredLNodes = Maybe Int
-> [LNode SimpleTaxon]
-> Gr SimpleTaxon Double
-> [LNode SimpleTaxon]
filterNodesByLevel Maybe Int
levelNumber [LNode SimpleTaxon]
lnodes Gr SimpleTaxon Double
unfilteredTaxonomySubTree
        --filteredLNodesVector = V.fromList filteredLNodes
        filteredledges :: [LEdge Double]
filteredledges = (LNode SimpleTaxon -> [LEdge Double])
-> [LNode SimpleTaxon] -> [LEdge Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Gr SimpleTaxon Double -> Int -> [LEdge Double]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out Gr SimpleTaxon Double
graph (Int -> [LEdge Double])
-> (LNode SimpleTaxon -> Int)
-> LNode SimpleTaxon
-> [LEdge Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode SimpleTaxon -> Int
forall a b. (a, b) -> a
fst) [LNode SimpleTaxon]
filteredLNodes
        --filteredledges = V.toList filteredledgesVector
        taxonomySubTree :: Gr SimpleTaxon Double
taxonomySubTree = [LNode SimpleTaxon] -> [LEdge Double] -> Gr SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode SimpleTaxon]
filteredLNodes [LEdge Double]
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 :: [Int]
-> Gr SimpleTaxon Double -> Maybe Rank -> Gr SimpleTaxon Double
extractTaxonomySubTreebyRank [Int]
inputNodes Gr SimpleTaxon Double
graph Maybe Rank
highestRank = Gr SimpleTaxon Double
taxonomySubTree
  where paths :: [Int]
paths = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ((Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Gr SimpleTaxon Double -> Int -> [Int]
getPath (Int
1 :: Node) Gr SimpleTaxon Double
graph) [Int]
inputNodes)
        contexts :: [Context SimpleTaxon Double]
contexts = (Int -> Context SimpleTaxon Double)
-> [Int] -> [Context SimpleTaxon Double]
forall a b. (a -> b) -> [a] -> [b]
map (Gr SimpleTaxon Double -> Int -> Context SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context Gr SimpleTaxon Double
graph) [Int]
paths
        lnodes :: [LNode SimpleTaxon]
lnodes = (Context SimpleTaxon Double -> LNode SimpleTaxon)
-> [Context SimpleTaxon Double] -> [LNode SimpleTaxon]
forall a b. (a -> b) -> [a] -> [b]
map Context SimpleTaxon Double -> LNode SimpleTaxon
forall a b. Context a b -> LNode a
labNode' [Context SimpleTaxon Double]
contexts
        filteredLNodes :: [LNode SimpleTaxon]
filteredLNodes = Maybe Rank -> [LNode SimpleTaxon] -> [LNode SimpleTaxon]
forall t. Maybe Rank -> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
filterNodesByRank Maybe Rank
highestRank [LNode SimpleTaxon]
lnodes
        filteredledges :: [LEdge Double]
filteredledges = [LEdge Double] -> [LEdge Double]
forall a. Eq a => [a] -> [a]
nub ((LNode SimpleTaxon -> [LEdge Double])
-> [LNode SimpleTaxon] -> [LEdge Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Gr SimpleTaxon Double -> Int -> [LEdge Double]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out Gr SimpleTaxon Double
graph (Int -> [LEdge Double])
-> (LNode SimpleTaxon -> Int)
-> LNode SimpleTaxon
-> [LEdge Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode SimpleTaxon -> Int
forall a b. (a, b) -> a
fst) [LNode SimpleTaxon]
filteredLNodes)
        taxonomySubTree :: Gr SimpleTaxon Double
taxonomySubTree = [LNode SimpleTaxon] -> [LEdge Double] -> Gr SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode SimpleTaxon]
filteredLNodes [LEdge Double]
filteredledges :: Gr SimpleTaxon Double

getVectorPath :: Node -> Gr SimpleTaxon Double -> Node -> V.Vector Node
getVectorPath :: Int -> Gr SimpleTaxon Double -> Int -> Vector Int
getVectorPath Int
root Gr SimpleTaxon Double
graph Int
node =  Vector Int -> ([Int] -> Vector Int) -> Maybe [Int] -> Vector Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Int
forall a. Vector a
V.empty [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList (Int -> Int -> Gr SimpleTaxon Double -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp Int
node Int
root Gr SimpleTaxon Double
graph)

getPath :: Node -> Gr SimpleTaxon Double -> Node -> Path
getPath :: Int -> Gr SimpleTaxon Double -> Int -> [Int]
getPath Int
root Gr SimpleTaxon Double
graph Int
node =  [Int] -> ([Int] -> [Int]) -> Maybe [Int] -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Int] -> [Int]
forall a. a -> a
id (Int -> Int -> Gr SimpleTaxon Double -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp Int
node Int
root Gr SimpleTaxon Double
graph)

-- | Extract parent node with specified Rank
getParentbyRank :: Node -> Gr SimpleTaxon Double -> Maybe Rank -> Maybe (Node, SimpleTaxon)
getParentbyRank :: Int
-> Gr SimpleTaxon Double -> Maybe Rank -> Maybe (LNode SimpleTaxon)
getParentbyRank Int
inputNode Gr SimpleTaxon Double
graph Maybe Rank
requestedRank = Maybe (LNode SimpleTaxon)
filteredLNode
  where path :: [Int]
path =  [Int] -> ([Int] -> [Int]) -> Maybe [Int] -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Int] -> [Int]
forall a. a -> a
id (Int -> Int -> Gr SimpleTaxon Double -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp (Int
inputNode :: Node) (Int
1 :: Node) Gr SimpleTaxon Double
graph)
        nodeContext :: [Context SimpleTaxon Double]
nodeContext = (Int -> Context SimpleTaxon Double)
-> [Int] -> [Context SimpleTaxon Double]
forall a b. (a -> b) -> [a] -> [b]
map (Gr SimpleTaxon Double -> Int -> Context SimpleTaxon Double
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context Gr SimpleTaxon Double
graph) [Int]
path
        lnode :: [LNode SimpleTaxon]
lnode = (Context SimpleTaxon Double -> LNode SimpleTaxon)
-> [Context SimpleTaxon Double] -> [LNode SimpleTaxon]
forall a b. (a -> b) -> [a] -> [b]
map Context SimpleTaxon Double -> LNode SimpleTaxon
forall a b. Context a b -> LNode a
labNode' [Context SimpleTaxon Double]
nodeContext
        filteredLNode :: Maybe (LNode SimpleTaxon)
filteredLNode = Maybe Rank -> [LNode SimpleTaxon] -> Maybe (LNode SimpleTaxon)
forall t.
Maybe Rank -> [(t, SimpleTaxon)] -> Maybe (t, SimpleTaxon)
findNodeByRank Maybe Rank
requestedRank [LNode SimpleTaxon]
lnode

-- | Filter nodes by distance from root
filterNodesByLevel :: Maybe Int -> [(Node, SimpleTaxon)] -> Gr SimpleTaxon Double -> [(Node, SimpleTaxon)]
filterNodesByLevel :: Maybe Int
-> [LNode SimpleTaxon]
-> Gr SimpleTaxon Double
-> [LNode SimpleTaxon]
filterNodesByLevel Maybe Int
levelNumber [LNode SimpleTaxon]
inputNodes Gr SimpleTaxon Double
graph
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
levelNumber = [LNode SimpleTaxon]
filteredNodes
  | Bool
otherwise = [LNode SimpleTaxon]
inputNodes
    --distances of all nodes to root
    where nodedistances :: [(Int, Int)]
nodedistances = Int -> Gr SimpleTaxon Double -> [(Int, Int)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> [(Int, Int)]
level (Int
1::Node) (Gr SimpleTaxon Double -> Gr SimpleTaxon Double
forall b (gr :: * -> * -> *) a.
(Eq b, DynGraph gr) =>
gr a b -> gr a b
undir Gr SimpleTaxon Double
graph)
          sortedNodeDistances :: [(Int, Int)]
sortedNodeDistances = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, Int) -> (Int, Int) -> Ordering
forall a. (Int, a) -> (Int, a) -> Ordering
sortByNodeID [(Int, Int)]
nodedistances
          sortedInputNodes :: [LNode SimpleTaxon]
sortedInputNodes = (LNode SimpleTaxon -> LNode SimpleTaxon -> Ordering)
-> [LNode SimpleTaxon] -> [LNode SimpleTaxon]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LNode SimpleTaxon -> LNode SimpleTaxon -> Ordering
forall a. (Int, a) -> (Int, a) -> Ordering
sortByNodeID [LNode SimpleTaxon]
inputNodes
          zippedNodeDistancesInputNodes :: [((Int, Int), LNode SimpleTaxon)]
zippedNodeDistancesInputNodes = [(Int, Int)]
-> [LNode SimpleTaxon] -> [((Int, Int), LNode SimpleTaxon)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
sortedNodeDistances [LNode SimpleTaxon]
sortedInputNodes
          zippedFilteredNodes :: [((Int, Int), LNode SimpleTaxon)]
zippedFilteredNodes = (((Int, Int), LNode SimpleTaxon) -> Bool)
-> [((Int, Int), LNode SimpleTaxon)]
-> [((Int, Int), LNode SimpleTaxon)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((Int
_,Int
distance),(Int
_,SimpleTaxon
_)) -> Int
distance Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
levelNumber) [((Int, Int), LNode SimpleTaxon)]
zippedNodeDistancesInputNodes
          filteredNodes :: [LNode SimpleTaxon]
filteredNodes = (((Int, Int), LNode SimpleTaxon) -> LNode SimpleTaxon)
-> [((Int, Int), LNode SimpleTaxon)] -> [LNode SimpleTaxon]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), LNode SimpleTaxon) -> LNode SimpleTaxon
forall a b. (a, b) -> b
snd [((Int, Int), LNode SimpleTaxon)]
zippedFilteredNodes

sortByNodeID :: (Node,a) -> (Node,a) -> Ordering
sortByNodeID :: (Int, a) -> (Int, a) -> Ordering
sortByNodeID (Int
n1, a
_) (Int
n2, a
_)
  | Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2 = Ordering
GT
  | Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2 = Ordering
LT
  | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 = Ordering
EQ
  | Bool
otherwise = Ordering
EQ

-- | Find only taxons of a specific rank in a list of input taxons
findNodeByRank :: Maybe Rank -> [(t, SimpleTaxon)] -> Maybe (t, SimpleTaxon)
findNodeByRank :: Maybe Rank -> [(t, SimpleTaxon)] -> Maybe (t, SimpleTaxon)
findNodeByRank Maybe Rank
requestedRank [(t, SimpleTaxon)]
inputNodes
  | Maybe Rank -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rank
requestedRank = Maybe (t, SimpleTaxon)
filteredNodes
  | Bool
otherwise = Maybe (t, SimpleTaxon)
forall a. Maybe a
Nothing
    where filteredNodes :: Maybe (t, SimpleTaxon)
filteredNodes = ((t, SimpleTaxon) -> Bool)
-> [(t, SimpleTaxon)] -> Maybe (t, SimpleTaxon)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(t
_,SimpleTaxon
t) -> SimpleTaxon -> Rank
simpleRank SimpleTaxon
t Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Rank -> Rank
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rank
requestedRank) [(t, SimpleTaxon)]
inputNodes

-- | Filter a list of input taxons for a minimal provided rank
filterNodesByRank :: Maybe Rank -> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
filterNodesByRank :: Maybe Rank -> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
filterNodesByRank Maybe Rank
highestRank [(t, SimpleTaxon)]
inputNodes
  | Maybe Rank -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rank
highestRank = [(t, SimpleTaxon)]
filteredNodes
  | Bool
otherwise = [(t, SimpleTaxon)]
inputNodes
    where filteredNodes :: [(t, SimpleTaxon)]
filteredNodes = ((t, SimpleTaxon) -> Bool)
-> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(t
_,SimpleTaxon
t) -> SimpleTaxon -> Rank
simpleRank SimpleTaxon
t Rank -> Rank -> Bool
forall a. Ord a => a -> a -> Bool
>= Maybe Rank -> Rank
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rank
highestRank) [(t, SimpleTaxon)]
inputNodes [(t, SimpleTaxon)] -> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
forall a. [a] -> [a] -> [a]
++ [(t, SimpleTaxon)]
noRankNodes
          noRankNodes :: [(t, SimpleTaxon)]
noRankNodes = ((t, SimpleTaxon) -> Bool)
-> [(t, SimpleTaxon)] -> [(t, SimpleTaxon)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(t
_,SimpleTaxon
t) -> SimpleTaxon -> Rank
simpleRank SimpleTaxon
t Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Norank) [(t, SimpleTaxon)]
inputNodes

-- | Returns path between 2 maybe nodes. Used in TreeDistance tool.
safeNodePath :: Maybe Node -> Gr SimpleTaxon Double -> Maybe Node -> Either String Path
safeNodePath :: Maybe Int
-> Gr SimpleTaxon Double -> Maybe Int -> Either String [Int]
safeNodePath Maybe Int
nodeid1 Gr SimpleTaxon Double
graphOutput Maybe Int
nodeid2
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
nodeid1 Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
nodeid2 = [Int] -> Either String [Int]
forall a b. b -> Either a b
Right  ([Int] -> ([Int] -> [Int]) -> Maybe [Int] -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Int] -> [Int]
forall a. a -> a
id (Int -> Int -> Gr SimpleTaxon Double -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeid1) (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeid2) (Gr SimpleTaxon Double -> Gr SimpleTaxon Double
forall b (gr :: * -> * -> *) a.
(Eq b, DynGraph gr) =>
gr a b -> gr a b
undir Gr SimpleTaxon Double
graphOutput)))
  | Bool
otherwise = String -> Either String [Int]
forall a b. a -> Either a b
Left String
"Both taxonomy ids must be provided for distance computation"