birch-beer 0.2.0.0 → 0.2.1.0
raw patch · 7 files changed
+47/−33 lines, 7 files
Files
- app/Main.hs +2/−0
- birch-beer.cabal +1/−1
- src/BirchBeer/Interactive.hs +1/−0
- src/BirchBeer/MainDiagram.hs +4/−1
- src/BirchBeer/Options.hs +16/−14
- src/BirchBeer/Plot.hs +19/−17
- src/BirchBeer/Types.hs +4/−0
app/Main.hs view
@@ -128,6 +128,7 @@ finalError err x = "Error in draw-discretize: " <> err <> " " <> x drawScaleSaturation' = fmap DrawScaleSaturation . unHelpful . drawScaleSaturation $ opts+ drawFont' = fmap DrawFont . unHelpful . drawFont $ opts output' = fromMaybe "dendrogram.svg" . unHelpful . output $ opts @@ -191,6 +192,7 @@ , _birchDrawColors = drawColors' , _birchDrawDiscretize = drawDiscretize' , _birchDrawScaleSaturation = drawScaleSaturation'+ , _birchDrawFont = drawFont' , _birchTree = tree , _birchMat = Nothing , _birchSimMat = simMat
birch-beer.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: birch-beer-version: 0.2.0.0+version: 0.2.1.0 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz
src/BirchBeer/Interactive.hs view
@@ -119,6 +119,7 @@ , _birchDrawColors = drawColors' , _birchDrawDiscretize = Nothing , _birchDrawScaleSaturation = drawScaleSaturation'+ , _birchDrawFont = Nothing , _birchTree = tree , _birchMat = mat , _birchSimMat = simMat
src/BirchBeer/MainDiagram.hs view
@@ -85,6 +85,7 @@ drawColors' = _birchDrawColors config drawDiscretize' = _birchDrawDiscretize config drawScaleSaturation' = _birchDrawScaleSaturation config+ drawFont' = fromMaybe (DrawFont "Arial") $ _birchDrawFont config order' = fromMaybe (Order 1) $ _birchOrder config mat = return $ _birchMat config simMat = _birchSimMat config@@ -208,6 +209,7 @@ (DrawItem (DrawContinuous x)) -> fmap ( fmap ( plotContinuousLegend+ drawFont' drawColors' discreteColors (fromMaybe (DrawScaleSaturation 1) drawScaleSaturation')@@ -219,6 +221,7 @@ fmap ( fmap ( plotSumContinuousLegend+ drawFont' drawColors' discreteColors (fromMaybe (DrawScaleSaturation 1) drawScaleSaturation')@@ -230,7 +233,7 @@ lm <- labelMap' lcm <- labelColorMap return- . plotLabelLegend+ . plotLabelLegend drawFont' . bool (subsetLabelColorMap gr lm) id
src/BirchBeer/Options.hs view
@@ -43,6 +43,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."+ , drawFont :: Maybe String <?> "([Arial] | FONT) Specify the font to use for the labels when plotting." , interactive :: Bool <?> "Display interactive tree." } deriving (Generic) @@ -50,27 +51,28 @@ modifiers = lispCaseModifiers { shortNameModifier = short } where short "customCut" = Nothing- short "inputMatrix" = Just 'X'- short "minSize" = Just 'M'- short "maxStep" = Just 'S'- short "maxProportion" = Just 'P'- short "minDistance" = Just 'T'- short "minDistanceSearch" = Nothing- short "drawLeaf" = Just 'L' short "drawCollection" = Just 'D'+ short "drawColors" = Just 'R' short "drawDiscretize" = Nothing- short "drawNodeNumber" = Just 'N'+ short "drawFont" = Nothing+ short "drawLeaf" = Just 'L'+ short "drawLegendAllLabels" = Just 'J'+ short "drawLegendSep" = Just 'Q' short "drawMark" = Just 'K'- short "drawColors" = Just 'R'- short "drawNoScaleNodes" = Just 'W'- short "drawMaxNodeSize" = Just 'A' short "drawMaxLeafNodeSize" = Nothing- short "drawLegendSep" = Just 'Q'- short "drawLegendAllLabels" = Just 'J'+ short "drawMaxNodeSize" = Just 'A'+ short "drawNoScaleNodes" = Just 'W'+ short "drawNodeNumber" = Just 'N' short "drawPalette" = Just 'Y' short "drawScaleSaturation" = Just 'V'- short "order" = Just 'O'+ short "inputMatrix" = Just 'X' short "interactive" = Just 'I'+ short "maxProportion" = Just 'P'+ short "maxStep" = Just 'S'+ short "minDistance" = Just 'T'+ short "minDistanceSearch" = Nothing+ short "minSize" = Just 'M'+ short "order" = Just 'O' short x = firstLetter x instance ParseRecord Options where
src/BirchBeer/Plot.hs view
@@ -243,15 +243,15 @@ legendFontSize :: Double legendFontSize = (/ 2.5) $ (def :: Legend B Double) ^. legendSpacing -plotLabelLegend :: LabelColorMap -> Diagram B-plotLabelLegend = flip (drawLegend emptyBox) legendOpts- . fmap plotLabel- . Map.toAscList- . unLabelColorMap+plotLabelLegend :: DrawFont -> LabelColorMap -> Diagram B+plotLabelLegend (DrawFont font') = flip (drawLegend emptyBox) legendOpts+ . fmap plotLabel+ . Map.toAscList+ . unLabelColorMap where legendOpts :: Legend B Double legendOpts =- over legendTextStyle (const (mempty # font "Arial" # fontSizeL legendFontSize))+ over legendTextStyle (const (mempty # font font' # fontSizeL legendFontSize)) . over legendStyle (lw none) $ def plotLabel :: (Label, Colour Double) -> (Diagram B, String)@@ -261,9 +261,9 @@ ) -- | Continous style of color bar.-cbOpts :: Maybe DiscreteColorMap -> ColourBar B Double-cbOpts discreteColors =- over tickLabelStyle (font "Arial" # fontSizeL legendFontSize)+cbOpts :: DrawFont -> Maybe DiscreteColorMap -> ColourBar B Double+cbOpts (DrawFont font') discreteColors =+ over tickLabelStyle (font font' # fontSizeL legendFontSize) . over colourBarStyle (lwL (0.2 * legendFontSize)) . set majorTicksStyle (mempty # lwL (0.2 * legendFontSize)) . set (minorTicks . visible) False@@ -280,23 +280,24 @@ -- | Get the legend for a feature. Bar from -- https://archives.haskell.org/projects.haskell.org/diagrams/blog/2013-12-03-Palette1.html plotContinuousLegend :: (MatrixLike a)- => Maybe CustomColors+ => DrawFont+ -> Maybe CustomColors -> Maybe DiscreteColorMap -> DrawScaleSaturation -> [Feature] -> a -> Diagram B-plotContinuousLegend customColors discreteColors sat gs mat =+plotContinuousLegend (DrawFont font') customColors discreteColors sat gs mat = either text dia $ getCombinedFeatures gs $ mat where dia fs = vsep (legendFontSize * 1.2) [ text (T.unpack . T.intercalate " " . fmap unFeature $ gs)- # font "Arial"+ # font font' # fontSizeL legendFontSize , rotateBy (3 / 4) $ renderColourBar- (cbOpts discreteColors)+ (cbOpts (DrawFont font') discreteColors) cm (fromMaybe 0 minVal, fromMaybe 0 maxVal) 100@@ -315,17 +316,18 @@ -- | Get the legend for the sum of all features. Bar from -- https://archives.haskell.org/projects.haskell.org/diagrams/blog/2013-12-03-Palette1.html plotSumContinuousLegend :: (MatrixLike a)- => Maybe CustomColors+ => DrawFont+ -> Maybe CustomColors -> Maybe DiscreteColorMap -> DrawScaleSaturation -> a -> Diagram B-plotSumContinuousLegend customColors discreteColors sat mat = vsep+plotSumContinuousLegend (DrawFont font') customColors discreteColors sat mat = vsep (legendFontSize * 1.2)- [ text "Total Sum" # font "Arial" # fontSizeL legendFontSize+ [ text "Total Sum" # font font' # fontSizeL legendFontSize , rotateBy (3 / 4) $ renderColourBar- (cbOpts discreteColors)+ (cbOpts (DrawFont font') discreteColors) cm (fromMaybe 0 minVal, fromMaybe 0 maxVal) 100
src/BirchBeer/Types.hs view
@@ -165,6 +165,9 @@ newtype DrawScaleSaturation = DrawScaleSaturation { unDrawScaleSaturation :: Double } deriving (Read,Show)+newtype DrawFont = DrawFont+ { unDrawFont :: String+ } deriving (Read,Show) newtype ClusterGraph a = ClusterGraph { unClusterGraph :: G.Gr (G.Node, Maybe (Seq.Seq a)) ClusterEdge } deriving (Read, Show)@@ -239,6 +242,7 @@ , _birchDrawColors :: Maybe CustomColors , _birchDrawDiscretize :: Maybe DrawDiscretize , _birchDrawScaleSaturation :: Maybe DrawScaleSaturation+ , _birchDrawFont :: Maybe DrawFont , _birchTree :: Tree (TreeNode (V.Vector a)) , _birchMat :: Maybe b , _birchSimMat :: Maybe (SimMatrix b)