diff --git a/birch-beer.cabal b/birch-beer.cabal --- a/birch-beer.cabal +++ b/birch-beer.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: birch-beer -version: 0.2.5.0 +version: 0.3.1.0 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz diff --git a/src/BirchBeer/ColorMap.hs b/src/BirchBeer/ColorMap.hs --- a/src/BirchBeer/ColorMap.hs +++ b/src/BirchBeer/ColorMap.hs @@ -16,7 +16,9 @@ , getLabelMapThresholdContinuous , labelToItemColorMap , getItemColorMapContinuous + , getItemValueMap , getItemColorMapSumContinuous + , getItemValueMapSum , getCombinedFeatures , getMarkColorMap , getNodeColorMapFromItems @@ -38,6 +40,7 @@ import Data.Colour.Names (black) import Data.Colour.RGBSpace.HSV (hsv, hsvView) import Data.Colour.Palette.ColorSet (rybColor) +import Data.Foldable (foldl') import Data.Function (on) import Data.Int (Int32) import Data.Maybe (fromMaybe, isNothing) @@ -119,6 +122,11 @@ where colors = interpColors (Set.size labels) $ Brewer.brewerSet Brewer.Set1 9 labels = Set.fromList . Map.elems $ lm +getLabelColorMap Blues (LabelMap lm) = + LabelColorMap . Map.fromList . flip zip colors . Set.toAscList $ labels + where + colors = interpColors (Set.size labels) $ Brewer.brewerSet Brewer.Blues 9 + labels = Set.fromList . Map.elems $ lm getLabelColorMap Ryb (LabelMap lm) = LabelColorMap . Map.fromList . flip zip colors . Set.toAscList $ labels where @@ -206,6 +214,18 @@ where (highColor, lowColor) = getHighLowColors customColors +-- | Get the values of each item, where the value is determined by the average +-- of features. +getItemValueMap + :: (MatrixLike a) => [Feature] -> a -> Either String ItemValueMap +getItemValueMap gs mat = + fmap ( ItemValueMap + . Map.fromList + . zip (fmap Id . V.toList . getRowNames $ mat) + ) + . getCombinedFeatures gs + $ mat + -- | For items with several needed features, combine together by averages. getCombinedFeatures :: (MatrixLike a) => [Feature] @@ -217,7 +237,7 @@ <> (show . fmap unFeature $ gs) <> " does not exist." | otherwise = Right - . fmap ((/ n) . sum) + . fmap ((/ n) . foldl' (+) 0) . S.toRowsL . S.fromColsV . fmap (S.extractCol (getMatrix mat)) @@ -263,19 +283,31 @@ $ mat -- | Get the colors of each item, where the color is determined by the sum of --- features in that cell. +-- features in that item. getItemColorMapSumContinuous :: (MatrixLike a) => Maybe CustomColors -> a -> ItemColorMap getItemColorMapSumContinuous customColors mat = ItemColorMap . Map.fromList . zip (fmap Id . V.toList . getRowNames $ mat) . getContinuousColor highColor lowColor - . fmap sum + . fmap (foldl' (+) 0) . S.toRowsL . getMatrix $ mat where (highColor, lowColor) = getHighLowColors customColors + +-- | Get the value of each item, where the value is determined by the sum of +-- features in that item. +getItemValueMapSum :: (MatrixLike a) => a -> ItemValueMap +getItemValueMapSum mat = + ItemValueMap + . Map.fromList + . zip (fmap Id . V.toList . getRowNames $ mat) + . fmap (foldl' (+) 0) + . S.toRowsL + . getMatrix + $ mat -- | Use the outgoing edges of a node to define the mark around the node. -- Min max normalization. diff --git a/src/BirchBeer/Interactive.hs b/src/BirchBeer/Interactive.hs --- a/src/BirchBeer/Interactive.hs +++ b/src/BirchBeer/Interactive.hs @@ -61,7 +61,7 @@ ] drawContinuousGene' <- TS.entry "[GENE] for DrawItem DrawContinuous" drawCollection' <- - TS.radioButton "Leaf shape" PieChart [PieRing, PieNone, CollectionGraph 1 0 []] + TS.radioButton "Leaf shape" PieChart [PieRing, IndividualItems, NoLeaf, Histogram, CollectionGraph 1 0 []] drawMark' <- TS.radioButton "Node mark" MarkNone [MarkModularity] drawPalette' <- TS.radioButton "Palette" Set1 [Hsv, Ryb] drawNodeNumber' <- fmap DrawNodeNumber $ TS.checkBox "Show node number" diff --git a/src/BirchBeer/MainDiagram.hs b/src/BirchBeer/MainDiagram.hs --- a/src/BirchBeer/MainDiagram.hs +++ b/src/BirchBeer/MainDiagram.hs @@ -182,6 +182,21 @@ fmap (fmap (getItemColorMapSumContinuous drawColors')) mat _ -> return defaultGetItemColorMap + -- Get the item value map. + itemValueMap <- + case drawLeaf' of + DrawItem (DrawContinuous x) -> + fmap + ( fmap ( either error id + . getItemValueMap + (fmap Feature x) + ) + ) + mat + DrawItem DrawSumContinuous -> + fmap (fmap getItemValueMapSum) mat + _ -> return Nothing + -- Get the node color map. let itemColorMap = fmap ( ItemColorMap . discretizeColorMapHelper @@ -265,7 +280,9 @@ plot <- plotGraph legend drawConfig + drawFont' itemColorMap + itemValueMap nodeColorMap markColorMap leafGraphMap diff --git a/src/BirchBeer/Options.hs b/src/BirchBeer/Options.hs --- a/src/BirchBeer/Options.hs +++ b/src/BirchBeer/Options.hs @@ -34,7 +34,7 @@ , rootCut :: Maybe Int "([Nothing] | NODE) Assign a new root to the tree, removing all nodes outside of the subtree." , order :: Maybe Double "([1] | DOUBLE) The order of diversity for DrawItem DrawDiversity." , drawLeaf :: Maybe String "([DrawText] | DrawItem DrawItemType) How to draw leaves in the dendrogram. DrawText is the number of items in that leaf. DrawItem is the collection of items represented by circles, consisting of: DrawItem DrawLabel, where each item is colored by its label, DrawItem (DrawContinuous [FEATURE]), where each item is colored by the expression of FEATURE (corresponding to a feature name in the input matrix, [FEATURE] is a list, so if more than one FEATURE is listed, uses the average of the feature values), DrawItem (DrawThresholdContinuous [(FEATURE, DOUBLE)]), where each item is colored by the binary high / low expression of FEATURE based on DOUBLE and multiple FEATUREs can be used to combinatorically label items (FEATURE1 high / FEATURE2 low, etc.), DrawItem DrawSumContinuous, where each item is colored by the sum of the post-normalized columns (use --normalization NoneNorm for UMI counts, default), and DrawItem DrawDiversity, where each node is colored by the diversity based on the labels of each item and the color is normalized separately for the leaves and the inner nodes. The default is DrawText, unless --labels-file is provided, in which DrawItem DrawLabel is the default. If the label or feature cannot be found, the default color will be black (check your spelling!)." - , drawCollection :: Maybe String "([PieChart] | PieRing | PieNone | CollectionGraph MAXWEIGHT THRESHOLD [NODE]) How to draw item leaves in the dendrogram. PieRing draws a pie chart ring around the items. PieChart only draws a pie chart instead of items. PieNone only draws items, no pie rings or charts. (CollectionGraph MAXWEIGHT THRESHOLD [NODE]) draws the nodes and edges within leaves that are descendents of NODE (empty list [] indicates draw all leaf networks) based on the input matrix, normalizes edges based on the MAXWEIGHT, and removes edges for display less than THRESHOLD (after normalization, so for CollectionGraph 2 0.5 [26], draw the leaf graphs for all leaves under node 26, then a edge of 0.7 would be removed because (0.7 / 2) < 0.5). For CollectionGraph with no colors, use --draw-leaf \"DrawItem DrawLabel\" and all nodes will be black. If you don't specify this option, DrawText from --draw-leaf overrides this argument and only the number of cells will be plotted." + , drawCollection :: Maybe String "([PieChart] | PieRing | IndividualItems | Histogram | NoLeaf | CollectionGraph MAXWEIGHT THRESHOLD [NODE]) How to draw item leaves in the dendrogram. PieRing draws a pie chart ring around the items. PieChart only draws a pie chart instead of items. IndividualItems only draws items, no pie rings or charts. Histogram plots a histogram of the features requested. NoLeaf has no leaf, useful if there are so many items the tree takes very long to render. (CollectionGraph MAXWEIGHT THRESHOLD [NODE]) draws the nodes and edges within leaves that are descendents of NODE (empty list [] indicates draw all leaf networks) based on the input matrix, normalizes edges based on the MAXWEIGHT, and removes edges for display less than THRESHOLD (after normalization, so for CollectionGraph 2 0.5 [26], draw the leaf graphs for all leaves under node 26, then a edge of 0.7 would be removed because (0.7 / 2) < 0.5). For CollectionGraph with no colors, use --draw-leaf \"DrawItem DrawLabel\" and all nodes will be black. If you don't specify this option, DrawText from --draw-leaf overrides this argument and only the number of cells will be plotted." , drawMark :: Maybe String "([MarkNone] | MarkModularity | MarkSignificance ) How to draw annotations around each inner node in the tree. MarkNone draws nothing and MarkModularity draws a black circle representing the modularity at that node, darker black means higher modularity for that next split. MarkSignificance is for significance, i.e. p-value, darker means higher value." , drawNodeNumber :: Bool "Draw the node numbers on top of each node in the graph." , drawMaxNodeSize :: Maybe Double "([72] | DOUBLE) The max node size when drawing the graph. 36 is the theoretical default, but here 72 makes for thicker branches." diff --git a/src/BirchBeer/Plot.hs b/src/BirchBeer/Plot.hs --- a/src/BirchBeer/Plot.hs +++ b/src/BirchBeer/Plot.hs @@ -40,6 +40,7 @@ import Math.Clustering.Hierarchical.Spectral.Types (getClusterItemsDend) import Plots import Plots.Axis.ColourBar +import Plots.Axis.Line import Plots.Legend import qualified Control.Foldl as Fold import qualified Control.Lens as L @@ -213,15 +214,18 @@ :: (TreeItem a) => DrawCollection -> Maybe ItemColorMap + -> Maybe (ItemValueMap, (Maybe Double, Maybe Double)) -> Maybe LeafGraphDiaMap -> G.Node -> Seq.Seq a -> Diagram B -drawCollectionItem (CollectionGraph{}) _ Nothing _ _ = mempty -drawCollectionItem (CollectionGraph{}) _ (Just (LeafGraphDiaMap lgdm)) n _ = +drawCollectionItem (CollectionGraph{}) _ _ Nothing _ _ = mempty +drawCollectionItem (CollectionGraph{}) _ _ (Just (LeafGraphDiaMap lgdm)) n _ = fromMaybe mempty . Map.lookup n $ lgdm -drawCollectionItem _ Nothing _ _ _ = mempty -drawCollectionItem drawCollection (Just (ItemColorMap cm)) _ _ items = +drawCollectionItem _ Nothing _ _ _ _ = mempty +drawCollectionItem Histogram _ (Just (vm, range)) _ _ items + = plotHistogram vm range items +drawCollectionItem drawCollection (Just (ItemColorMap cm)) _ _ _ items = renderAxis $ polarAxis &~ do let colorWedge :: (Kolor, Double) -> State (Plot (Wedge Double) b) () colorWedge colorPair = do @@ -233,6 +237,7 @@ . F.toList $ items + axisStyle .= vividColours piePlot colorPairs snd $ onWedges colorWedge case drawCollection of PieChart -> return () @@ -436,12 +441,13 @@ drawNode n p = drawGraphNode -- DrawText is irrelevant here. (resetLeafSize opts) Nothing + Nothing ncm Nothing Nothing gr (n, Nothing) - p + p resetLeafSize x = x { _drawMaxLeafNodeSize = DrawMaxLeafNodeSize -- Reset the leaf node size to behave like an inner node. . unDrawMaxNodeSize . _drawMaxNodeSize @@ -456,10 +462,26 @@ then scaleUToX else scaleUToY +-- | Get the relative size of the node for inner nodes. +getNodeSize :: (TreeItem a) + => DrawConfig + -> ClusterGraph a + -> Seq.Seq a + -> Double +getNodeSize opts@(DrawConfig { _drawNoScaleNodesFlag = DrawNoScaleNodesFlag False}) gr = + isTo totalItems (unDrawMaxNodeSize . _drawMaxNodeSize $ opts) + . fromIntegral + . Seq.length + where + totalItems = fromIntegral . Seq.length . getGraphLeafItems gr $ 0 +getNodeSize opts@(DrawConfig { _drawNoScaleNodesFlag = DrawNoScaleNodesFlag True}) gr = + const (unDrawMaxNodeSize . _drawMaxNodeSize $ opts) + -- | Draw the final node of a graph. drawGraphNode :: (TreeItem a) => DrawConfig -> Maybe ItemColorMap + -> Maybe (ItemValueMap, (Maybe Double, Maybe Double)) -> Maybe NodeColorMap -> Maybe MarkColorMap -> Maybe LeafGraphDiaMap @@ -467,7 +489,7 @@ -> (G.Node, Maybe (Seq.Seq a)) -> P2 Double -> Diagram B -drawGraphNode opts@(DrawConfig { _drawLeaf = DrawText }) cm _ _ _ gr (n, Just items) pos = +drawGraphNode opts@(DrawConfig { _drawLeaf = DrawText }) cm _ _ _ _ gr (n, Just items) pos = ((textDia dnn # fontSizeL (smallestAxis dia)) <> dia <> background) # scaleUToX scaleVal # moveTo pos @@ -483,7 +505,7 @@ then maxLeafNodeSize else getScaledLeafSize maxClusterSize' maxLeafNodeSize items maxClusterSize' = maxClusterSize . unClusterGraph $ gr -drawGraphNode opts@(DrawConfig { _drawLeaf = (DrawItem drawType) }) cm ncm _ lgdm gr (n, Just items) pos = +drawGraphNode opts@(DrawConfig { _drawLeaf = (DrawItem drawType) }) cm vm ncm _ lgdm gr (n, Just items) pos = ((textDia dnn # fontSizeL (smallestAxis dia)) <> dia) # moveTo pos where dia = drawLeafDia drawType @@ -495,17 +517,26 @@ <> itemsDia <> background (_drawCollection opts) ) - background PieNone = roundedRect (width itemsDia) (height itemsDia) 1 # fc white # lw none # scaleUToY (scaleVal * 1.1) + background IndividualItems = roundedRect (width itemsDia) (height itemsDia) 1 # fc white # lw none # scaleUToY (scaleVal * 1.1) background x@(CollectionGraph{}) = roundedRect (width (collectionDia x)) (height (collectionDia x)) 1 # fc white # lw none # scaleUToY (scaleVal * 1.1) + background x@Histogram = roundedRect (width (collectionDia x)) (height (collectionDia x)) 1 # fc white # lw none # opacity 0.5 # scaleUToY (scaleVal * 1.1) + background x@NoLeaf = mempty background _ = circle 1 # fc white # lw none # scaleUToY scaleVal itemsDia = getItemsDia $ _drawCollection opts - getItemsDia PieNone = scaleUToY scaleVal $ drawGraphItem cm (_drawItemLineWeight opts) items + getItemsDia IndividualItems = scaleUToY scaleVal $ drawGraphItem cm (_drawItemLineWeight opts) items getItemsDia PieChart = mempty + getItemsDia Histogram = mempty + getItemsDia NoLeaf = mempty getItemsDia (CollectionGraph{}) = mempty getItemsDia _ = scaleUToY (0.5 * scaleVal) $ drawGraphItem cm (_drawItemLineWeight opts) items - collectionDia PieNone = mempty + collectionDia IndividualItems = mempty + collectionDia NoLeaf = + circle 1 + # fc (getNodeColor ncm n) + # lw none + # scaleUToY (getNodeSize opts gr items) collectionDia x = - scaleUToY scaleVal $ drawCollectionItem x cm lgdm n items + scaleUToY scaleVal $ drawCollectionItem x cm vm lgdm n items scaleVal = if unDrawNoScaleNodesFlag . _drawNoScaleNodesFlag $ opts then maxLeafNodeSize else getScaledLeafSize maxClusterSize' maxLeafNodeSize items @@ -514,11 +545,11 @@ textDia True = text (show n) # fc (bool black white . isNothing $ cm) textDia False = mempty dnn = unDrawNodeNumber . _drawNodeNumber $ opts -drawGraphNode opts cm ncm mcm _ gr (n, Nothing) pos = +drawGraphNode opts cm _ ncm mcm _ gr (n, Nothing) pos = (mark mcm <> mainNode) # moveTo pos where mainNode = ((textDia dnn # fontSizeL 1) <> mainDia) - # scaleUToY (getNodeSize (_drawNoScaleNodesFlag opts) items) + # scaleUToY (getNodeSize opts gr items) mainDia = circle 1 # fc color # rootDiffer n mark :: Maybe MarkColorMap -> Diagram B mark Nothing = mempty @@ -535,14 +566,6 @@ rootDiffer n = lw none color = getNodeColor ncm n items = getGraphLeafItems gr n - getNodeSize :: DrawNoScaleNodesFlag -> Seq.Seq a -> Double - getNodeSize (DrawNoScaleNodesFlag False) = - isTo totalItems (unDrawMaxNodeSize . _drawMaxNodeSize $ opts) - . fromIntegral - . Seq.length - getNodeSize (DrawNoScaleNodesFlag True) = - const (unDrawMaxNodeSize . _drawMaxNodeSize $ opts) - totalItems = fromIntegral . Seq.length . getGraphLeafItems gr $ 0 -- | Plot the graph of a leaf. plotLeafGraph @@ -582,20 +605,67 @@ return $ treeDia # center +-- | Plot the histogram of a leaf. +plotHistogram :: (TreeItem a) + => ItemValueMap + -> (Maybe Double, Maybe Double) + -> Seq.Seq a + -> Diagram B +plotHistogram (ItemValueMap vm) (minVal, maxVal) items + | isNothing minVal || isNothing maxVal = mempty + | fromMaybe 0 minVal >= fromMaybe 0 maxVal = mempty + | otherwise = + center $ renderAxis $ r2Axis &~ do + let values = fmap (flip (Map.findWithDefault 0) vm . getId) + . F.toList + $ items + + hideGridLines + axisStyle .= vividColours + xAxis . axisLineType .= MiddleAxisLine + yAxis . axisLineType .= LeftAxisLine + xAxis . axisLineStyle .= mempty # lwL 0.5 # opacity 0.25 + yAxis . axisLineStyle .= mempty # lw none + -- xAxis . tickLabel . tickLabelPositions %= (\x -> [head x, last x]) + -- yAxis . tickLabel . tickLabelPositions %= (\x -> [head x, last x]) + xAxis . tickLabel . visible .= False + yAxis . tickLabel . visible .= False + + hide (yAxis . minorTicks) + hide (yAxis . majorTicks) + hide (xAxis . minorTicks) + hide (xAxis . majorTicks) + tickLabelStyle .= mempty # fontSize (local 15) # recommendFillColor black + + histogramPlot values $ do + plotColor .= black + numBins .= 20 + binRange .= Just ( (\x -> if x > 0 then 0 else x) -- No value greater than 0 + $ fromMaybe 0 minVal + , fromIntegral . ceiling $ fromMaybe 0 maxVal -- Try to eliminate rounding errors. + ) + -- | Plot a graph rather than a traditional tree. Uses only info in leaves -- rather than a tree which stores all leaves. plotGraph :: (Ord a, TreeItem a) => Maybe (Diagram B) -> DrawConfig + -> DrawFont -> Maybe ItemColorMap + -> Maybe ItemValueMap -> Maybe NodeColorMap -> Maybe MarkColorMap -> Maybe (LeafGraphMap T.Text) -> ClusterGraph a -> IO (Diagram B) -plotGraph legend opts cm ncm mcm lgm (ClusterGraph gr) = do - let numClusters :: Double +plotGraph legend opts font' cm vm ncm mcm lgm (ClusterGraph gr) = do + let + items = Set.fromList + . fmap getId + . F.toList + $ getGraphLeafItems (ClusterGraph gr) 0 + numClusters :: Double numClusters = fromIntegral . Seq.length $ getGraphLeaves gr 0 maxNodeSize = unDrawMaxNodeSize . _drawMaxNodeSize $ opts params :: (TreeItem a) => G.GraphvizParams Int (G.Node, Maybe (Seq.Seq a)) ClusterEdge () (G.Node, Maybe (Seq.Seq a)) @@ -603,6 +673,15 @@ { G.fmtEdge = (\(_, _, !w) -> [G.Len . fromMaybe 0 . L.view edgeDistance $ w]) , G.globalAttributes = [G.GraphAttrs { G.attrs = [G.Sep . G.DVal $ maxNodeSize / 2] }] } + vm' = fmap ( \x -> ( x + , Fold.fold ((,) <$> Fold.minimum <*> Fold.maximum) + . fmap snd + . filter (flip Set.member items . fst) + . Map.toList + . unItemValueMap + $ x) + ) + vm layout <- G.layoutGraph' params G.TwoPi gr @@ -618,7 +697,7 @@ let treeDia = G.drawGraph' G.VerticesOnTop - (drawGraphNode opts cm ncm mcm lgdm (ClusterGraph gr)) + (drawGraphNode opts cm vm' ncm mcm lgdm (ClusterGraph gr)) (drawGraphPath opts ncm (ClusterGraph gr)) layout dia = case legend of @@ -628,7 +707,7 @@ . hsep (unDrawLegendSep . _drawLegendSep $ opts) $ [ alignY 1.5 . lw 0.3 . center . scaleUToX (width treeDia / 8) $ l - , alignT . center $ treeDia + , alignT . center . font (unDrawFont font') $ treeDia ] return dia diff --git a/src/BirchBeer/Types.hs b/src/BirchBeer/Types.hs --- a/src/BirchBeer/Types.hs +++ b/src/BirchBeer/Types.hs @@ -163,6 +163,9 @@ newtype ItemColorMap = ItemColorMap { unItemColorMap :: Map Id Kolor } deriving (Read,Show) +newtype ItemValueMap = ItemValueMap + { unItemValueMap :: Map Id Double + } deriving (Read,Show) newtype MarkColorMap = MarkColorMap { unMarkColorMap :: Map G.Node (AlphaColour Double) } deriving (Read,Show) @@ -212,10 +215,10 @@ | DrawDiversity deriving (Read,Show) data DrawLeaf = DrawItem DrawItemType | DrawText deriving (Read, Show) -data DrawCollection = CollectionGraph Double Double [Int] | PieRing | PieChart | PieNone deriving (Read, Show) +data DrawCollection = CollectionGraph Double Double [Int] | PieRing | PieChart | NoLeaf | Histogram | IndividualItems deriving (Read, Show) data DrawNodeMark = MarkModularity | MarkSignificance | MarkNone deriving (Read, Show) -data Palette = Set1 | Ryb | Hsv | Hcl deriving (Read, Show) +data Palette = Set1 | Blues | Ryb | Hsv | Hcl deriving (Read, Show) data DrawDiscretize = CustomColorMap [Kolor] | SegmentColorMap Int deriving (Read, Show)