packages feed

hierarchical-clustering-diagrams (empty) → 0.1

raw patch · 6 files changed

+369/−0 lines, 6 filesdep +HUnitdep +basedep +diagrams-cairosetup-changedbinary-added

Dependencies added: HUnit, base, diagrams-cairo, diagrams-lib, hierarchical-clustering, hierarchical-clustering-diagrams, hspec

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Felipe Lessa++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Felipe Lessa nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example.png view

binary file changed (absent → 6031 bytes)

+ hierarchical-clustering-diagrams.cabal view
@@ -0,0 +1,55 @@+Name:                hierarchical-clustering-diagrams+Version:             0.1+Synopsis:            Draw diagrams of dendrograms made by hierarchical-clustering.+License:             BSD3+License-file:        LICENSE+Author:              Felipe Lessa+Maintainer:          felipe.lessa@gmail.com+Category:            Clustering, Graphics+Build-type:          Simple+Cabal-version:       >=1.8+Description:+  This package contains functions for drawing diagrams of+  dendrograms.  You may see a simple image sample at+  <https://patch-tag.com/r/felipe/hierarchical-clustering-diagrams/snapshot/current/content/pretty/example.png>.+  See the documentation at "Diagrams.Dendrogram" to see how to+  reproduce this diagram.++Extra-source-files:+  tests/runtests.hs+  example.png++Source-repository head+  type: darcs+  location: http://patch-tag.com/r/felipe/hierarchical-clustering-diagrams+++Library+  Hs-source-dirs: src+  Exposed-modules:+      Diagrams.Dendrogram+  Build-depends:+      base                    == 4.*++    , hierarchical-clustering == 0.4.*++    , diagrams-lib            == 0.4.*+  GHC-options: -Wall++Test-suite runtests+  Type: exitcode-stdio-1.0+  Hs-source-dirs: tests+  Main-is: runtests.hs+  Build-depends:+      base                    == 4.*++    , hierarchical-clustering == 0.4.*++    , diagrams-lib            == 0.4.*+    , diagrams-cairo          == 0.4.*++    , hspec                   == 0.9.*+    , HUnit                   == 1.2.*++    , hierarchical-clustering-diagrams+  GHC-options: -Wall
+ src/Diagrams/Dendrogram.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+-- | This module contain functions for drawing diagrams of+-- dendrograms.+module Diagrams.Dendrogram+    ( -- * High-level interface+      -- $runnableExample+      dendrogram+    , Width(..)++      -- * Low-level interface+    , dendrogramPath+    , fixedWidth+    , variableWidth+    , X+    , hcatB+    ) where++-- from base+import Control.Arrow (first, second)++-- from hierarchical-clustering+import Data.Clustering.Hierarchical (Dendrogram(..), elements)++-- from diagrams-lib+import Diagrams.Prelude+++-- $runnableExample+--+-- Given a dendrogram @dendro :: 'Dendrogram' a@ and a function+-- @drawItem :: a -> Diagram b R2@ for drawing the items on the+-- leaves of @dendro@, just use @'dendrogram' 'Variable' drawItem+-- dendro :: Diagram b R2@ to draw a diagram of @dendro@.+--+-- Runnable example which produces something like+-- <https://patch-tag.com/r/felipe/hierarchical-clustering-diagrams/snapshot/current/content/pretty/example.png>:+--+-- @+--import Data.Clustering.Hierarchical (Dendrogram(..))+--import Diagrams.Prelude (Diagram, R2, atop, lw, pad, roundedRect, text, (\#))+--import Diagrams.Backend.Cairo.CmdLine (Cairo, defaultMain)+--import qualified Diagrams.Dendrogram as D+--+--main :: IO ()+--main = defaultMain diagram+--+--diagram :: Diagram Cairo R2+--diagram = D.'dendrogram' 'Fixed' char test \# lw 0.1 \# pad 1.1+--+--char :: Char -> Diagram Cairo R2+--char c = pad 1.3 $ roundedRect (1,1) 0.1 \`atop\` text [c]+--+--test :: Dendrogram Char+--test = Branch 5+--         (Branch 2+--           (Branch 1+--             (Leaf \'A\')+--             (Leaf \'B\'))+--           (Leaf \'C\'))+--         (Leaf \'D\')+-- @+++-- | @dendrogram width drawItem dendro@ is a drawing of the+-- dendrogram @dendro@ using @drawItem@ to draw its leafs.  The+-- @width@ parameter controls how whether all items have the same+-- width or not ('Fixed' or 'Variable', respectively, see+-- 'Width').+--+-- Note: you should probably use 'alignT' to align your items.+dendrogram :: (Monoid m, Renderable (Path R2) b) =>+              Width+           -> (a -> AnnDiagram b R2 m)+           -> Dendrogram a+           -> AnnDiagram b R2 m+dendrogram width_ drawItem dendro = (stroke path_ # value mempty)+                                               ===+                                         (items # alignL)+  where+    (path_, items) =+        case width_ of+          Fixed -> let drawnItems = map drawItem (elements dendro)+                       w = width (head drawnItems)+                       (dendro', _) = fixedWidth w dendro+                   in (dendrogramPath dendro', hcatB drawnItems)+          Variable -> first dendrogramPath $ variableWidth drawItem dendro+++-- | The width of the items on the leafs of a dendrogram.+data Width =+      Fixed+      -- ^ @Fixed@ assumes that all items have a fixed width+      -- (which is automatically calculated).  This mode is+      -- faster than @Variable@, especially when you have many+      -- items.+    | Variable+      -- ^ @Variable@ does not assume that all items have a fixed+      -- width, so each item may have a different width.  This+      -- mode is slower since it has to calculate the width of+      -- each item separately.+++-- | A dendrogram path that can be 'stroke'd later.  This function+-- assumes that the 'Leaf'@s@ of your 'Dendrogram' are already in+-- the right position.+dendrogramPath :: Dendrogram X -> Path R2+dendrogramPath = mconcat . fst . go []+    where+      go acc (Leaf x)       = (acc, (x, 0))+      go acc (Branch d l r) = (path : acc'', pos)+        where+          (acc',  (!xL, !yL)) = go acc  l+          (acc'', (!xR, !yR)) = go acc' r++          path = fromVertices [ P (xL, yL)+                              , P (xL, d)+                              , P (xR, d)+                              , P (xR, yR)]+          pos  = ((xL + xR) / 2, d)+++-- | The horizontal position of a dendrogram Leaf.+type X = Double+++-- | @fixedWidth w@ positions the 'Leaf'@s@ of a 'Dendrogram'+-- assuming that they have the same width @w@.  Also returns the+-- total width.+fixedWidth :: Double -> Dendrogram a -> (Dendrogram X, Double)+fixedWidth w = second (subtract half_w) . go half_w+    where+      half_w = w/2+      go !y (Leaf _)       = (Leaf y, y + w)+      go !y (Branch d l r) = (Branch d l' r', y'')+          where+            (l', !y')  = go y  l+            (r', !y'') = go y' r+++-- | @variableWidth draw@ positions the 'Leaf'@s@ of a+-- 'Dendrogram' according to the diagram generated by 'draw'.+-- Each 'Leaf' may have a different width.  Also returns the+-- resulting diagram having all 'Leaf'@s@ drawn side-by-side.+--+-- Note: you should probably use 'alignT' to align your items.+variableWidth :: (Monoid m) =>+                 (a -> AnnDiagram b R2 m)+              -> Dendrogram a+              -> (Dendrogram X, AnnDiagram b R2 m)+variableWidth draw = finish . go 0 []+    where+      go !y acc (Leaf a) = (Leaf y', y'', dia : acc)+          where+            dia  = draw a+            !w   = width dia+            !y'  = y + w/2+            !y'' = y + w+      go !y acc (Branch d l r) = (Branch d l' r', y'', acc'')+          where+            (l', !y',  acc'') = go y  acc' l -- yes, this is acc'+            (r', !y'', acc')  = go y' acc r+      finish (dendro, _, dias) = (dendro, hcatB dias)+      -- We used to concatenate diagrams inside 'go' using (|||).+      -- However, pathological dendrograms (such as those created+      -- using single linkage) may be highly unbalanced, creating+      -- a performance problem for 'variableWidth'.+++-- | Like 'hcat', but balanced.  Much better performance.  Use it+-- for concatenating the items of your dendrogram.+hcatB :: Monoid m => [AnnDiagram b R2 m] -> AnnDiagram b R2 m+hcatB [y] = y+hcatB ys  = hcatB $ dubs ys+  where dubs (x1:x2:xs) = x1 ||| x2 : dubs xs+        dubs [x]        = [x]+        dubs []         = []
+ tests/runtests.hs view
@@ -0,0 +1,106 @@+-- from base+import System.Environment (getArgs)++-- from hierarchical-clustering+import Data.Clustering.Hierarchical++-- from diagrams-lib+import Diagrams.Prelude++-- from diagrams-cairo+import Diagrams.Backend.Cairo (Cairo)+import Diagrams.Backend.Cairo.CmdLine (multiMain)++-- from hspec+import Test.Hspec.Monadic (hspecX, describe, it)+import Test.Hspec.HUnit ()++-- from HUnit+import Test.HUnit ((~?=))++-- from this package+import qualified Diagrams.Dendrogram as D++++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> testsMain+    _  -> diaMain+++testsMain :: IO ()+testsMain = hspecX $ do+  describe "fixedWidth" $ do+    it "works on a test example" $+       D.fixedWidth 1 test ~?=+          ( Branch 5+              (Branch 2+                (Branch 1+                  (Leaf 0.5)+                  (Leaf 1.5))+                (Leaf 2.5))+              (Leaf 3.5)+          , 4)++  describe "variableWidth" $ do+    let r :: Double -> Diagram Cairo R2+        r w = rect w 40+    it "works on a test example with fixed widths" $+       fst (D.variableWidth (const $ r 1) test) ~?=+          Branch 5+            (Branch 2+              (Branch 1+                (Leaf 0.5)+                (Leaf 1.5))+              (Leaf 2.5))+            (Leaf 3.5)+    let test2 = fmap f test+        f 'A' = 5+        f 'B' = 3+        f 'C' = 10+        f 'D' = 1+        f _   = undefined+    it "works on a test example with variable widths" $+       fst (D.variableWidth r test2) ~?=+          Branch 5+            (Branch 2+              (Branch 1+                (Leaf 2.5)+                (Leaf 6.5))+              (Leaf 13))+            (Leaf 18.5)+++++diaMain :: IO ()+diaMain =+    multiMain $ [ ("test", D.dendrogram D.Variable char test # lw 0.1) ] +++                [ ("alpha-" ++ n, D.dendrogram D.Fixed char (alpha l) # lw 0.1)+                  | (n,l) <- [ ("single",   SingleLinkage)+                             , ("complete", CompleteLinkage)+                             , ("clink",    CLINK)+                             , ("upgma",    UPGMA)+                             ]+                ]+++char :: Char -> Diagram Cairo R2+char c = pad 1.3 $ roundedRect (1,1) 0.1 `atop` text [c]++test :: Dendrogram Char+test = Branch 5+         (Branch 2+           (Branch 1+             (Leaf 'A')+             (Leaf 'B'))+           (Leaf 'C'))+         (Leaf 'D')++alpha :: Linkage -> Dendrogram Char+alpha link = dendrogram link ['A'..'Z'] dist+    where+      dist a b = fromIntegral $ abs (fromEnum a - fromEnum b)