fgl-extras-decompositions (empty) → 0.1.0.0

raw patch · 4 files changed

+160/−0 lines, 4 filesdep +basedep +containersdep +fglsetup-changed

Dependencies added: base, containers, fgl

Files

• Data/Graph/Inductive/Query/Ear.hs +88/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• fgl-extras-decompositions.cabal +40/−0

@@ -0,0 +1,88 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- | Ear decomposition of a graph.++module Data.Graph.Inductive.Query.Ear where++import Data.Function+import Data.Graph.Inductive.Basic+import Data.Graph.Inductive.Example+import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.Query+import Data.Graph.Inductive.Tree+import Data.List+import Data.Tree+import Data.Tuple++++-- | The 'ears' function takes a graph with no node or edge annotation and+-- produces an ear decomposition. Each edge is annotated with a weight. Edges+-- with the same weight are in the same ear.++ears :: forall gr . DynGraph gr => gr () () -> gr () Int+ears g+  | isConnected g = gWs+  | otherwise = error "called ears on disconnected graph"+  where+    t :: Tree Node+    [t] = dff' g+    tps = treeToPaths t+    te = treeToEdges t+    g' = mkUGraph (nodes g) ((edges g \\ te) \\ (map swap te)) `asTypeOf` g+    -- gE is the graph of all edges not in the spanning tree. The edge weight+    -- is the distance between the tree root and the lowest common ancestor of+    -- the two nodes making up each edge+    gE :: gr () Int  = mkGraph (labNodes g') (map (lca tps) $ labEdges g')+    gE'  = mkGraph (labNodes gE) (labEdges gE ++ map (\(a,b) -> (a,b,0)) (te ++ map swap te))+    teWs = map (shortestPaths gE') te+    gWs  = mkGraph (labNodes g') (labEdges gE ++ teWs ++ map swap12 teWs)++shortestPaths :: Gr () Int -> Edge -> LEdge Int+shortestPaths g (u,v) = (u,v,spLength u v g') where+  g' = delEdge (u,v) $ delEdge (v,u) g++lca :: [[Node]] -> (LEdge ()) -> (LEdge Int)+lca ps (u,v,())+  | any null ps = error $ "null path: " ++ show ps+  | otherwise = (u,v,) . (subtract 1) . length . filter (uncurry (==)) $ zip u' v' where+  [u'] = filter ((==u) . last) ps+  [v'] = filter ((==v) . last) ps++swap12 (a,b,c) = (b,a,c)++sel3 (_,_,s) = s++-- tree edges++treeToEdges :: Tree Node -> [Edge]+treeToEdges (Node _ []) = []+treeToEdges (Node k xs) = map ((k,) . rootLabel) xs ++ concatMap treeToEdges xs++-- paths+treeToPaths :: Tree Node -> [[Node]]+treeToPaths (Node k []) = [[k]]+treeToPaths (Node k xs) = [[k]] ++ [ (k:ys) | ys <- concatMap treeToPaths xs ]++++{-+ - Test graph+ -++fig13 :: Gr () ()+fig13 = undir $ mkUGraph ns es where+  ns = [1..9]+  es = [ (1,2),(1,4)+       , (2,3),(2,5)+       , (3,4),(3,6)+       , (4,7)+       , (5,6),(5,8)+       , (6,7)+       , (7,9)+       , (8,9)+       ]++-}+

@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 2013++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 Christian Hoener zu Siederdissen 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,40 @@+Name:           fgl-extras-decompositions+Version:        0.1.0.0+License:        BSD3+License-file:   LICENSE+Author:         Christian Hoener zu Siederdissen+Maintainer:     choener@tbi.univie.ac.at+Copyright:      Christian Hoener zu Siederdissen, 2013+Homepage:       http://www.tbi.univie.ac.at/~choener/+Stability:      Experimental+Category:       Data+Build-type:     Simple+Cabal-version:  >=1.6+Synopsis:+                Graph decomposition algorithms+Description:+                Graph decompositions of fgl graphs. This library is rather+                experimental.+                .+                Currently:+                .+                - ear decomposition+                .+                .+                .+                Patches and ideas welcome.++Library+  Exposed-modules:+    Data.Graph.Inductive.Query.Ear+  Build-depends:+    base        >= 4 && <5  ,+    containers              ,+    fgl         >= 5.4+  ghc-options:+    -O2++source-repository head+  type: git+  location: git://github.com/choener/fgl-extras-decompositions+