packages feed

birch-beer 0.2.4.2 → 0.2.5.0

raw patch · 7 files changed

+39/−17 lines, 7 files

Files

app/Main.hs view
@@ -138,6 +138,10 @@         drawScaleSaturation' =             fmap DrawScaleSaturation . unHelpful . drawScaleSaturation $ opts         drawFont' = fmap DrawFont . unHelpful . drawFont $ opts+        drawItemLineWeight' = fmap DrawItemLineWeight+                            . unHelpful+                            . drawItemLineWeight+                            $ opts         output'           =             fromMaybe "dendrogram.svg" . unHelpful . output $ opts @@ -204,6 +208,7 @@                         , _birchDrawDiscretize      = drawDiscretize'                         , _birchDrawScaleSaturation = drawScaleSaturation'                         , _birchDrawFont            = drawFont'+                        , _birchDrawItemLineWeight  = drawItemLineWeight'                         , _birchTree                = tree                         , _birchMat                 = Nothing                         , _birchSimMat              = simMat
birch-beer.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: birch-beer-version: 0.2.4.2+version: 0.2.5.0 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz
src/BirchBeer/Interactive.hs view
@@ -91,6 +91,9 @@     drawScaleSaturation' <-         fmap (Just . DrawScaleSaturation)             $ TS.spinButtonAt 1 "Saturate colors in the HSV model" 1+    drawItemLineWeight' <-+        fmap (Just . DrawItemLineWeight)+            $ TS.spinButtonAt 0.1 "Line weight for item in collection" 1      return $         let drawLeaf' = case drawLeafTemp of@@ -122,6 +125,7 @@                             , _birchDrawDiscretize      = Nothing                             , _birchDrawScaleSaturation = drawScaleSaturation'                             , _birchDrawFont            = Nothing+                            , _birchDrawItemLineWeight  = drawItemLineWeight'                             , _birchTree                = tree                             , _birchMat                 = mat                             , _birchSimMat              = simMat
src/BirchBeer/MainDiagram.hs view
@@ -103,6 +103,8 @@         drawDiscretize'   = _birchDrawDiscretize config         drawScaleSaturation' = _birchDrawScaleSaturation config         drawFont'         = fromMaybe (DrawFont "Arial") $ _birchDrawFont config+        drawItemLineWeight' = fromMaybe (DrawItemLineWeight 0.1)+                            $ _birchDrawItemLineWeight config         order'            = fromMaybe (Order 1) $ _birchOrder config         mat               = return $ _birchMat config         simMat            = _birchSimMat config@@ -134,6 +136,7 @@                                 drawMaxLeafNodeSize'                                 drawNoScaleNodes'                                 drawLegendSep'+                                drawItemLineWeight'      -- Get the color of each label.     let labelColorMapRaw =
src/BirchBeer/Options.hs view
@@ -46,6 +46,7 @@     , drawColors :: Maybe String <?> "([Nothing] | COLORS) Custom colors for the labels or continuous features. Will repeat if more labels than provided colors. For continuous feature plots, uses first two colors [high, low], defaults to [red, gray]. For instance: --draw-colors \"[\\\"#e41a1c\\\", \\\"#377eb8\\\"]\""     , drawDiscretize :: Maybe String <?> "([Nothing] | COLORS | INT) Discretize colors by finding the nearest color for each item and node. For instance, --draw-discretize \"[\\\"#e41a1c\\\", \\\"#377eb8\\\"]\" will change all node and item colors to one of those two colors, based on Euclidean distance. If using \"--draw-discretize INT\", will instead take the default map and segment (or interpolate) it into INT colors, rather than a more continuous color scheme. May have unintended results when used with --draw-scale-saturation."     , drawScaleSaturation :: Maybe Double <?> "([Nothing] | DOUBLE) Multiply the saturation value all nodes by this number in the HSV model. Useful for seeing more visibly the continuous colors by making the colors deeper against a gray scale."+    , drawItemLineWeight :: Maybe Double <?> "([0.1] | DOUBLE) The line weight for items in the leaves if shown. Supplied as if there are too many items, the collection may look like a black box. Set to 0 to disable outlines of items to avoid this."     , drawFont :: Maybe String <?> "([Arial] | FONT) Specify the font to use for the labels when plotting."     , interactive :: Bool <?> "Display interactive tree."     } deriving (Generic)
src/BirchBeer/Plot.hs view
@@ -165,12 +165,12 @@ -- | Plot the leaf of a dendrogram as a collection of items. dendrogramLeafItem     :: (TreeItem a)-    => Maybe ItemColorMap -> V.Vector a -> Diagram B-dendrogramLeafItem Nothing leaf = getItem black # centerX # pad 1.3 # alignT-dendrogramLeafItem (Just (ItemColorMap cm)) leaf =+    => Maybe ItemColorMap -> DrawItemLineWeight -> V.Vector a -> Diagram B+dendrogramLeafItem Nothing w leaf = getItem w black # centerX # pad 1.3 # alignT+dendrogramLeafItem (Just (ItemColorMap cm)) w leaf =     (vcat . fmap hcat . Split.chunksOf 10 $ items) # centerX # pad 1.3 # alignT   where-    items  = fmap getItem colors+    items  = fmap (getItem w) colors     colors = sort            . fmap (flip (Map.findWithDefault black) cm . getId)            . V.toList@@ -192,13 +192,17 @@     color = getMostFrequentColorList cm . F.toList $ items  -- | Plot the node of a graph as a collection of items.-drawGraphItem :: (TreeItem a) => Maybe ItemColorMap -> Seq.Seq a -> Diagram B-drawGraphItem Nothing _ = getItem black # centerX # pad 1.3 # center-drawGraphItem (Just (ItemColorMap cm)) node =+drawGraphItem :: (TreeItem a)+              => Maybe ItemColorMap+              -> DrawItemLineWeight+              -> Seq.Seq a+              -> Diagram B+drawGraphItem Nothing w _ = getItem w black # centerX # pad 1.3 # center+drawGraphItem (Just (ItemColorMap cm)) w node =     (vcat . fmap hcat . Split.chunksOf boxSize $ items) # center   where     boxSize = floor . sqrt . fromIntegral . Seq.length $ node-    items  = fmap getItem colors+    items  = fmap (getItem w) colors     colors = sort            . fmap (flip (Map.findWithDefault black) cm . getId)            . F.toList@@ -236,8 +240,8 @@         hide (axes . traversed)  -- | Draw a single item.-getItem :: Kolor -> Diagram B-getItem color = circle 1 # lc black # fc color # lwL 0.1 -- Unfortunately cannot change to lwL or they disappear with certain scalings.+getItem :: DrawItemLineWeight -> Kolor -> Diagram B+getItem (DrawItemLineWeight w) color = circle 1 # lc black # fc color # lwL w  -- | Legend text size. legendFontSize :: Double@@ -495,10 +499,10 @@     background x@(CollectionGraph{}) = roundedRect (width (collectionDia x)) (height (collectionDia x)) 1 # fc white # lw none # scaleUToY (scaleVal * 1.1)     background _       = circle 1 # fc white # lw none # scaleUToY scaleVal     itemsDia              = getItemsDia $ _drawCollection opts-    getItemsDia PieNone   = scaleUToY scaleVal $ drawGraphItem cm items+    getItemsDia PieNone   = scaleUToY scaleVal $ drawGraphItem cm (_drawItemLineWeight opts) items     getItemsDia PieChart  = mempty     getItemsDia (CollectionGraph{}) = mempty-    getItemsDia _         = scaleUToY (0.5 * scaleVal) $ drawGraphItem cm items+    getItemsDia _         = scaleUToY (0.5 * scaleVal) $ drawGraphItem cm (_drawItemLineWeight opts) items     collectionDia PieNone = mempty     collectionDia x       =         scaleUToY scaleVal $ drawCollectionItem x cm lgdm n items@@ -543,8 +547,8 @@ -- | Plot the graph of a leaf. plotLeafGraph     :: (Ord a, TreeItem a)-    => Maybe ItemColorMap -> LeafGraph a -> IO (Diagram B)-plotLeafGraph cm (LeafGraph gr) = do+    => Maybe ItemColorMap -> DrawItemLineWeight -> LeafGraph a -> IO (Diagram B)+plotLeafGraph cm ilw (LeafGraph gr) = do     let params :: (TreeItem a) => G.GraphvizParams Int (G.Node, a) Double () (G.Node, a)         params = G.defaultDiaParams             { G.fmtEdge = (\(_, _, w) -> [G.Weight . G.Int . round $ 100 * w])@@ -554,7 +558,7 @@     layout <- G.layoutGraph G.Neato gr      let drawNode (_, x) pos =-            ( getItem+            ( getItem ilw                 . maybe black ( Map.findWithDefault black (getId x)                               . unItemColorMap                               )@@ -606,7 +610,7 @@     lgdm <- sequence           . fmap ( fmap LeafGraphDiaMap                  . sequence-                 . Map.map (plotLeafGraph cm)+                 . Map.map (plotLeafGraph cm (_drawItemLineWeight opts))                  . unLeafGraphMap                  )           $ lgm
src/BirchBeer/Types.hs view
@@ -175,6 +175,9 @@ newtype DrawFont = DrawFont     { unDrawFont :: String     } deriving (Read,Show)+newtype DrawItemLineWeight = DrawItemLineWeight+    { unDrawItemLineWeight :: Double+    } deriving (Read,Show) newtype ClusterGraph a = ClusterGraph     { unClusterGraph :: G.Gr (G.Node, Maybe (Seq.Seq a)) ClusterEdge     } deriving (Read, Show)@@ -224,6 +227,7 @@     , _drawMaxLeafNodeSize  :: DrawMaxLeafNodeSize     , _drawNoScaleNodesFlag :: DrawNoScaleNodesFlag     , _drawLegendSep        :: DrawLegendSep+    , _drawItemLineWeight   :: DrawItemLineWeight     } deriving (Read,Show)  data Config a b = Config@@ -252,6 +256,7 @@     , _birchDrawDiscretize      :: Maybe DrawDiscretize     , _birchDrawScaleSaturation :: Maybe DrawScaleSaturation     , _birchDrawFont            :: Maybe DrawFont+    , _birchDrawItemLineWeight  :: Maybe DrawItemLineWeight     , _birchTree                :: Tree (TreeNode (V.Vector a))     , _birchMat                 :: Maybe b     , _birchSimMat              :: Maybe (SimMatrix b)