packages feed

find-clumpiness-0.2.0.1: app/Main.hs

{- find-clumpiness
By Gregory W. Schwartz

Takes a Haskell or JSON tree and finds the relationship between labels
using the clumpiness metric
-}

-- Standard
import Data.Maybe
import Data.Tree
import qualified Data.HashMap.Strict as Hash

-- Cabal
import Options.Applicative
import Math.TreeFun.Tree
import Math.TreeFun.Types
import qualified Math.Clumpiness.Algorithms as Clump
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 qualified Data.Aeson.Types as AT

-- Local
import Types
import LineageConvert
import TreeTransform
import Print

-- Command line arguments
data Options = Options { input            :: Maybe String
                       , inputFormat      :: Format
                       , inputExclusivity :: Exclusivity
                       , output           :: Maybe String
                       }

-- Command line options
options :: Parser Options
options = Options
      <$> optional ( strOption
          ( long "input"
         <> short 'i'
         <> metavar "FILE"
         <> help "The input file containing the tree with labels"
          )
        )
      <*> 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\
                 \ specify what to use as the label\
                 \ (for instance, Lineage tissues). The format for JSON is\
                 \ [{ \"nodeID\": \"ID\", \"nodeLabels\" [ \"Label\" ]  },\
                 \ [RECURSION]]"
          )
      <*> option auto
          ( long "exclusivity"
         <> short 'e'
         <> metavar "[Exclusive] | AllExclusive | Majority"
         <> value Exclusive
         <> help "Whether to only look at exclusive nodes (nodes with one label\
                 \ only), all nodes, or majority nodes (makes nodes exclusive\
                 \ by choosing the most abundant label. If a tie, then\
                 \ alphabetical)."
          )
      <*> optional ( strOption
          ( long "output"
         <> short 'o'
         <> metavar "FILE"
         <> help "The output file containing the heatmap of clumpiness"
          )
        )

-- | Get the generic AST from the file
decodeLineageTree :: C.ByteString -> Object
decodeLineageTree contents = fromMaybe
                             (error "JSON is not an object")
                             (decode contents :: Maybe Object)

-- | Get the lineage tree from a generic AST
getLineageTree :: Label -> Object -> Tree NodeLabel
getLineageTree label object = either error (lineageToTree label)
                            . flip AT.parseEither object $ \obj -> do
                                germTree <- obj .: T.pack "tree"
                                tree <- germTree .: T.pack "children"
                                return . rootCheck tree $ germTree
  where
    -- Get the first branch point (sometimes there are additional nodes
    -- right after the root for lineages that bypass the no root rule).
    rootCheck [tree] _ = tree
    rootCheck _ tree   = tree

findClumpiness :: Options -> IO ()
findClumpiness opts = do
    contents <- case input opts of
                    Nothing  -> C.getContents
                    (Just x) -> C.readFile x

    let inputTree      = case inputFormat opts of
                            Haskell   -> read . C.unpack $ contents
                            JSON      -> either error id
                                       $ eitherDecode contents :: Tree NodeLabel
                            Lineage x -> getLineageTree x
                                       . decodeLineageTree
                                       $ contents
        inputSuperTree = convertToSuperTree
                       . filterExclusiveTree (inputExclusivity opts)
                       . innerToLeaves
                       $ inputTree
        propertyMap    = getPropertyMap inputSuperTree
        clumpResult    = Clump.generateClumpMap
                         (const True)
                         propertyMap
                         inputSuperTree

    case output opts of
        Nothing  -> T.putStrLn . printClumpList $ clumpResult
        (Just x) ->  T.writeFile x . printClumpList $ clumpResult

main :: IO ()
main = execParser opts >>= findClumpiness
  where
    opts = info (helper <*> options)
      ( fullDesc
     <> progDesc "Find the clumpiness of different pairs of labels in a\
                 \ tree"
     <> header "find-clumpiness, Gregory W. Schwartz" )