module Biobase.Taxonomy.Utils (
module Biobase.Taxonomy.Types,
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
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)
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
extractTaxonomySubTreebyLevel :: [Node] -> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double
[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
extractTaxonomySubTreebyLevelNew :: [Node] -> Gr SimpleTaxon Double -> Maybe Int -> Gr SimpleTaxon Double
[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
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 = (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
extractTaxonomySubTreebyRank :: [Node] -> Gr SimpleTaxon Double -> Maybe Rank -> Gr SimpleTaxon Double
[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)
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
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
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
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
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
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"