birch-beer 0.2.3.0 → 0.2.4.0

raw patch · 4 files changed

+40/−2 lines, 4 files

Files

• app/Main.hs +7/−1
• birch-beer.cabal +1/−1
• src/BirchBeer/Options.hs +2/−0
• src/BirchBeer/Utility.hs +30/−0

@@ -209,7 +209,7 @@                         , _birchSimMat              = simMat                         } -    (plot, _, _, _, tree', _) <- mainDiagram config+    (plot, _, _, _, tree', gr) <- mainDiagram config      -- Plot tree.     D.renderCairo@@ -219,6 +219,12 @@      -- Write new tree if necessary.     mapM_ (\x -> B.writeFile x . A.encode $ tree') . unHelpful . jsonOutput $ opts++    -- Write the csv if necessary.+    mapM_ (\x -> B.writeFile x . printNodeAssignments . getNodeAssignments $ gr)+      . unHelpful+      . csvOutput+      $ opts      when (unHelpful . interactive $ opts) $ interactiveDiagram tree labelMap (Nothing :: Maybe NamedMatrix) simMat 

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: birch-beer-version: 0.2.3.0+version: 0.2.4.0 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz

@@ -20,6 +20,7 @@     , inputMatrix :: Maybe String <?> "([Nothing] | FILE) The input adjacency matrix file for CollectionGraph (matrix market format if ends in .mtx, \"i,j,value\" without header otherwise and text labels will be sorted when converting indices)."     , output :: Maybe String <?> "([dendrogram.svg] | FILE) The filename for the dendrogram. Supported formats are PNG, PS, PDF, and SVG."     , jsonOutput :: Maybe String <?> "([Nothing] | FILE) The filename for the output json tree. The input tree can change based on pruning, so this option provides a way to output the new tree as a json."+    , csvOutput :: Maybe String <?> "([Nothing] | FILE) The filename for the output csv containing node assignment for each item. The input tree can change based on pruning, so this option provides a way to view the new assignments as a csv."     , delimiter :: Maybe Char <?> "([,] | CHAR) The delimiter for csv files."     , labelsFile :: Maybe String <?> "([Nothing] | FILE) The input file containing the label for each item, with \"item,label\" header."     , minSize :: Maybe Int <?> "([1] | INT) The minimum size of a cluster. Defaults to 1."@@ -53,6 +54,7 @@ modifiers = lispCaseModifiers { shortNameModifier = short }   where     short "customCut"            = Nothing+    short "csvOutput"            = Nothing     short "drawCollection"       = Just 'D'     short "drawColors"           = Just 'R'     short "drawDiscretize"       = Nothing

@@ -7,6 +7,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}  module BirchBeer.Utility     ( getMostFrequent@@ -34,6 +35,8 @@     , subsetLabelColorMap     , getHighLowColors     , closestColor+    , getNodeAssignments+    , printNodeAssignments     ) where  -- Remote@@ -46,9 +49,12 @@ import Data.Monoid ((<>)) import Data.Tree (Tree (..), flatten) import Safe (atMay, headMay)+import TextShow (showt) import qualified Control.Lens as L import qualified Data.Clustering.Hierarchical as HC+import qualified Data.Csv as CSV import qualified Math.Clustering.Hierarchical.Spectral.Types as HSC+import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Foldable as F import qualified Data.Graph.Inductive as G import qualified Data.Map.Strict as Map@@ -373,3 +379,27 @@ -- | Euclidean distance between two lists. euclideanDist :: [Double] -> [Double] -> Double euclideanDist xs = sqrt . sum . zipWith (\x y -> (x - y) ** 2) xs++-- | Get a list of clusters for each item.+getNodeAssignments :: (TreeItem a) => ClusterGraph a -> [(a, [Cluster])]+getNodeAssignments =+  concatMap (\ (!ns, (_, !xs))+            -> zip (maybe [] F.toList xs) . repeat . fmap Cluster $ ns+            )+      . F.toList+      . flip getGraphLeavesWithParents 0+      . unClusterGraph++-- | Print the node assignments.+printNodeAssignments :: (TreeItem a) => [(a, [Cluster])] -> B.ByteString+printNodeAssignments cr = header <> "\n" <> body+  where+    header = "item,cluster,path"+    body = CSV.encode+         . fmap (\ (!ci, !(c:cs))+                -> ( unId . getId $ ci+                   , showt $ unCluster c+                   , T.intercalate "/" . fmap (showt . unCluster) $ c:cs+                   )+                 )+         $ cr