Differential.hs

{- TooManyCells.Program.Differential
Gregory W. Schwartz

Differential entry point for command line program.
-}

{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE DuplicateRecordFields #-}

module TooManyCells.Program.Differential where

-- Remote
import BirchBeer.Load
import BirchBeer.Types
import BirchBeer.Utility
import Control.Monad (when, join)
import Control.Monad.Trans (liftIO)
import Data.Bool (bool)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Monoid ((<>))
import Language.R as R
import Math.Clustering.Hierarchical.Spectral.Types (getClusterItemsDend, EigenGroup (..))
import System.IO (hPutStrLn, stderr)
import Text.Read (readMaybe)
import qualified Control.Lens as L
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Set as Set
import qualified H.Prelude as H
import qualified System.Directory as FP
import qualified System.FilePath as FP

-- Local
import TooManyCells.Program.Options
import TooManyCells.Differential.Differential
import TooManyCells.Differential.Types
import TooManyCells.MakeTree.Types
import TooManyCells.MakeTree.Utility
import TooManyCells.File.Types
import TooManyCells.Matrix.Utility
import TooManyCells.Program.LoadMatrix
import TooManyCells.MakeTree.Load

-- | Differential path.
differentialMain :: Subcommand -> IO ()
differentialMain sub@(DifferentialCommand opts) = do
    let readOrErr err = fromMaybe (error err) . readMaybe
        delimiter'        = Delimiter
                          . (delimiter :: LoadMatrixOptions -> Char)
                          . (loadMatrixOptions :: Differential -> LoadMatrixOptions)
                          $ opts
        labelsFile' =
            fmap LabelFile . (labelsFile :: Differential -> Maybe String) $ opts
        nodes'    =
          DiffNodes . readOrErr "Cannot read --nodes." . nodes $ opts
        prior'    = PriorPath . (prior :: Differential -> String) $ opts
        topN'     = TopN . (topN :: Differential -> Int) $ opts
        features'    = fmap Feature . features $ opts
        aggregate' = Aggregate . aggregate $ opts
        separateNodes' = SeparateNodes . plotSeparateNodes $ opts
        separateLabels' = SeparateLabels . plotSeparateLabels $ opts
        violinFlag' = ViolinFlag . plotViolin $ opts
        noOutlierFlag' = NoOutlierFlag . plotNoOutlier $ opts
        updateTreeRows' = UpdateTreeRowsFlag . not . (noUpdateTreeRows :: Differential -> Bool) $ opts
        edger' = Edger . edger $ opts
        subsampleGroups' = fmap Subsample . subsampleGroups $ opts
        seed' = Seed . seed $ opts
        labels'   = fmap ( DiffLabels
                         . L.over L.both ( (\x -> bool (Just x) Nothing . Set.null $ x)
                                         . Set.fromList
                                         . fmap Label
                                         )
                         . readOrErr "Cannot read --labels."
                         )
                  . labels
                  $ opts
        (combined1, combined2) = combineNodesLabels nodes' labels'
        plotOutputR = plotOutput opts

    when (isNothing labelsFile' && isJust labels') $
      hPutStrLn stderr "Warning: labels requested with no label file, ignoring labels..."

    scRes <- loadAllSSM sub
           $ (loadMatrixOptions :: Differential -> LoadMatrixOptions) opts
    let processedSc = fmap fst scRes
        customLabelMap = join . fmap snd $ scRes

    labelMap <- if isJust labelsFile'
                  then mapM (loadLabelData delimiter') $ labelsFile'
                  else return customLabelMap

    let clInput = (FP.</> "cluster_list.json") . unPriorPath $ prior'
        treeInput = (FP.</> "cluster_tree.json") . unPriorPath $ prior'

        cr :: IO ClusterResults
        cr = loadClusterResultsFiles clInput treeInput

    gr <- treeToGraph
        . updateTreeRowBool updateTreeRows' processedSc
        . _clusterDend
      <$> cr

    H.withEmbeddedR defaultConfig $ H.runRegion $ do
      case features' of
        [] -> do
          case nodes' of
            (DiffNodes ([], [])) -> do
              res <- H.io
                       . getAllDEGraphKruskalWallis
                           seed'
                           subsampleGroups'
                           topN'
                           labelMap
                           (maybe (DiffLabels (Nothing, Nothing)) id labels')
                           (extractSc processedSc)
                       $ gr

              H.io . B.putStrLn . getAllDEStringKruskalWallis $ res
            (DiffNodes ([], _)) -> error "Need other nodes to compare with. If every node should be compared to all other nodes using Mann-Whitney U, use \"([], [])\"."
            (DiffNodes (_, [])) -> error "Need other nodes to compare with. If every node should be compared to all other nodes using Mann-Whitney U, use \"([], [])\"."
            _ -> do
              if not $ unEdger edger'
                then do
                  res <- H.io
                       $ getDEGraphKruskalWallis
                           seed'
                           subsampleGroups'
                           topN'
                           labelMap
                           (extractSc processedSc)
                           combined1
                           combined2
                           gr

                  H.io . B.putStrLn . getDEStringKruskalWallis $ res
                else do
                  res <- getDEGraph
                          seed'
                          subsampleGroups'
                          topN'
                          labelMap
                          (extractSc processedSc)
                          combined1
                          combined2
                          gr

                  H.io . B.putStrLn . getDEString $ res
        _ -> do
          let outputCsvR = FP.replaceExtension plotOutputR ".csv"

          diffPlot <- getSingleDiff
                       seed'
                       subsampleGroups'
                       False
                       violinFlag'
                       noOutlierFlag'
                       aggregate'
                       separateNodes'
                       separateLabels'
                       labelMap
                       (extractSc processedSc)
                       combined1
                       combined2
                       features'
                       gr
          [H.r| suppressMessages(write.csv(diffPlot_hs[[2]], file = outputCsvR_hs, row.names = FALSE, quote = FALSE)) |]
          [H.r| suppressMessages(ggsave(diffPlot_hs[[1]], file = plotOutputR_hs)) |]

          let normOutputR = FP.replaceBaseName
                              plotOutputR
                             (FP.takeBaseName plotOutputR <> "_scaled")
              normOutputCsvR = FP.replaceExtension normOutputR ".csv"

          diffNormPlot <- getSingleDiff
                            seed'
                            subsampleGroups'
                            True
                            violinFlag'
                            noOutlierFlag'
                            aggregate'
                            separateNodes'
                            separateLabels'
                            labelMap
                            (extractSc processedSc)
                            combined1
                            combined2
                            features'
                            gr
          [H.r| suppressMessages(write.csv(diffNormPlot_hs[[2]], file = normOutputCsvR_hs, row.names = FALSE, quote = FALSE)) |]
          [H.r| suppressMessages(ggsave(diffNormPlot_hs[[1]], file = normOutputR_hs)) |]

          return ()
differentialMain _ = error "Wrong path in differential, contact Gregory Schwartz for this error."