diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 --- a/ChangeLog +++ /dev/null @@ -1,3 +0,0 @@ -0.1.0.0 -------- -- Initial release diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,13 @@ +0.2 (2022-05-08) +---------------- + +- Exported the `vertexId` function to project an `Int` from a `Vertex`, which is useful for conversions to other formats (e.g., graphviz) (@benjaminselfridge) +- Fixed a bug in the `BiDigraph` that prevented parallel edges from being added to the graph (@benjaminselfridge) +- Added `Unbox` instances for `Vertex` and `Edge` (@bielr) +- Added a `Bifunctor` instance for the `PatriciaTree` (@kquick) + + +0.1.0.0 (2019-12-18) +-------------------- + +- Initial release diff --git a/haggle.cabal b/haggle.cabal --- a/haggle.cabal +++ b/haggle.cabal @@ -1,5 +1,5 @@ name: haggle -version: 0.1.0.1 +version: 0.2 synopsis: A graph library offering mutable, immutable, and inductive graphs description: This library provides mutable (in ST or IO), immutable, and inductive graphs. There are multiple graphs implementations provided to support different use @@ -7,6 +7,8 @@ and allow users to "pay as they go". Node and edge labels are optional. Haggle also aims to be safer than fgl: there are no partial functions in the API. +homepage: https://github.com/travitch/haggle +bug-reports: https://github.com/travitch/haggle/issues license: BSD3 license-file: LICENSE author: Tristan Ravitch @@ -14,8 +16,8 @@ category: Data Structures, Graphs build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 -extra-source-files: ChangeLog +tested-with: GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2 +extra-source-files: ChangeLog.md README.md library @@ -23,7 +25,7 @@ hs-source-dirs: src ghc-options: -Wall if impl(ghc > 8) - ghc-options: -Wno-compat + ghc-options: -Wcompat exposed-modules: Data.Graph.Haggle, Data.Graph.Haggle.BiDigraph, Data.Graph.Haggle.Classes, @@ -42,11 +44,12 @@ build-depends: base >= 4.5 && < 5, ref-tf >= 0.4 && < 0.6, vector >= 0.9 && < 0.13, + vector-th-unbox >= 0.2.1.3 && < 0.3, primitive >= 0.4 && < 0.9, containers >= 0.4, - hashable < 1.4, + hashable >= 1.2 && < 1.5, deepseq >= 1 && < 2, - monad-primitive + monad-primitive < 0.2 test-suite GraphTests type: exitcode-stdio-1.0 diff --git a/src/Data/Graph/Haggle.hs b/src/Data/Graph/Haggle.hs --- a/src/Data/Graph/Haggle.hs +++ b/src/Data/Graph/Haggle.hs @@ -89,7 +89,7 @@ -- ** Inductive graphs PT.PatriciaTree, -- * Basic types - I.Vertex, + I.Vertex, I.vertexId, I.Edge, I.edgeSource, I.edgeDest, diff --git a/src/Data/Graph/Haggle/Algorithms/DFS.hs b/src/Data/Graph/Haggle/Algorithms/DFS.hs --- a/src/Data/Graph/Haggle/Algorithms/DFS.hs +++ b/src/Data/Graph/Haggle/Algorithms/DFS.hs @@ -55,7 +55,6 @@ import Data.Graph.Haggle import Data.Graph.Haggle.Classes ( maxVertexId ) -import Data.Graph.Haggle.Internal.Basic import Data.Graph.Haggle.Internal.BitSet -- | The most general DFS diff --git a/src/Data/Graph/Haggle/BiDigraph.hs b/src/Data/Graph/Haggle/BiDigraph.hs --- a/src/Data/Graph/Haggle/BiDigraph.hs +++ b/src/Data/Graph/Haggle/BiDigraph.hs @@ -137,10 +137,9 @@ instance MAddEdge MBiDigraph where - addEdge g v1@(V src) v2@(V dst) = do + addEdge g (V src) (V dst) = do nVerts <- R.readRef (mgraphVertexCount g) - exists <- checkEdgeExists g v1 v2 - case exists || src >= nVerts || dst >= nVerts of + case src >= nVerts || dst >= nVerts of True -> return Nothing False -> do eid <- R.readRef (mgraphEdgeIdSrc g) diff --git a/src/Data/Graph/Haggle/Classes.hs b/src/Data/Graph/Haggle/Classes.hs --- a/src/Data/Graph/Haggle/Classes.hs +++ b/src/Data/Graph/Haggle/Classes.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} module Data.Graph.Haggle.Classes ( -- * Basic Types - Vertex, + Vertex, vertexId, Edge, edgeSource, edgeDest, @@ -28,12 +29,16 @@ ) where -import Control.Monad ( forM, liftM ) +import Control.Monad ( forM, liftM ) import qualified Control.Monad.Primitive as P import qualified Control.Monad.Ref as R -import Data.Maybe ( fromMaybe ) -import Data.Graph.Haggle.Internal.Basic +#if MIN_VERSION_base(4, 9, 0) +import Data.Kind ( Type ) +#endif +import Data.Maybe ( fromMaybe ) +import Data.Graph.Haggle.Internal.Basic + -- | The interface supported by a mutable graph. class MGraph g where -- | The type generated by 'freeze'ing a mutable graph @@ -131,7 +136,11 @@ edgeExists g v1 v2 = not . null $ edgesBetween g v1 v2 class (Graph g) => Thawable g where +#if MIN_VERSION_base(4, 9, 0) + type MutableGraph g :: (Type -> Type) -> Type +#else type MutableGraph g :: (* -> *) -> * +#endif thaw :: (P.PrimMonad m, R.MonadRef m) => g -> m (MutableGraph g m) -- | The interface for immutable graphs with efficient access to diff --git a/src/Data/Graph/Haggle/Internal/Basic.hs b/src/Data/Graph/Haggle/Internal/Basic.hs --- a/src/Data/Graph/Haggle/Internal/Basic.hs +++ b/src/Data/Graph/Haggle/Internal/Basic.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell, TypeFamilies #-} + -- | This module defines the most basic types in the library. Their -- representations are required in several modules, but external -- clients should probably not rely on them. @@ -14,6 +16,7 @@ import Control.DeepSeq import Data.Hashable +import Data.Vector.Unboxed.Deriving (derivingUnbox) -- | An abstract representation of a vertex. -- @@ -22,6 +25,11 @@ newtype Vertex = V Int deriving (Eq, Ord, Show) +$(derivingUnbox "Vertex" + [t| Vertex -> Int |] + [| \(V i) -> i |] + [| V |]) + instance Hashable Vertex where hashWithSalt = hashVertex @@ -35,6 +43,11 @@ -- | An edge between two vertices. data Edge = E {-# UNPACK #-}!Int {-# UNPACK #-}!Int {-# UNPACK #-}!Int deriving (Eq, Ord, Show) + +$(derivingUnbox "Edge" + [t| Edge -> (Int, Int, Int) |] + [| \(E eid src dst) -> (eid, src, dst) |] + [| \(eid, src, dst) -> E eid src dst |]) instance Hashable Edge where hashWithSalt = hashEdge diff --git a/src/Data/Graph/Haggle/PatriciaTree.hs b/src/Data/Graph/Haggle/PatriciaTree.hs --- a/src/Data/Graph/Haggle/PatriciaTree.hs +++ b/src/Data/Graph/Haggle/PatriciaTree.hs @@ -5,13 +5,14 @@ -- This formulation does not support parallel edges. module Data.Graph.Haggle.PatriciaTree ( PatriciaTree ) where -import Control.DeepSeq -import Control.Monad ( guard ) -import Data.Foldable ( toList ) -import Data.IntMap ( IntMap ) +import Control.DeepSeq +import Control.Monad ( guard ) +import Data.Bifunctor +import Data.Foldable ( toList ) +import Data.IntMap ( IntMap ) import qualified Data.IntMap as IM -import Data.Maybe ( fromMaybe ) -import Data.Monoid +import Data.Maybe ( fromMaybe ) +import Data.Monoid import Prelude @@ -39,6 +40,14 @@ instance (NFData nl, NFData el) => NFData (PatriciaTree nl el) where rnf (Gr im) = im `deepseq` () + +instance Bifunctor PatriciaTree where + first f (Gr im) = + let onNode (Ctx inM v n outM) = Ctx inM v (f n) outM + in Gr $ fmap onNode im + second f (Gr im) = + let onEdge (Ctx inM v n outM) = Ctx (f <$> inM) v n (f <$> outM) + in Gr $ fmap onEdge im instance I.Graph (PatriciaTree nl el) where vertices = map I.V . IM.keys . graphRepr diff --git a/tests/GraphTests.hs b/tests/GraphTests.hs --- a/tests/GraphTests.hs +++ b/tests/GraphTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | This module tests Haggle by comparing its results to those of FGL. -- This assumes that FGL is reasonably correct. -- @@ -7,15 +8,23 @@ -- return the same results. module Main ( main ) where -import Test.Framework ( defaultMain, testGroup, Test ) +import Test.Framework ( defaultMain, Test ) import Test.Framework.Providers.QuickCheck2 ( testProperty ) +import Test.Framework.Providers.HUnit ( hUnitTestToTests ) +import Test.HUnit import Test.QuickCheck import Control.Arrow ( first, second ) +import qualified Data.Bifunctor as Bi import Control.Monad ( replicateM ) import qualified Data.Foldable as F -import Data.Maybe ( isNothing ) +import qualified Data.List as L +import Data.Maybe ( fromJust, isNothing ) import qualified Data.Set as S +#if MIN_VERSION_base(4, 11, 0) +#else +import Data.Monoid ( (<>) ) +#endif import qualified Data.Graph.Inductive as FGL import qualified Data.Graph.Haggle as HGL @@ -62,7 +71,7 @@ main :: IO () main = defaultMain tests -tests :: [Test] +tests :: [Test.Framework.Test] tests = [ testProperty "prop_sameVertexCount" prop_sameVertexCount , testProperty "prop_sameEdgeCount" prop_sameEdgeCount , testProperty "prop_sameSuccessorsAtLabel" prop_sameSuccessorsAtLabel @@ -72,7 +81,7 @@ , testProperty "prop_sameNoComponents" prop_sameNoComponents , testProperty "prop_immDominatorsSame" prop_immDominatorsSame , testProperty "prop_dominatorsSame" prop_dominatorsSame - ] + ] <> testPatricia prop_sameVertexCount :: GraphPair -> Bool prop_sameVertexCount (GP _ bg tg) = @@ -153,3 +162,41 @@ unique :: (Ord a) => [a] -> [a] unique = S.toList . S.fromList + +---------------------------------------------------------------------- + +-- Explicit tests for various functionality + +testPatricia :: [Test.Framework.Test] +testPatricia = + let gr0 = foldl (\g -> snd . HGL.insertLabeledVertex g) + (HGL.emptyGraph :: HGL.PatriciaTree Int Char) + [1,2,4,3,5,0] + vs = fst <$> HGL.labeledVertices gr0 + gr1 = foldl (\g (f,t,l) -> + snd $ fromJust $ HGL.insertLabeledEdge g f t l) + gr0 + [ (vs !! 1, vs !! 2, 'a') + , (vs !! 0, vs !! 2, 'b') + , (vs !! 1, vs !! 5, 'c') + ] + in hUnitTestToTests $ test + [ "create graph" ~: + do sum (snd <$> HGL.labeledVertices gr1) @?= 15 + L.sort (snd <$> HGL.labeledEdges gr1) @?= "abc" + + , "bifunctor first (nodes)" ~: + do let gr2 = Bi.first (+3) gr1 + sum (snd <$> HGL.labeledVertices gr2) @?= 33 + L.sort (snd <$> HGL.labeledEdges gr2) @?= "abc" + + , "bifunctor second (edges)" ~: + do let gr2 = Bi.second (succ . succ . succ) gr1 + sum (snd <$> HGL.labeledVertices gr2) @?= 15 + L.sort (snd <$> HGL.labeledEdges gr2) @?= "def" + + , "bifunctor bimap" ~: + do let gr2 = Bi.bimap (+2) (succ . succ) gr1 + sum (snd <$> HGL.labeledVertices gr2) @?= 27 + L.sort (snd <$> HGL.labeledEdges gr2) @?= "cde" + ]