find-clumpiness 0.2.2.0 → 0.2.3.0

raw patch · 4 files changed

+112/−49 lines, 4 filesdep +hierarchical-clusteringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hierarchical-clustering

API changes (from Hackage documentation)

Files

• app/Main.hs +37/−41
• find-clumpiness.cabal +4/−2
• src/Clumpiness.hs +39/−0
• src/Types.hs +32/−6

@@ -5,30 +5,30 @@ using the clumpiness metric -} --- Standard+-- Remote+import Data.Aeson import Data.Maybe-import Data.Tree import Data.Semigroup ((<>))---- Cabal-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.ByteString.Lazy.Char8 as C-import Data.Aeson+import Data.Tree import Math.TreeFun.Tree import Math.TreeFun.Types-import qualified Math.Clumpiness.Algorithms as Clump-import qualified Biobase.Newick as Newick import Options.Applicative+import qualified Biobase.Newick as Newick+import qualified Data.ByteString.Lazy.Char8 as C+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Math.Clumpiness.Algorithms as Clump  -- Local-import Types-import Utility+import Clumpiness+import LineageConvert import NewickConvert+import Print import RJSONConvert-import LineageConvert import TreeTransform-import Print+import Types+import Utility  -- Command line arguments data Options = Options { input            :: Maybe String@@ -53,7 +53,7 @@       <*> option auto           ( long "format"          <> short 'f'-         <> metavar "[JSON] | RJSON | Haskell | Lineage LABEL"+         <> metavar "[JSON] | RJSON | Haskell HaskellFormat | Lineage LABEL"          <> value JSON          <> help "Whether the input tree is in JSON, RJSON, Haskell, or Lineage format.\                  \ The format for JSON is\@@ -62,7 +62,9 @@                  \ \"toJSON(as.list(as.Node(dendrogram), mode = \"explicit\", unname = TRUE))\"\                  \ using the data.tree and jsonlite libraries,\                  \ where \"dendrogram\" is a dendrogram object in R.\-                 \ The format for Haskell is \"Tree NodeLabel\" from this library.\+                 \ The format for Haskell STRING is one of\+                 \ \"Tree NodeLabel\" (BaseFormat) from this library or\+                 \ \"Tree (Seq Text)\" (TreeFormat).\                  \ The Lineage format needs an additional field to\                  \ specify what to use as the label\                  \ (for instance, Lineage tissues).\@@ -110,12 +112,15 @@         )  -- | Get the tree from a Haskell format-haskellFormat :: Options -> IO (Tree NodeLabel)-haskellFormat opts = do+haskellFormat :: Options -> HaskellFormat -> IO (Tree NodeLabel)+haskellFormat opts format = do     contents <- case input opts of                     Nothing  -> getContents                     (Just x) -> readFile x-    return . read $ contents+    return . makeWork format $ contents+  where+    makeWork BaseFormat x       = makeWorkable (read x :: Tree NodeLabel)+    makeWork TreeFormat x       = makeWorkable (read x :: Tree (Seq.Seq T.Text))  -- | Get the tree from a JSON format jsonFormat :: Options -> IO (Tree NodeLabel)@@ -162,30 +167,21 @@ findClumpiness :: Options -> IO () findClumpiness opts = do     inputTree <- case inputFormat opts of-                    Haskell   -> haskellFormat opts-                    JSON      -> jsonFormat opts-                    RJSON     -> rJsonFormat opts-                    Newick    -> newickFormat opts-                    Lineage x -> lineageFormat opts x-    let inputSuperTree = convertToSuperTree-                       . filterExclusiveTree (inputExclusivity opts)-                       . (\ x -> if excludeInnerFlag opts-                                    then x-                                    else innerToLeaves x-                         )-                       . (\ x -> if predefinedIDs opts-                                    then x-                                    else addUniqueNodeIDs x-                         )-                       $ inputTree-        propertyMap    = getPropertyMap inputSuperTree-        clumpResult    = Clump.generateClumpMap-                         (const True)-                         propertyMap-                         inputSuperTree+                    Haskell x      -> haskellFormat opts x+                    JSON           -> jsonFormat opts+                    RJSON          -> rJsonFormat opts+                    Newick         -> newickFormat opts+                    Lineage x      -> lineageFormat opts x +    let clumpResult =+            getClumpiness+                (inputExclusivity opts)+                (predefinedIDs opts)+                (excludeInnerFlag opts)+                inputTree+     case output opts of-        Nothing  -> T.putStrLn . printClumpList $ clumpResult+        Nothing  -> T.putStr . printClumpList $ clumpResult         (Just x) ->  T.writeFile x . printClumpList $ clumpResult  main :: IO ()

@@ -1,5 +1,5 @@ name:                find-clumpiness-version:             0.2.2.0+version:             0.2.3.0 synopsis:            Find the clumpiness of labels in a tree description:         Use a clumpiness measure to find the aggregation relationship between labels inside of a tree. homepage:            http://github.com/GregorySchwartz/find-clumpiness#readme@@ -21,13 +21,15 @@                      , RJSONConvert                      , LineageConvert                      , TreeTransform+                     , Clumpiness                      , Print   build-depends:       base >= 4.7 && < 5-                     , clumpiness                      , BiobaseNewick                      , aeson                      , bytestring+                     , clumpiness                      , containers+                     , hierarchical-clustering                      , listsafe                      , mtl                      , text

@@ -0,0 +1,39 @@+{- Clumpiness+By Gregory W. Schwartz++Contains an easier to use version of the clumpiness function.+-}++module Clumpiness+    ( getClumpiness+    ) where++-- Cabal+import Data.Tree (Tree)+import Math.Clumpiness.Algorithms (generateClumpMap)+import Math.Clumpiness.Types (ClumpList)++-- Local+import TreeTransform+import Types++getClumpiness :: Exclusivity -- ^ How to look at vertices with multiple labels.+              -> Bool -- ^ Whether the unique node IDs are predefined (recommended False unless you know what you are doing)+              -> Bool -- ^ Whether to look at labels in inner vertices.+              -> Tree NodeLabel+              -> ClumpList Label+getClumpiness exclusivity predefinedIDs excludeInner tree =+    generateClumpMap (const True) propertyMap superTree+  where+    superTree   = convertToSuperTree+                . filterExclusiveTree exclusivity+                . (\ x -> if excludeInner+                             then x+                             else innerToLeaves x+                  )+                . (\ x -> if predefinedIDs+                             then x+                             else addUniqueNodeIDs x+                  )+                $ tree+    propertyMap = getPropertyMap superTree

@@ -3,26 +3,29 @@ -- -- Collects all application specific types +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}  module Types where --- Standard+-- Remote+import Data.Aeson+import Data.Tree import GHC.Generics import qualified Data.Sequence as Seq-import Data.Tree---- Cabal import qualified Data.Text as T-import Data.Aeson+import qualified Data.Clustering.Hierarchical as H  -- Algebraic data NodeLabel = NodeLabel { nodeID     :: !T.Text                            , nodeLabels :: !Labels                            } deriving (Generic, Eq, Ord, Read, Show) -data Format = JSON | RJSON | Haskell | Newick | Lineage T.Text deriving (Read)+data Format = JSON | RJSON | Haskell HaskellFormat | Newick | Lineage T.Text deriving (Read) +data HaskellFormat = BaseFormat | TreeFormat | DendrogramFormat deriving (Read)+ data Exclusivity = Exclusive | AllExclusive | Majority deriving (Read)  newtype Separator = Separator T.Text deriving (Show)@@ -35,3 +38,26 @@ type Labels = Seq.Seq Label  instance FromJSON NodeLabel++-- | Class of trees that can be converted to workable trees.+class WorkableTree a where+    makeWorkable :: a -> Tree NodeLabel++instance WorkableTree (Tree NodeLabel) where+    makeWorkable = id++instance WorkableTree (Tree (Seq.Seq T.Text)) where+    makeWorkable (Node { rootLabel = ls, subForest = xs}) =+        Node { rootLabel = NodeLabel { nodeID = "", nodeLabels = ls}+             , subForest = fmap makeWorkable xs+             }++instance WorkableTree (H.Dendrogram (Seq.Seq T.Text)) where+    makeWorkable (H.Leaf x) =+        Node { rootLabel = NodeLabel { nodeID = "", nodeLabels = x}+             , subForest = []+             }+    makeWorkable (H.Branch _ l r) =+        Node { rootLabel = NodeLabel { nodeID = "", nodeLabels = Seq.empty }+             , subForest = [makeWorkable l, makeWorkable r]+             }