find-clumpiness 0.2.1.3 → 0.2.2.0

raw patch · 6 files changed

+177/−36 lines, 6 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• app/Main.hs +54/−16
• find-clumpiness.cabal +16/−14
• src/LineageConvert.hs +1/−2
• src/RJSONConvert.hs +82/−0
• src/TreeTransform.hs +23/−3
• src/Types.hs +1/−1

@@ -25,6 +25,7 @@ import Types import Utility import NewickConvert+import RJSONConvert import LineageConvert import TreeTransform import Print@@ -34,6 +35,8 @@                        , inputFormat      :: Format                        , inputExclusivity :: Exclusivity                        , inputNewickLabel :: Maybe String+                       , excludeInnerFlag :: Bool+                       , predefinedIDs    :: Bool                        , output           :: Maybe String                        } @@ -44,20 +47,26 @@           ( long "input"          <> short 'i'          <> metavar "FILE"-         <> help "The input file containing the tree with labels"+         <> help "The input file containing the tree with labels (or just use stdin)"           )         )       <*> option auto           ( long "format"          <> short 'f'-         <> metavar "[Haskell] | JSON | Lineage LABEL"-         <> value Haskell-         <> help "Whether the input tree is in Haskell, JSON, or Lineage format\-                 \, where the Lineage format needs an additional field to\+         <> metavar "[JSON] | RJSON | Haskell | Lineage LABEL"+         <> value JSON+         <> help "Whether the input tree is in JSON, RJSON, Haskell, or Lineage format.\+                 \ The format for JSON is\+                 \ [{ \"nodeID\": \"ID\", \"nodeLabels\" [ \"Label\" ]  }, [RECURSION]].\+                 \ The format for RJSON is from\+                 \ \"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 Lineage format needs an additional field to\                  \ specify what to use as the label\-                 \ (for instance, Lineage tissues). The format for JSON is\-                 \ [{ \"nodeID\": \"ID\", \"nodeLabels\" [ \"Label\" ]  },\-                 \ [RECURSION]]"+                 \ (for instance, Lineage tissues).\+                 \ See README for more information about formats."           )       <*> option auto           ( long "exclusivity"@@ -79,11 +88,24 @@                  \ order to get the label."           )         )+      <*> switch+          ( long "exclude-inner"+         <> short 'E'+         <> help "Do not include inner node labels in clumpiness calculation."+          )+      <*> switch+          ( long "predefined-ids"+         <> short 'p'+         <> help "Whether the node IDs are predefined. Otherwise,\+                 \ we set the unique ID of the node as Text integers\+                 \ starting at 0. Recommended to ignore this flag unless you\+                 \ know what you are doing. Ignore this flag for RJSON."+          )       <*> optional ( strOption           ( long "output"          <> short 'o'          <> metavar "FILE"-         <> help "The output file containing the heatmap of clumpiness"+         <> help "The output file containing the heatmap of clumpiness (or just use stdout)"           )         ) @@ -96,7 +118,7 @@     return . read $ contents  -- | Get the tree from a JSON format-jsonFormat :: Options -> IO (Tree NodeLabel) +jsonFormat :: Options -> IO (Tree NodeLabel) jsonFormat opts = do     contents <- case input opts of                     Nothing  -> C.getContents@@ -104,7 +126,7 @@     return ((either error id . eitherDecode $ contents) :: Tree NodeLabel)  -- | Get the tree from a Newick format-newickFormat :: Options -> IO (Tree NodeLabel) +newickFormat :: Options -> IO (Tree NodeLabel) newickFormat opts = do     contents <- case input opts of                     Nothing  -> T.getContents@@ -121,24 +143,40 @@         . Newick.newicksFromText         $ contents --- | Get the tree form a lineage fromat-lineageFormat :: Options -> T.Text -> IO (Tree NodeLabel) -lineageFormat opts x = do+-- | Get the tree from a lineage fromat+lineageFormat :: Options -> T.Text -> IO (Tree NodeLabel)+lineageFormat opts l = do     contents <- case input opts of                     Nothing  -> C.getContents                     (Just x) -> C.readFile x-    return . getLineageTree x . decodeLineageTree $ contents+    return . getLineageTree l . decodeLineageTree $ contents +-- | Get the tree from an R JSON format+rJsonFormat :: Options -> IO (Tree NodeLabel)+rJsonFormat opts = do+    contents <- case input opts of+                    Nothing  -> C.getContents+                    (Just x) -> C.readFile x+    return . getRJsonTree . decodeRJsonTree $ contents+ 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)-                       . innerToLeaves+                       . (\ 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

@@ -1,5 +1,5 @@ name:                find-clumpiness-version:             0.2.1.3+version:             0.2.2.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@@ -18,21 +18,23 @@   exposed-modules:     Types                      , Utility                      , NewickConvert+                     , RJSONConvert                      , LineageConvert                      , TreeTransform                      , Print   build-depends:       base >= 4.7 && < 5                      , clumpiness-                     , tree-fun-                     , containers-                     , unordered-containers-                     , vector+                     , BiobaseNewick+                     , aeson                      , bytestring+                     , containers+                     , listsafe+                     , mtl                      , text                      , text-show-                     , aeson-                     , BiobaseNewick-                     , listsafe+                     , tree-fun+                     , unordered-containers+                     , vector   default-language:    Haskell2010  executable find-clumpiness@@ -41,15 +43,15 @@   ghc-options:         -threaded -rtsopts -O2   build-depends:       base                      , find-clumpiness-                     , clumpiness-                     , tree-fun-                     , containers-                     , unordered-containers+                     , BiobaseNewick                      , aeson-                     , text                      , bytestring+                     , clumpiness+                     , containers                      , optparse-applicative-                     , BiobaseNewick+                     , text+                     , tree-fun+                     , unordered-containers   default-language:    Haskell2010  source-repository head

@@ -18,7 +18,6 @@ import qualified Data.Sequence as Seq import Data.Tree import qualified Data.HashMap.Strict as Hash-import Debug.Trace  -- Cabal import qualified Data.Vector as V@@ -77,7 +76,7 @@ -- | Get the generic AST from the file decodeLineageTree :: C.ByteString -> Object decodeLineageTree contents = fromMaybe-                             (error "JSON is not an object")+                             (error "Input is not a JSON object")                              (decode contents :: Maybe Object)  -- | Get the lineage tree from a generic AST

@@ -0,0 +1,82 @@+{- RJSONConvert+By Gregory W. Schwartz++Collects functions pertaining to converting the JSON output of R to the workable+tree. To create the input for this program from R:++@+library(data.tree)+library(jsonlite)+hc = hclust(dist(USArrests), "ave")+tree = as.Node(as.dendrogram(hc))+toJSON(as.list(tree, mode = "explicit", unname = TRUE))+@++-}++{-# LANGUAGE OverloadedStrings #-}++module RJSONConvert+    ( rJsonToTree+    , decodeRJsonTree+    , getRJsonTree+    ) where++-- Standard+import Data.Maybe+import qualified Data.Sequence as Seq+import Data.Tree+import Debug.Trace++-- Cabal+import qualified Data.Vector as V+import qualified Data.ByteString.Lazy.Char8 as C+import qualified Data.Text as T+import TextShow (showt)+import Math.TreeFun.Types+import Math.TreeFun.Tree+import Data.Aeson+import Data.Aeson.Types++-- Local+import Types++-- | Convert a R JSON format into the workable tree format+rJsonToTree :: Object -> Tree NodeLabel+rJsonToTree object =+    Node { rootLabel = getNodeLabel object+         , subForest = fmap rJsonToTree . getChildren $ object+         }++-- | Get the NodeLabel of a node+getNodeLabel :: Object -> NodeLabel+getNodeLabel object = do+    NodeLabel { nodeID = ""+              , nodeLabels = getLabel object+              }++-- | Get the label of the node+getLabel :: Object -> Labels+getLabel object = Seq.fromList+                . V.toList+                . either error id+                . flip parseEither object $ \obj -> do+                    labels <- obj .: "name"+                    return labels++-- | Get the children of a node+getChildren :: Object -> [Object]+getChildren object = either (const []) id+                   . flip parseEither object $ \obj -> do+                        children <- obj .: "children"+                        return children++-- | Get the generic AST from the file+decodeRJsonTree :: C.ByteString -> Object+decodeRJsonTree contents = fromMaybe+                             (error "Input is not a JSON object")+                             (decode contents :: Maybe Object)++-- | Get the lineage tree from a generic AST+getRJsonTree :: Object -> Tree NodeLabel+getRJsonTree object = rJsonToTree object

@@ -12,20 +12,23 @@     , getPropertyMap     , innerToLeaves     , filterExclusiveTree+    , addUniqueNodeIDs     ) where  -- Standard+import Control.Monad.State+import Data.Function (on)+import Data.Tree+import qualified Data.Foldable as F import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Set as Set-import Data.Tree-import qualified Data.Foldable as F-import Data.Function (on)  -- Cabal import qualified Data.Text as T import Math.TreeFun.Types import Math.TreeFun.Tree+import TextShow (showt)  -- Local import Types@@ -88,3 +91,20 @@                                     . Map.fromListWith (+)                                     . flip zip [1,1..]                                     . F.toList $ xs++-- | Add unique node IDs to a tree, replacing any previous node IDs.+addUniqueNodeIDs :: Tree NodeLabel -> Tree NodeLabel+addUniqueNodeIDs tree = fst . runState (go tree) $ 0+  where+    go :: Tree NodeLabel -> State Int (Tree NodeLabel)+    go tree = do+        newRootLabel <- updateRootLabel . rootLabel $ tree+        newSubForest <- mapM go . subForest $ tree+        return $ tree { rootLabel = newRootLabel+                      , subForest = newSubForest+                      }+    updateRootLabel :: NodeLabel -> State Int NodeLabel+    updateRootLabel n = do+        nId <- get+        modify (+ 1)+        return $ n { nodeID = showt nId }

@@ -21,7 +21,7 @@                            , nodeLabels :: !Labels                            } deriving (Generic, Eq, Ord, Read, Show) -data Format = Haskell | JSON | Newick | Lineage T.Text deriving (Read)+data Format = JSON | RJSON | Haskell | Newick | Lineage T.Text deriving (Read)  data Exclusivity = Exclusive | AllExclusive | Majority deriving (Read)