tests/Clustering/FrequentItemSet/LCM/closedFrequentItemSets/db=4.minSupp=1.minSize=2.golden
tests/Clustering/FrequentItemSet/LCM/closedFrequentItemSets/db=4.minSupp=2.minSize=1.golden
tests/Clustering/FrequentItemSet/LCM/closedFrequentItemSets/db=4.minSupp=2.minSize=2.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.00.scale=0.3333333333333333333.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.00.scale=0.5000000000000000000.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.00.scale=0.6666666666666666667.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.00.scale=1.0000000000000000000.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.30.scale=0.3333333333333333333.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.30.scale=0.5000000000000000000.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.30.scale=0.6666666666666666667.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=0.30.scale=1.0000000000000000000.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=1.00.scale=0.3333333333333333333.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=1.00.scale=0.5000000000000000000.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=1.00.scale=0.6666666666666666667.golden
+ tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningForest/docs=docs0.minSupp=1.minSize=2.lambda=1.00.scale=1.0000000000000000000.golden
tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningTrees/docs=docs0.minSupp=1.minSize=2.lambda=0.00.golden
tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningTrees/docs=docs0.minSupp=1.minSize=2.lambda=0.30.golden
tests/Phylomemy/TemporalMatchingSpec/dotMaximalSpanningTrees/docs=docs0.minSupp=1.minSize=2.lambda=1.00.golden
import Control.Monad (Monad (..))
import Data.Bool (Bool)
-import Data.Eq (Eq(..))
+import Data.Eq (Eq (..))
import Data.Function (id, on, (.))
import Data.Maybe (Maybe (..), fromJust)
import Data.Monoid (Monoid (..))
import Data.Validity (Validity (..), declare)
import Data.Word (Word64)
import GHC.Generics (Generic)
-import GHC.Real (RealFrac(..))
+import GHC.Real (RealFrac (..))
import GHC.Stack (HasCallStack)
import GHC.TypeNats (Natural, natVal)
import Logic
import Numeric.Decimal qualified as Decimal
import System.Random (Random)
import Text.Show (Show (show))
-import Prelude (Bounded (..), Enum, Fractional (..), Integral, Num (..), Rational, Real(..), error, (^))
+import Prelude (Bounded (..), Enum, Fractional (..), Integral, Num (..), Rational, Real (..), error, (^))
type Probability = Decimal Decimal.RoundHalfEven ProbabilityScale ProbabilityBounded
instance Validity Probability where
(/) = Decimal.bindM2 Decimal.divideDecimalBoundedWithRounding
fromRational = probability
+{- HasCallStack does not work well for those
+
instance Eq (Decimal.Arith Probability) where
- --(==) :: HasCallStack => Decimal.Arith Probability -> Decimal.Arith Probability -> Bool
+ (==) :: HasCallStack => Decimal.Arith Probability -> Decimal.Arith Probability -> Bool
(==) = (==) `on` Decimal.arithError
instance Ord (Decimal.Arith Probability) where
- --compare :: HasCallStack => Decimal.Arith Probability -> Decimal.Arith Probability -> Ordering
+ compare :: HasCallStack => Decimal.Arith Probability -> Decimal.Arith Probability -> Ordering
compare = compare `on` Decimal.arithError
instance Real (Decimal.Arith Probability) where
properFraction p = (n, return (assertProbability f))
where
(n,f) = properFraction (Decimal.toRationalDecimal (Decimal.arithError p))
+-}
-- >>> 10^19 <= (fromIntegral (maxBound :: Word64) :: Integer
-- True
module Phylomemy.DOT where
--- import Debug.Pretty.Simple (pTraceShow, pTraceShowM)
import Control.Applicative (Applicative (..))
import Control.Monad (Monad (..), foldM_, forM_, mapM_, when, zipWithM_)
import Control.Monad.Trans.Class qualified as MT
import Control.Monad.Trans.Reader qualified as MT
import Control.Monad.Trans.Writer.CPS qualified as MT
-import Data.Bool (otherwise)
+import Data.Bool (otherwise, (&&))
import Data.ByteString.Builder qualified as BS
import Data.ByteString.Short qualified as BSh
import Data.Eq (Eq (..))
import Data.Foldable (foldMap', toList)
-import Data.Function (on, ($), (&), (.))
+import Data.Function (id, on, ($), (&), (.))
import Data.Functor ((<&>))
import Data.Int (Int)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
-import Data.Maybe (Maybe (..), maybe)
+import Data.Maybe (Maybe (..), fromMaybe)
import Data.Monoid (Monoid (..))
import Data.Ord (Ord (..))
-import Data.Semigroup (Semigroup (..))
+import Data.Semigroup (Min (..), Semigroup (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (String)
+import Data.Text.Lazy qualified as LazyText
+import Data.Text.Lazy.Encoding qualified as LazyText
import Data.Text.Short qualified as TS
import Data.Tree qualified as Tree
-import Data.Tuple (snd)
+import Debug.Pretty.Simple (pTraceShow)
import GHC.Real (floor)
+import GHC.Stack (HasCallStack)
import Numeric (showFFloat)
import Numeric.Probability
+import Text.Pretty.Simple (pShow)
import Text.Printf (printf)
import Text.Show (Show (..))
import Prelude
import Phylomemy.Indexation
import Phylomemy.TemporalMatching
--- | @(`dotMaximalSpanningForest` msf)@
+type MST = Int
+type ClusterGroup = Int
+
+-- | @(`dotMaximalSpanningForest` scaleToMsf)@
-- returns a graph of the given `MaximalSpanningForest`
-- in [DOT](https://graphviz.org/doc/info/lang.html) format.
+--
+-- Each maximal spanning tree is here pruned of its edges
+-- from the lowest `Similarity` it contains, to the highest,
+-- each level is called a `Scale`, and groups `(range, cluster)` differently,
+-- hence this actually returns a `Map.Map` of `Scale` to graph.
dotMaximalSpanningForest ::
forall range cluster.
+ HasCallStack =>
+ cluster ~ Cluster =>
Show range =>
Show cluster =>
Ord range =>
ShowHuman range =>
ShowHuman cluster =>
MaximalSpanningForest range cluster ->
- BS.Builder
-dotMaximalSpanningForest msf = runDOT do
- let sortedMSF = msf & List.sortBy (compare `on` mstNodeRangeCluster . Tree.rootLabel)
- let rangeToMSTToClusters :: range :-> {-mstI-} Int :-> (Maybe Similarity, Set cluster) =
- let merge = Map.unionWith \(minSimil, x) (_minSimil, y) -> (minSimil, Set.union x y)
+ Int :-> BS.Builder
+dotMaximalSpanningForest msf =
+ -- pTraceShow ("scaleToRangeToMstToGroupToClusters", Map.findMin scaleToRangeToMstToGroupToClusters) $
+ scaleToRangeToMstToGroupToClusters
+ & Map.mapWithKey \scaleI rangeToMstToGroupToClusters -> runDOT do
+ -- forM_ (similToRangeToMstToGroupToClusters & Map.toList) \(minSimil, rangeToMstToGroupToClusters) -> do
+ dotComments [(BS.lazyByteString $ LazyText.encodeUtf8 $ pShow $ rangeToMstToGroupToClusters & Map.map Map.keys)]
+ -- pTraceShow ("num of nodes", Map.size nodeToBranch, "num of branches", Map.size msf) $
+ dotLine "digraph g"
+ dotBlock do
+ dotLine "splines=\"ortho\""
+ indexFrom1M_ (rangeToMstToGroupToClusters & Map.toList) \(srcR, mstToGroupToClusters) srcRI -> do
+ let srcRB = "r" <> BS.intDec srcRI
+ dotLine $ "subgraph cluster_" <> srcRB
+ dotBlock do
+ dotComments ["Create a node for the range " <> srcRB]
+ dotNode
+ srcRB
+ [ ("shape", "box")
+ , ("label", builderQuotedString (showHuman srcR))
+ , ("color", "gray")
+ , ("style", "filled")
+ , ("fillcolor", "gray")
+ ]
+ dotLine "color=gray"
+ dotBlock do
+ dotLine "rank=same"
+ dotComments ["Create the cluster nodes within the range " <> srcRB]
+ forM_ (mstToGroupToClusters & Map.toList) \(mstI, groupToClusters) -> do
+ forM_ (groupToClusters & Map.toList) \(srcGroup, srcClusters) -> do
+ dotNodeCluster
+ srcRI
+ mstI
+ srcGroup
+ [
+ ( "label"
+ , builderQuotedString $
+ (srcClusters & toList <&> showHuman & List.unlines)
+ <> "\nT"
+ <> printf "%03d" mstI
+ <> "\nS"
+ <> show scaleI
+ -- <> {-maybe ""-} (("\n" <>) . showSimilarity) minSimil
+ )
+ , ("style", "filled")
+ , -- , minSimil & {-maybe ("", "")-} (\s -> ("fillcolor", 1 + ((floor (runProbability s * 10)) `mod` 10) & BS.intDec))
+ ("colorscheme", "ylorrd9")
+ , ("shape", "box")
+ ]
+ dotComments ["Horizontally align the cluster nodes within the same range"]
+ let row =
+ [ (mstI, group)
+ | (mstI, groupToClusters) <- mstToGroupToClusters & Map.toList
+ , (group, _clusters) <- groupToClusters & Map.toList
+ ]
+ case row of
+ [] -> return ()
+ c@(firstMst, firstGroup) : cs -> do
+ dotEdges
+ [srcRB, srcRB <> "t" <> BS.intDec firstMst <> "c" <> BS.intDec firstGroup]
+ [ ("style", "invis")
+ ]
+ cs & (`foldM_` c) \(srcMst, srcGroup) dst@(dstMst, dstGroup) -> do
+ dotEdgesCluster
+ [(srcRI, srcMst, srcGroup), (srcRI, dstMst, dstGroup)]
+ [ ("weight", "10")
+ , ("style", "invis")
+ ]
+ return dst
+ indexFrom1M_ sortedMSF \mst mstI -> do
+ dotComments ["Create the edges of the MST " <> BS.intDec mstI]
+ -- pTraceShowM (mstI, List.length (Tree.flatten mst))
+ let loop (Tree.Node MSTNode{mstNodeRangeCluster = src} dsts) = do
+ forM_ dsts \dstNode@(Tree.Node MSTNode{mstNodeRangeCluster = dst, mstNodeSimilarity = simil} _) -> do
+ -- let similB = BS.stringUtf8 $ showFFloat (Just 2) (simil & runProbability & fromRational @Double) ""
+ let indexRangeCluster (r, c) =
+ let clusterToGroup :: cluster :-> ClusterGroup =
+ Map.fromList
+ [ (cluster, group)
+ | (group, clusters) <-
+ rangeToMstToGroupToClusters
+ & Map.lookup r
+ & fromMaybe Map.empty
+ & Map.lookup mstI
+ & fromMaybe Map.empty
+ & Map.toList
+ , cluster <- clusters & Set.toList
+ ]
+ in ( 1 + Map.findIndex r rangeToMstToGroupToClusters
+ , mstI
+ , Map.lookup c clusterToGroup
+ & fromMaybe (error (LazyText.unpack (pShow ("r", r, "c", c {-, "clusterToGroup", clusterToGroup, "rangeToMstToGroupToClusters", rangeToMstToGroupToClusters-}))))
+ )
+ dotEdgesCluster
+ [ indexRangeCluster src
+ , indexRangeCluster dst
+ ]
+ [ ("constraint", "false")
+ , ("color", (floor (runProbability simil * 10)) `mod` 10 & BS.intDec)
+ , ("colorscheme", "ylorrd9")
+ , -- , ("label", similB)
+ ("fontcolor", "blue")
+ , ("dir", "both")
+ , ("arrowhead", "dot")
+ , ("arrowtail", "dot")
+ ]
+ loop dstNode
+ loop mst
+ dotRanges rangeToMstToGroupToClusters
+ where
+ -- TODO: improve this, this is just a quick attempt to stabilize the DOT
+ sortedMSF = msf & List.sortBy (compare `on` mstNodeRangeCluster . Tree.rootLabel)
+ -- Deep remapping of the `msf` to something more suitable for generating the DOT
+ scaleToRangeToMstToGroupToClusters ::
+ {-scale-} Int :-> range :-> MST :-> ClusterGroup :-> Set cluster =
+ let merge = Map.unionWith (Map.unionWith (Map.unionWith Set.union))
in Map.unionsWith
merge
- [ Map.fromListWith merge $
- case mst of
- Tree.Node MSTNode{mstNodeRangeCluster = (rootR, rootC)} ts ->
- (rootR, Map.singleton mstI (minSimil, Set.singleton rootC))
- : [ (range, Map.singleton mstI (minSimil, Set.singleton cluster))
- | MSTNode{mstNodeRangeCluster = (range, cluster)} <- ts & List.concatMap toList
- ]
- | (mstI, mst) <- sortedMSF & List.zip [1 :: Int ..]
- , let minSimil = mstMinimalSimilarity mst
- ]
- let showSimilarity (s :: Similarity) = showFFloat (Just 2) (s & runProbability & fromRational @Double) ""
- dotComments [(BS.stringUtf8 $ show $ rangeToMSTToClusters & Map.map Map.keys)]
- -- pTraceShow ("num of nodes", Map.size nodeToBranch, "num of branches", Map.size msf) $
- dotLine "digraph g"
- dotBlock do
- dotLine "splines=\"ortho\""
- indexFrom1M_ (rangeToMSTToClusters & Map.toList) \(srcR, mstToClusters) srcRI -> do
- let srcRB = "r" <> BS.intDec srcRI
- dotLine $ "subgraph cluster_" <> srcRB
- dotBlock do
- dotComments ["Create a node for the range " <> srcRB]
- dotNode
- srcRB
- [ ("shape", "box")
- , ("label", builderQuotedString (showHuman srcR))
- , ("color", "gray")
- , ("style", "filled")
- , ("fillcolor", "gray")
- ]
- dotLine "color=gray"
- dotBlock do
- dotLine "rank=same"
- dotComments ["Create the cluster nodes within the range " <> srcRB]
- forM_ (mstToClusters & Map.toList) \(mstI, (minSimil, clusters)) -> do
- indexFrom1M_ (clusters & toList) \srcC srcCI -> do
- dotNodeCluster
- srcRI
- mstI
- srcCI
- [ ("label", builderQuotedString $ showHuman srcC <> "\nT" <> printf "%03d" mstI <> maybe "" (("\n" <>) . showSimilarity) minSimil)
- , ("style", "filled")
- , minSimil & maybe ("", "") (\s -> ("fillcolor", 1 + ((floor (runProbability s * 10)) `mod` 10) & BS.intDec))
- , ("colorscheme", "ylorrd9")
- , ("shape", "box")
- ]
- dotComments ["Horizontally align the cluster nodes within the same range"]
- let row =
- [ (mstI, clusterI)
- | (mstI, (_minSimil, clusters)) <- mstToClusters & Map.toList
- , clusterI <- [1 .. Set.size clusters]
- ]
- case row of
- [] -> return ()
- c@(firstTI, firstCI) : cs -> do
- dotEdges
- [srcRB, srcRB <> "t" <> BS.intDec firstTI <> "c" <> BS.intDec firstCI]
- [ ("style", "invis")
- ]
- cs & (`foldM_` c) \(srcTI, srcCI) dst@(dstTI, dstCI) -> do
- dotEdgesCluster
- [(srcRI, srcTI, srcCI), (srcRI, dstTI, dstCI)]
- [ ("weight", "10")
- , ("style", "invis")
+ [ Map.unionsWith
+ merge
+ [ Map.unionsWith
+ merge
+ [ Map.fromListWith merge $
+ [ {-(if scaleI == 3
+ then pTraceShow (["scaleToRangeToMstToGroupToClusters"], "scaleI", scaleI, "scaleSimil", scaleSimil, "range", range, "mstI", mstI, "clusterGroup", clusterGroup, "cluster", cluster)
+ else id) $-}
+ (scaleI,) $
+ Map.singleton range $
+ Map.singleton mstI $
+ Map.singleton clusterGroup $
+ Set.singleton cluster
+ | MSTNode{mstNodeRangeCluster = (range, cluster)} <- scaleMST & toList
]
- return dst
- indexFrom1M_ sortedMSF \mst mstI -> do
- dotComments ["Create the edges of the MST " <> BS.intDec mstI]
- -- pTraceShowM (mstI, List.length (Tree.flatten mst))
- let loop (Tree.Node MSTNode{mstNodeRangeCluster = src} dsts) = do
- forM_ dsts \dstNode@(Tree.Node MSTNode{mstNodeRangeCluster = dst, mstNodeSimilarity = simil} _) -> do
- -- let similB = BS.stringUtf8 $ showFFloat (Just 2) (simil & runProbability & fromRational @Double) ""
- let indexRangeCluster (r, c) =
- ( 1 + Map.findIndex r rangeToMSTToClusters
- , mstI
- , 1 + Set.findIndex c (rangeToMSTToClusters Map.! r Map.! mstI & snd)
- )
- dotEdgesCluster
- [ indexRangeCluster src
- , indexRangeCluster dst
- ]
- [ ("constraint", "false")
- , ("color", (floor (runProbability simil * 10)) `mod` 10 & BS.intDec)
- , ("colorscheme", "ylorrd9")
- , -- , ("label", similB)
- ("fontcolor", "blue")
- , ("dir", "both")
- , ("arrowhead", "dot")
- , ("arrowtail", "dot")
+ | (clusterGroup, scaleMST) <-
+ -- (if mstI == 2 then pTraceShow ("scaleI", scaleI, "scaleMSF", scaleMSF) else id) $
+ scaleMsf & List.zip [1 :: ClusterGroup ..]
]
- loop dstNode
- loop mst
- dotRanges rangeToMSTToClusters
+ | (mstI, scaleMsf) <- mstToMsf & Map.toList
+ ]
+ | (scaleI, mstToMsf) <- mstScales sortedMSF & Map.toList
+ ]
+ showSimilarity (s :: Similarity) = showFFloat (Just 2) (s & runProbability & fromRational @Double) ""
dotRanges :: range :-> a -> DOT
dotRanges rangeTo = do
MT.lift $ MT.tell $ BS.shortByteString indent <> s <> "\n"
dotComments :: [BS.Builder] -> DOT
-dotComments = mapM_ \c -> dotLine $ "// " <> c
+dotComments cs = do
+ dotLine "/*"
+ forM_ cs dotLine
+ dotLine "*/"
dotEdges :: [BS.Builder] -> [(BS.Builder, BS.Builder)] -> DOT
dotEdges names as = dotLine $ mconcat (List.intersperse " -> " names) <> builderAttrs as
module Phylomemy.TemporalMatching where
--- import Data.Traversable (traverse)
--- import Debug.Pretty.Simple (pTraceShow, pTraceShowId)
+-- import Debug.Pretty.Simple (pTraceShow)
import Control.Monad (Monad (..), foldM, forM_, unless)
import Control.Monad.ST qualified as ST
import Data.Bool (otherwise)
-- is the crux of understanding how it is computed:
--
-- - the `mstMinimalSimilarity` is the next `Similarity`
--- that will split the `MaximalSpanningTree` into two or more `MaximalSpanningForest`.
+-- that will split the `MaximalSpanningTree` into two or more `MaximalSpanningTree`s.
--
-- - it explains what the "scale of a phylomemy" is:
--- merging clusters of the same range and same `MaximalSpanningTree`
+-- merging clusters of the same `range`
-- when they still belong to the same `MaximalSpanningTree`.
--
-- ImplementationNote: using a `Tree.Tree` to represent a `MaximalSpanningTree`
-- (instead of an adjacency edge map for instance)
-- is motivated by the need to implement `mstSplit`,
-- which needs to gather the `(range, cluster)` nodes
--- of the `MaximalSpanningForest` resulting from the cut,
--- which will then be filtered by `msfGlobalQuality`.
+-- of each `MaximalSpanningTree` resulting from the cut,
+-- because knowing that is required by `msfGlobalQuality`.
--
-- TODO: "Inadequacies of Minimum Spanning Trees in Molecular Epidemiology"
-- https://www.ncbi.nlm.nih.gov/pmc/articles/PMC3187300/
-- ImplementationNote: `maximalSpanningForest` puts a `Similarity` of `1` for the root node.
-- and `mstSplit` leaves the `mstMinimalSimilarity` of the edge before splitting out the `MaximalSpanningTree`.
, mstNodeRangeCluster :: (range, cluster)
- -- , nodeMSTMinSimilarity :: Min Similarity
}
deriving (Show)
type MaximalSpanningForest range cluster =
[MaximalSpanningTree range cluster]
--- | @(`maximalSpanningForest` allSimils)@
--- uses the Kruskal algorithm to find the maximal spanning trees
--- of the given `AllSimilarities`.
+-- | @(`maximalSpanningForest` similarity rangeToClusterToDocs)@
+-- uses the Kruskal algorithm to find the trees spanning all
+-- the given `(range, cluster)` nodes in `rangeToClusterToDocs`
+-- with the maximal total `similarity` between them.
--
-- ExplanationNote: https://en.wikipedia.org/wiki/Kruskal's_algorithm
maximalSpanningForest ::
forall range cluster doc.
+ HasCallStack =>
Ord range =>
Ord cluster =>
{-similarityMeasure :::-} (cluster -> cluster -> Similarity) ->
--
-- See: in `Phylomemy.References.RefDrawMeScience`,
-- « C.5 The sea-level rise algorithm and its implementation in Gargantext »
-msfSplit ::
- HasCallStack =>
+msfPrune ::
forall range roots predictionMeasure.
+ HasCallStack =>
Show range =>
Ord range =>
predictionMeasure ::: (Set (range, Cluster) -> Set (range, Cluster) -> Decimal.Arith Similarity) ->
roots ::: Set Root ->
MaximalSpanningForest range Cluster ->
MaximalSpanningForest range Cluster
-msfSplit predictionMeasure roots =
+msfPrune predictionMeasure roots =
loop (return proba0) []
where
+ loop ::
+ Decimal.Arith Probability ->
+ MaximalSpanningForest range Cluster ->
+ MaximalSpanningForest range Cluster ->
+ MaximalSpanningForest range Cluster
loop previousQuality doneBranches currentBranches =
- -- pTraceShow (["msfSplit", "loop"], ("previousQuality", previousQuality), ("doneBranches", List.length doneBranches), ("todoBranches", List.length currentBranches)) $
+ -- pTraceShow (["msfPrune", "loop"], ("previousQuality", previousQuality), ("doneBranches", List.length doneBranches), ("todoBranches", List.length currentBranches)) $
case currentBranches of
[] -> doneBranches
currentBranch : todoBranches ->
let splitBranches = mstSplit currentBranch
- in -- pTraceShow (["msfSplit", "loop", "splitBranches"], ("size", Map.size splitBranches)) $
+ in -- pTraceShow (["msfPrune", "loop", "splitBranches"], ("size", Map.size splitBranches)) $
if List.length splitBranches <= 1
then loop previousQuality (doneBranches <> splitBranches) todoBranches
else letName (fmap mstNodes $ (doneBranches <> splitBranches) <> todoBranches) \mstToNodes ->
let splitQuality = msfGlobalQuality predictionMeasure roots mstToNodes
- in if previousQuality < splitQuality
- then loop splitQuality doneBranches (splitBranches <> todoBranches)
+ in if Decimal.arithError previousQuality < Decimal.arithError splitQuality
+ then -- CorrectnessFixMe: these `Decimal.arithError` may raise "arithmetic overflow",
+ -- it has to be understood.
+ loop splitQuality doneBranches (splitBranches <> todoBranches)
else loop previousQuality (doneBranches <> splitBranches) todoBranches
+-- | @(`mstSplit` mst)@ returns the `MaximalSpanningTree`s
+-- resulting from pruning out the given `MaximalSpanningTree`
+-- of all the edges having the minimal `Similarity` of that `MaximalSpanningTree`.
mstSplit ::
forall range cluster.
HasCallStack =>
- Show range =>
- Show cluster =>
Ord range =>
Ord cluster =>
MaximalSpanningTree range cluster ->
MaximalSpanningForest range cluster
mstSplit mst =
+ -- TODO: take minSimil as argument to avoid recomputing it when already known
case mstMinimalSimilarity mst of
Nothing -> [mst]
Just minSimil -> cutMerge mst
where
cutMerge = uncurry (:) . cut
- cut :: MaximalSpanningTree range cluster -> (MaximalSpanningTree range cluster, [MaximalSpanningTree range cluster])
+ cut ::
+ MaximalSpanningTree range cluster ->
+ (MaximalSpanningTree range cluster, [MaximalSpanningTree range cluster])
cut (Tree.Node node children) =
let (keptChildren, cutChildren) =
children & List.partition \tree ->
| List.null rootBranches = Nothing
| otherwise =
-- ExplanationNote: the root node of a `MaximalSpanningTree`,
- -- being a root node, does not have parent,
+ -- being a root node, does not have a parent,
-- hence its `mstNodeSimilarity` must be ignored.
Just $
List.minimum $
mstSplittingSimilarities :: MaximalSpanningTree range cluster -> Set Similarity
mstSplittingSimilarities (Tree.Node _rootNode rootBranches)
| List.null rootBranches = Set.empty
- | otherwise = rootBranches & foldMap' (Tree.foldTree \node accs -> Set.unions (Set.singleton (mstNodeSimilarity node) : accs))
+ | otherwise =
+ rootBranches
+ & foldMap'
+ ( Tree.foldTree \node accs ->
+ Set.unions (Set.singleton (mstNodeSimilarity node) : accs)
+ )
+
+type Scale = Int -- > 0
+
+-- | @(`mstScales` msf)@
+-- returns the successive results of calling `mstSplit` on the given `MaximalSpanningTree`s in @(msf)@
+-- until each one of them is a single node.
+-- Even though the greatest `Scale`s may be different for each `MaximalSpanningTree` of @(msf)@,
+-- the result are grouped by `Scale` then by `MaximalSpanningTree`,
+-- which enabled to have a maximal `Scale` for the whole `msf`.
+mstScales ::
+ forall range cluster.
+ Ord range =>
+ Ord cluster =>
+ MaximalSpanningForest range cluster ->
+ Scale :-> {-mst-} Int :-> MaximalSpanningForest range cluster
+mstScales initMSF =
+ Map.unionsWith
+ (Map.unionWith (List.++))
+ [ Map.fromDistinctAscList
+ [ (scale, Map.singleton mstI msf)
+ | (scale, msf) <- scaleToMsf
+ ]
+ | (mstI, mst) <- initMSF & List.zip [1 :: Int ..]
+ , let scaleToMsf :: [(Scale, MaximalSpanningForest range cluster)] =
+ -- scanl :: (acc -> scale -> acc) -> acc -> [scale] -> [acc]
+ splitSimils
+ & Map.keys
+ & List.scanl'
+ (\(scale, msf) _minSimil -> (scale + 1, msf >>= mstSplit))
+ (1, [mst])
+ ]
+ where
+ splitSimils :: Similarity :-> () =
+ Map.unions
+ [ mst
+ & Tree.foldTree \node accs ->
+ Map.unionsWith
+ (\() () -> ())
+ (Map.singleton (mstNodeSimilarity node) () : accs)
+ | mst <- initMSF
+ ]
--- | @(`mstNodes` branch)@ returns the nodes of the given @(branch)@.
+-- | @(`mstNodes` mst)@ returns the nodes of the given @(mst)@.
mstNodes ::
HasCallStack =>
Ord range =>
recall = cardinal relevantRetrievedNodes % cardinal relevantNodes
relevantRetrievedNodes = Set.intersection relevantNodes retrievedNodes
lambdaDouble = lambda & Decimal.toScientificDecimal & toBoundedRealFloat @Double & fromLeft 1
- -- ExplanationNote: the `tan` is just to spread `lambda`
+ -- ExplanationNote: the `tan` is just to spread the `lambda ∈ [0,1]` from -∞ to +∞
-- Two commonly used values for β are:
-- - 2, which weighs recall higher than precision,
-- - and 0.5, which weighs recall lower than precision.
module Phylomemy.TemporalMatchingSpec where
-import Control.Monad (Monad (..), foldM, foldM_, forM_, void)
+import Control.Monad (Monad (..), foldM, foldM_, forM_, void, when)
+import Data.Eq (Eq (..))
import Data.Function (($), (&), (.))
import Data.Functor (Functor (..), (<$>), (<&>))
import Data.GenValidity
import Data.Validity.Text ()
import Debug.Pretty.Simple (pTraceShow, pTraceShowId)
import GHC.IsList (toList)
+import GHC.Stack (HasCallStack)
import Logic
import Numeric (showFFloat)
import Numeric.Natural (Natural)
]
-}
-spec :: Spec
+spec :: HasCallStack => Spec
spec = do
{-
describe "splitMaximalSpanningTree" do
]
]
goldenBuilder ("mst=0" <.> "split=0") $
- dotMaximalSpanningTrees [mst0]
+ dotMaximalSpanningForest [mst0]
goldenBuilder ("mst=0" <.> "split=1") $
- dotMaximalSpanningTrees $
+ dotMaximalSpanningForest $
splitMaximalSpanningTree mst0
goldenBuilder ("mst=0" <.> "split=2") $
- dotMaximalSpanningTrees $
+ dotMaximalSpanningForest $
mst0
& splitMaximalSpanningTree
>>= splitMaximalSpanningTree
goldenBuilder ("mst=0" <.> "split=3") $
- dotMaximalSpanningTrees $
+ dotMaximalSpanningForest $
mst0
& splitMaximalSpanningTree
>>= splitMaximalSpanningTree
let clusters = clusterize roots (assertStrictlyPositive minSupp) (assertStrictlyPositive minSize) rangeToDocs
-- let allSimils = allSimilarities similarityJaccard (clusters <&> unName)
let msf = maximalSpanningForest similarityJaccard (clusters <&> unName)
- describe "dotMaximalSpanningTrees" do
- forM_ ([0, 0.3, 1] :: [Rational]) \lambda -> do
+ describe "dotMaximalSpanningForest" do
+ forM_ ([0.3] :: [Rational]) \lambda -> do
letName (predictionMeasureF (assertProbability lambda)) \predMeasure -> do
- goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "lambda=" <> showFFloat (Just 2) (fromRational @Double lambda) "") $
- dotMaximalSpanningForest $
- msfSplit predMeasure roots msf
+ forM_ (msfPrune predMeasure roots msf & dotMaximalSpanningForest & Map.toList) \(scale, dot) ->
+ -- when (scale == 3) do
+ goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "lambda=" <> showFFloat (Just 2) (fromRational @Double lambda) "" <.> "scale=" <> show scale) dot
--- describe "dotMaximalSpanningTrees" do
+-- describe "dotMaximalSpanningForest" do
-- ([Map.keysSet similToMST | similToMST <- msf & Map.elems] & Set.unions & toList)
-- & (`foldM_` msf) \acc simil -> do
-- let similS = showFFloat Nothing (fromRational @Double (runProbability simil)) ""
-- Map.unionWith (Map.unionWith (Map.unionWith (Seq.><))) $
-- splitMaximalSpanningTree mst
-- goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "simil=" <> similS) $
--- dotMaximalSpanningTrees acc
+-- dotMaximalSpanningForest acc
-- return acc'
-- describe "splitMaximalSpanningTrees" do
-- forM_ ([0] :: [Rational]) \lambda -> do
-- letName (predictionMeasureF (assertProbability lambda)) \predMeasure -> do
-- goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "lambda=" <> showFFloat (Just 2) (fromRational @Double lambda) "") $
--- dotMaximalSpanningTrees $
+-- dotMaximalSpanningForest $
-- splitMaximalSpanningTrees predMeasure roots msf
-- describe "dotSimilarities" do
-- forM_ ([0] :: [Rational]) \lambda -> do
+++ /dev/null
-// fromList [(Pos 1,[1,2,3]),(Pos 2,[4,5,6]),(Pos 3,[7,8]),(Pos 4,[9,10,11,12]),(Pos 5,[13,14,15,16]),(Pos 6,[17,18,19,20,21,22])]
-digraph g
-{
- splines="ortho"
- subgraph cluster_r1
- {
- // Create a node for the range r1
- r1[shape=box,label="1",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r1
- r1t1c1[label="a & b & c
-T001",style=filled,colorscheme=ylorrd9,shape=box]
- r1t2c1[label="a & d & e
-T002",style=filled,colorscheme=ylorrd9,shape=box]
- r1t3c1[label="e & f & g
-T003",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r1 -> r1t1c1[style=invis]
- r1t1c1 -> r1t2c1[weight=10,style=invis]
- r1t2c1 -> r1t3c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r2
- {
- // Create a node for the range r2
- r2[shape=box,label="2",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r2
- r2t4c1[label="a & b
-T004",style=filled,colorscheme=ylorrd9,shape=box]
- r2t5c1[label="a & d
-T005",style=filled,colorscheme=ylorrd9,shape=box]
- r2t6c1[label="d & f
-T006",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r2 -> r2t4c1[style=invis]
- r2t4c1 -> r2t5c1[weight=10,style=invis]
- r2t5c1 -> r2t6c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r3
- {
- // Create a node for the range r3
- r3[shape=box,label="3",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r3
- r3t7c1[label="a & f & g
-T007",style=filled,colorscheme=ylorrd9,shape=box]
- r3t8c1[label="d & f
-T008",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r3 -> r3t7c1[style=invis]
- r3t7c1 -> r3t8c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r4
- {
- // Create a node for the range r4
- r4[shape=box,label="4",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r4
- r4t9c1[label="a & b & c
-T009",style=filled,colorscheme=ylorrd9,shape=box]
- r4t10c1[label="a & d & e
-T010",style=filled,colorscheme=ylorrd9,shape=box]
- r4t11c1[label="b & c
-T011",style=filled,colorscheme=ylorrd9,shape=box]
- r4t12c1[label="b & c & e
-T012",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r4 -> r4t9c1[style=invis]
- r4t9c1 -> r4t10c1[weight=10,style=invis]
- r4t10c1 -> r4t11c1[weight=10,style=invis]
- r4t11c1 -> r4t12c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r5
- {
- // Create a node for the range r5
- r5[shape=box,label="5",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r5
- r5t13c1[label="a & c & d
-T013",style=filled,colorscheme=ylorrd9,shape=box]
- r5t14c1[label="a & f
-T014",style=filled,colorscheme=ylorrd9,shape=box]
- r5t15c1[label="b & f
-T015",style=filled,colorscheme=ylorrd9,shape=box]
- r5t16c1[label="d & f & g
-T016",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r5 -> r5t13c1[style=invis]
- r5t13c1 -> r5t14c1[weight=10,style=invis]
- r5t14c1 -> r5t15c1[weight=10,style=invis]
- r5t15c1 -> r5t16c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r6
- {
- // Create a node for the range r6
- r6[shape=box,label="6",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r6
- r6t17c1[label="a & b & c
-T017",style=filled,colorscheme=ylorrd9,shape=box]
- r6t18c1[label="b & c
-T018",style=filled,colorscheme=ylorrd9,shape=box]
- r6t19c1[label="b & c & g
-T019",style=filled,colorscheme=ylorrd9,shape=box]
- r6t20c1[label="c & d & g
-T020",style=filled,colorscheme=ylorrd9,shape=box]
- r6t21c1[label="c & g
-T021",style=filled,colorscheme=ylorrd9,shape=box]
- r6t22c1[label="e & g
-T022",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r6 -> r6t17c1[style=invis]
- r6t17c1 -> r6t18c1[weight=10,style=invis]
- r6t18c1 -> r6t19c1[weight=10,style=invis]
- r6t19c1 -> r6t20c1[weight=10,style=invis]
- r6t20c1 -> r6t21c1[weight=10,style=invis]
- r6t21c1 -> r6t22c1[weight=10,style=invis]
- }
- }
- // Create the edges of the MST 1
- // Create the edges of the MST 2
- // Create the edges of the MST 3
- // Create the edges of the MST 4
- // Create the edges of the MST 5
- // Create the edges of the MST 6
- // Create the edges of the MST 7
- // Create the edges of the MST 8
- // Create the edges of the MST 9
- // Create the edges of the MST 10
- // Create the edges of the MST 11
- // Create the edges of the MST 12
- // Create the edges of the MST 13
- // Create the edges of the MST 14
- // Create the edges of the MST 15
- // Create the edges of the MST 16
- // Create the edges of the MST 17
- // Create the edges of the MST 18
- // Create the edges of the MST 19
- // Create the edges of the MST 20
- // Create the edges of the MST 21
- // Create the edges of the MST 22
- // Vertically align range nodes
- r1 -> r2 -> r3 -> r4 -> r5 -> r6[weight=10,style=invis]
-}
+++ /dev/null
-// fromList [(Pos 1,[1,2,5]),(Pos 2,[1,3,5]),(Pos 3,[3,4]),(Pos 4,[1,5]),(Pos 5,[1,3,4,6]),(Pos 6,[2,5,7,8])]
-digraph g
-{
- splines="ortho"
- subgraph cluster_r1
- {
- // Create a node for the range r1
- r1[shape=box,label="1",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r1
- r1t1c1[label="a & d & e
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r1t2c1[label="e & f & g
-T002
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r1t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r1 -> r1t1c1[style=invis]
- r1t1c1 -> r1t2c1[weight=10,style=invis]
- r1t2c1 -> r1t5c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r2
- {
- // Create a node for the range r2
- r2[shape=box,label="2",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r2
- r2t1c1[label="a & d
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r2t3c1[label="d & f
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r2t5c1[label="a & b
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r2 -> r2t1c1[style=invis]
- r2t1c1 -> r2t3c1[weight=10,style=invis]
- r2t3c1 -> r2t5c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r3
- {
- // Create a node for the range r3
- r3[shape=box,label="3",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r3
- r3t3c1[label="d & f
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r3t4c1[label="a & f & g
-T004
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r3 -> r3t3c1[style=invis]
- r3t3c1 -> r3t4c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r4
- {
- // Create a node for the range r4
- r4[shape=box,label="4",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r4
- r4t1c1[label="a & d & e
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c2[label="b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c3[label="b & c & e
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r4 -> r4t1c1[style=invis]
- r4t1c1 -> r4t5c1[weight=10,style=invis]
- r4t5c1 -> r4t5c2[weight=10,style=invis]
- r4t5c2 -> r4t5c3[weight=10,style=invis]
- }
- }
- subgraph cluster_r5
- {
- // Create a node for the range r5
- r5[shape=box,label="5",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r5
- r5t1c1[label="a & c & d
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t3c1[label="d & f & g
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t4c1[label="a & f
-T004
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t6c1[label="b & f
-T006",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r5 -> r5t1c1[style=invis]
- r5t1c1 -> r5t3c1[weight=10,style=invis]
- r5t3c1 -> r5t4c1[weight=10,style=invis]
- r5t4c1 -> r5t6c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r6
- {
- // Create a node for the range r6
- r6[shape=box,label="6",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r6
- r6t2c1[label="e & g
-T002
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c2[label="b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c3[label="b & c & g
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t7c1[label="c & d & g
-T007",style=filled,colorscheme=ylorrd9,shape=box]
- r6t8c1[label="c & g
-T008",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r6 -> r6t2c1[style=invis]
- r6t2c1 -> r6t5c1[weight=10,style=invis]
- r6t5c1 -> r6t5c2[weight=10,style=invis]
- r6t5c2 -> r6t5c3[weight=10,style=invis]
- r6t5c3 -> r6t7c1[weight=10,style=invis]
- r6t7c1 -> r6t8c1[weight=10,style=invis]
- }
- }
- // Create the edges of the MST 1
- r1t1c1 -> r5t1c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t1c1 -> r2t1c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t1c1 -> r4t1c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 2
- r1t2c1 -> r6t2c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 3
- r2t3c1 -> r5t3c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r2t3c1 -> r3t3c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 4
- r3t4c1 -> r5t4c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 5
- r4t5c3 -> r1t5c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r6t5c3[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r4t5c2[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r4t5c2 -> r6t5c2[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r2t5c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r6t5c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r4t5c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 6
- // Create the edges of the MST 7
- // Create the edges of the MST 8
- // Vertically align range nodes
- r1 -> r2 -> r3 -> r4 -> r5 -> r6[weight=10,style=invis]
-}
+++ /dev/null
-// fromList [(Pos 1,[1,2,5]),(Pos 2,[1,3,5]),(Pos 3,[3,4]),(Pos 4,[1,5]),(Pos 5,[1,3,4,6]),(Pos 6,[2,5,7,8])]
-digraph g
-{
- splines="ortho"
- subgraph cluster_r1
- {
- // Create a node for the range r1
- r1[shape=box,label="1",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r1
- r1t1c1[label="a & d & e
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r1t2c1[label="e & f & g
-T002
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r1t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r1 -> r1t1c1[style=invis]
- r1t1c1 -> r1t2c1[weight=10,style=invis]
- r1t2c1 -> r1t5c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r2
- {
- // Create a node for the range r2
- r2[shape=box,label="2",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r2
- r2t1c1[label="a & d
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r2t3c1[label="d & f
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r2t5c1[label="a & b
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r2 -> r2t1c1[style=invis]
- r2t1c1 -> r2t3c1[weight=10,style=invis]
- r2t3c1 -> r2t5c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r3
- {
- // Create a node for the range r3
- r3[shape=box,label="3",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r3
- r3t3c1[label="d & f
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r3t4c1[label="a & f & g
-T004
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r3 -> r3t3c1[style=invis]
- r3t3c1 -> r3t4c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r4
- {
- // Create a node for the range r4
- r4[shape=box,label="4",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r4
- r4t1c1[label="a & d & e
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c2[label="b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r4t5c3[label="b & c & e
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r4 -> r4t1c1[style=invis]
- r4t1c1 -> r4t5c1[weight=10,style=invis]
- r4t5c1 -> r4t5c2[weight=10,style=invis]
- r4t5c2 -> r4t5c3[weight=10,style=invis]
- }
- }
- subgraph cluster_r5
- {
- // Create a node for the range r5
- r5[shape=box,label="5",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r5
- r5t1c1[label="a & c & d
-T001
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t3c1[label="d & f & g
-T003
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t4c1[label="a & f
-T004
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r5t6c1[label="b & f
-T006",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r5 -> r5t1c1[style=invis]
- r5t1c1 -> r5t3c1[weight=10,style=invis]
- r5t3c1 -> r5t4c1[weight=10,style=invis]
- r5t4c1 -> r5t6c1[weight=10,style=invis]
- }
- }
- subgraph cluster_r6
- {
- // Create a node for the range r6
- r6[shape=box,label="6",color=gray,style=filled,fillcolor=gray]
- color=gray
- {
- rank=same
- // Create the cluster nodes within the range r6
- r6t2c1[label="e & g
-T002
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c1[label="a & b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c2[label="b & c
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t5c3[label="b & c & g
-T005
-0.67",style=filled,fillcolor=7,colorscheme=ylorrd9,shape=box]
- r6t7c1[label="c & d & g
-T007",style=filled,colorscheme=ylorrd9,shape=box]
- r6t8c1[label="c & g
-T008",style=filled,colorscheme=ylorrd9,shape=box]
- // Horizontally align the cluster nodes within the same range
- r6 -> r6t2c1[style=invis]
- r6t2c1 -> r6t5c1[weight=10,style=invis]
- r6t5c1 -> r6t5c2[weight=10,style=invis]
- r6t5c2 -> r6t5c3[weight=10,style=invis]
- r6t5c3 -> r6t7c1[weight=10,style=invis]
- r6t7c1 -> r6t8c1[weight=10,style=invis]
- }
- }
- // Create the edges of the MST 1
- r1t1c1 -> r5t1c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t1c1 -> r2t1c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t1c1 -> r4t1c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 2
- r1t2c1 -> r6t2c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 3
- r2t3c1 -> r5t3c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r2t3c1 -> r3t3c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 4
- r3t4c1 -> r5t4c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 5
- r4t5c3 -> r1t5c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r6t5c3[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r4t5c2[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r4t5c2 -> r6t5c2[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r2t5c1[constraint=false,color=6,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r6t5c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- r1t5c1 -> r4t5c1[constraint=false,color=0,colorscheme=ylorrd9,fontcolor=blue,dir=both,arrowhead=dot,arrowtail=dot]
- // Create the edges of the MST 6
- // Create the edges of the MST 7
- // Create the edges of the MST 8
- // Vertically align range nodes
- r1 -> r2 -> r3 -> r4 -> r5 -> r6[weight=10,style=invis]
-}
sourcephile / git / literate-phylomemy.git / commitdiff