Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
74917562
Commit
74917562
authored
Jul 11, 2016
by
Edward Z. Yang
Browse files
Add Distribution.Compat.Graph, fixes #3521.
parent
d3259408
Changes
4
Hide whitespace changes
Inline
Sidebyside
Cabal/Cabal.cabal
View file @
74917562
...
...
@@ 273,6 +273,7 @@ library
Distribution.Compat.CreatePipe
Distribution.Compat.Environment
Distribution.Compat.Exception
Distribution.Compat.Graph
Distribution.Compat.Internal.TempFile
Distribution.Compat.ReadP
Distribution.Compat.Semigroup
...
...
@@ 377,6 +378,7 @@ testsuite unittests
UnitTests.Distribution.Compat.CreatePipe
UnitTests.Distribution.Compat.ReadP
UnitTests.Distribution.Compat.Time
UnitTests.Distribution.Compat.Graph
UnitTests.Distribution.Simple.Program.Internal
UnitTests.Distribution.Simple.Utils
UnitTests.Distribution.System
...
...
@@ 384,7 +386,9 @@ testsuite unittests
UnitTests.Distribution.Version
mainis: UnitTests.hs
builddepends:
array,
base,
containers,
directory,
filepath,
tasty,
...
...
Cabal/Distribution/Compat/Graph.hs
0 → 100644
View file @
74917562
{# LANGUAGE TypeFamilies #}
{# LANGUAGE CPP #}
{# LANGUAGE FlexibleContexts #}
{# LANGUAGE DeriveDataTypeable #}
{# LANGUAGE UndecidableInstances #}
{# LANGUAGE BangPatterns #}

 
 Module : Distribution.Compat.Graph
 Copyright : (c) Edward Z. Yang 2016
 License : BSD3

 Maintainer : cabaldev@haskell.org
 Stability : experimental
 Portability : portable

 A data type representing directed graphs, backed by "Data.Graph".
 It is strict in the node type.

 This is an alternative interface to "Data.Graph". In this interface,
 nodes (identified by the 'IsNode' type class) are associated with a
 key and record the keys of their neighbors. This interface is more
 convenient than 'Data.Graph.Graph', which requires vertices to be
 explicitly handled by integer indexes.

 The current implementation has somewhat peculiar performance
 characteristics. The asymptotics of all maplike operations mirror
 their counterparts in "Data.Map". However, to perform a graph
 operation, we first must build the "Data.Graph" representation, an
 operation that takes /O(V + E log V)/. However, this operation can
 be amortized across all queries on that particular graph.

 Some nodes may be broken, i.e., refer to neighbors which are not
 stored in the graph. In our graph algorithms, we transparently
 ignore such edges; however, you can easily query for the broken
 vertices of a graph using 'broken' (and should, e.g., to ensure that
 a closure of a graph is wellformed.) It's possible to take a closed
 subset of a broken graph and get a wellformed graph.


module
Distribution.Compat.Graph
(
 * Graph type
Graph
,
IsNode
(
..
),
 * Query
null
,
size
,
lookup
,
 * Construction
empty
,
insert
,
deleteKey
,
deleteLookup
,
 * Combine
unionLeft
,
unionRight
,
 * Graph algorithms
stronglyConnComp
,
SCC
(
..
),
cycles
,
broken
,
closure
,
revClosure
,
topSort
,
revTopSort
,
 * Conversions
 ** Maps
toMap
,
 ** Lists
fromList
,
toList
,
keys
,
 ** Graphs
toGraph
,
 * Node type
Node
(
..
),
nodeValue
,
)
where
import
qualified
Prelude
as
Prelude
import
Prelude
hiding
(
lookup
,
null
)
import
Data.Graph
(
SCC
(
..
))
import
qualified
Data.Graph
as
G
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
qualified
Data.Array
as
Array
import
Data.Array
((
!
))
import
qualified
Data.Tree
as
Tree
import
Data.Either
import
Data.Typeable
import
qualified
Data.Foldable
as
Foldable
import
Control.DeepSeq
import
Distribution.Compat.Binary
(
Binary
(
..
))
  A graph of nodes @a@. The nodes are expected to have instance
 of class 'IsNode'.
data
Graph
a
=
Graph
{
graphMap
::
!
(
Map
(
Key
a
)
a
),
 Lazily cached graph representation
graphForward
::
G
.
Graph
,
graphAdjoint
::
G
.
Graph
,
graphVertexToNode
::
G
.
Vertex
>
a
,
graphKeyToVertex
::
Key
a
>
Maybe
G
.
Vertex
,
graphBroken
::
[(
a
,
[
Key
a
])]
}
deriving
(
Typeable
)
 NB: Not a Functor! (or Traversable), because you need
 to restrict Key a ~ Key b. We provide our own mapping
 functions.
 General strategy is most operations are deferred to the
 Map representation.
instance
Show
a
=>
Show
(
Graph
a
)
where
show
=
show
.
toList
instance
(
IsNode
a
,
Read
a
)
=>
Read
(
Graph
a
)
where
readsPrec
d
s
=
map
(
\
(
a
,
r
)
>
(
fromList
a
,
r
))
(
readsPrec
d
s
)
instance
(
IsNode
a
,
Binary
a
)
=>
Binary
(
Graph
a
)
where
put
x
=
put
(
toList
x
)
get
=
fmap
fromList
get
instance
(
Eq
(
Key
a
),
Eq
a
)
=>
Eq
(
Graph
a
)
where
g1
==
g2
=
graphMap
g1
==
graphMap
g2
instance
Foldable
.
Foldable
Graph
where
fold
=
Foldable
.
fold
.
graphMap
foldr
f
z
=
Foldable
.
foldr
f
z
.
graphMap
foldl
f
z
=
Foldable
.
foldl
f
z
.
graphMap
foldMap
f
=
Foldable
.
foldMap
f
.
graphMap
#
ifdef
MIN_VERSION_base
#
if
MIN_VERSION_base
(
4
,
6
,
0
)
foldl'
f
z
=
Foldable
.
foldl'
f
z
.
graphMap
foldr'
f
z
=
Foldable
.
foldr'
f
z
.
graphMap
#
endif
#
if
MIN_VERSION_base
(
4
,
8
,
0
)
length
=
Foldable
.
length
.
graphMap
null
=
Foldable
.
null
.
graphMap
toList
=
Foldable
.
toList
.
graphMap
elem
x
=
Foldable
.
elem
x
.
graphMap
maximum
=
Foldable
.
maximum
.
graphMap
minimum
=
Foldable
.
minimum
.
graphMap
sum
=
Foldable
.
sum
.
graphMap
product
=
Foldable
.
product
.
graphMap
#
endif
#
endif
instance
(
NFData
a
,
NFData
(
Key
a
))
=>
NFData
(
Graph
a
)
where
rnf
Graph
{
graphMap
=
m
,
graphForward
=
gf
,
graphAdjoint
=
ga
,
graphVertexToNode
=
vtn
,
graphKeyToVertex
=
ktv
,
graphBroken
=
b
}
=
gf
`
seq
`
ga
`
seq
`
vtn
`
seq
`
ktv
`
seq
`
b
`
seq
`
rnf
m
 TODO: Data instance?
  The 'IsNode' class is used for datatypes which represent directed
 graph nodes. A node of type @a@ is associated with some unique key of
 type @'Key' a@; given a node we can determine its key ('nodeKey')
 and the keys of its neighbors ('nodeNeighbors').
class
Ord
(
Key
a
)
=>
IsNode
a
where
type
Key
a
::
*
nodeKey
::
a
>
Key
a
nodeNeighbors
::
a
>
[
Key
a
]
  A simple, trivial data type which admits an 'IsNode' instance.
data
Node
k
a
=
N
a
k
[
k
]
deriving
(
Show
,
Eq
)
  Get the value from a 'Node'.
nodeValue
::
Node
k
a
>
a
nodeValue
(
N
a
_
_
)
=
a
instance
Functor
(
Node
k
)
where
fmap
f
(
N
a
k
ks
)
=
N
(
f
a
)
k
ks
instance
Ord
k
=>
IsNode
(
Node
k
a
)
where
type
Key
(
Node
k
a
)
=
k
nodeKey
(
N
_
k
_
)
=
k
nodeNeighbors
(
N
_
_
ks
)
=
ks
 TODO: Maybe introduce a typeclass for items with just
 keys (so, Key associated type, and nodeKey method). But
 I didn't need it here, so I didn't introduce it.
 Query
  /O(1)/. Is the graph empty?
null
::
Graph
a
>
Bool
null
=
Map
.
null
.
toMap
  /O(1)/. The number of nodes in the graph.
size
::
Graph
a
>
Int
size
=
Map
.
size
.
toMap
  /O(log V)/. Lookup the node at a key in the graph.
lookup
::
IsNode
a
=>
Key
a
>
Graph
a
>
Maybe
a
lookup
k
g
=
Map
.
lookup
k
(
toMap
g
)
 Construction
  /O(1)/. The empty graph.
empty
::
IsNode
a
=>
Graph
a
empty
=
fromMap
Map
.
empty
  /O(log V)/. Insert a node into a graph.
insert
::
IsNode
a
=>
a
>
Graph
a
>
Graph
a
insert
!
n
g
=
fromMap
(
Map
.
insert
(
nodeKey
n
)
n
(
toMap
g
))
  /O(log V)/. Delete the node at a key from the graph.
deleteKey
::
IsNode
a
=>
Key
a
>
Graph
a
>
Graph
a
deleteKey
k
g
=
fromMap
(
Map
.
delete
k
(
toMap
g
))
  /O(log V)/. Lookup and delete. This function returns the deleted
 value if it existed.
deleteLookup
::
IsNode
a
=>
Key
a
>
Graph
a
>
(
Maybe
a
,
Graph
a
)
deleteLookup
k
g
=
let
(
r
,
m'
)
=
Map
.
updateLookupWithKey
(
\
_
_
>
Nothing
)
k
(
toMap
g
)
in
(
r
,
fromMap
m'
)
 Combining
  /O(V + V')/. Rightbiased union, preferring entries
 from the second map when conflicts occur.
 @'nodeKey' x = 'nodeKey' (f x)@.
unionRight
::
IsNode
a
=>
Graph
a
>
Graph
a
>
Graph
a
unionRight
g
g'
=
fromMap
(
Map
.
union
(
toMap
g'
)
(
toMap
g
))
  /O(V + V')/. Leftbiased union, preferring entries from
 the first map when conflicts occur.
unionLeft
::
IsNode
a
=>
Graph
a
>
Graph
a
>
Graph
a
unionLeft
g
g'
=
fromMap
(
Map
.
union
(
toMap
g
)
(
toMap
g'
))
 Graphlike operations
  /Ω(V + E)/. Compute the strongly connected components of a graph.
 Requires amortized construction of graph.
stronglyConnComp
::
Graph
a
>
[
SCC
a
]
stronglyConnComp
g
=
map
decode
forest
where
forest
=
G
.
scc
(
graphForward
g
)
decode
(
Tree
.
Node
v
[]
)

mentions_itself
v
=
CyclicSCC
[
graphVertexToNode
g
v
]

otherwise
=
AcyclicSCC
(
graphVertexToNode
g
v
)
decode
other
=
CyclicSCC
(
dec
other
[]
)
where
dec
(
Tree
.
Node
v
ts
)
vs
=
graphVertexToNode
g
v
:
foldr
dec
vs
ts
mentions_itself
v
=
v
`
elem
`
(
graphForward
g
!
v
)
 Implementation copied from 'stronglyConnCompR' in 'Data.Graph'.
  /Ω(V + E)/. Compute the cycles of a graph.
 Requires amortized construction of graph.
cycles
::
Graph
a
>
[[
a
]]
cycles
g
=
[
vs

CyclicSCC
vs
<
stronglyConnComp
g
]
  /O(1)/. Return a list of nodes paired with their broken
 neighbors (i.e., neighbor keys which are not in the graph).
 Requires amortized construction of graph.
broken
::
Graph
a
>
[(
a
,
[
Key
a
])]
broken
g
=
graphBroken
g
  Compute the subgraph which is the closure of some set of keys.
 Returns @Nothing@ if one (or more) keys are not present in
 the graph.
 Requires amortized construction of graph.
closure
::
Graph
a
>
[
Key
a
]
>
Maybe
[
a
]
closure
g
ks
=
do
vs
<
mapM
(
graphKeyToVertex
g
)
ks
return
(
decodeVertexForest
g
(
G
.
dfs
(
graphForward
g
)
vs
))
  Compute the reverse closure of a graph from some set
 of keys. Returns @Nothing@ if one (or more) keys are not present in
 the graph.
 Requires amortized construction of graph.
revClosure
::
Graph
a
>
[
Key
a
]
>
Maybe
[
a
]
revClosure
g
ks
=
do
vs
<
mapM
(
graphKeyToVertex
g
)
ks
return
(
decodeVertexForest
g
(
G
.
dfs
(
graphAdjoint
g
)
vs
))
flattenForest
::
Tree
.
Forest
a
>
[
a
]
flattenForest
=
concatMap
Tree
.
flatten
decodeVertexForest
::
Graph
a
>
Tree
.
Forest
G
.
Vertex
>
[
a
]
decodeVertexForest
g
=
map
(
graphVertexToNode
g
)
.
flattenForest
  Topologically sort the nodes of a graph.
 Requires amortized construction of graph.
topSort
::
Graph
a
>
[
a
]
topSort
g
=
map
(
graphVertexToNode
g
)
$
G
.
topSort
(
graphForward
g
)
  Reverse topologically sort the nodes of a graph.
 Requires amortized construction of graph.
revTopSort
::
Graph
a
>
[
a
]
revTopSort
g
=
map
(
graphVertexToNode
g
)
$
G
.
topSort
(
graphAdjoint
g
)
 Conversions
  /O(1)/. Convert a map from keys to nodes into a graph.
 The map must satisfy the invariant that
 @'fromMap' m == 'fromList' ('Data.Map.elems' m)@;
 if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
 instead. The values of the map are assumed to already
 be in WHNF.
fromMap
::
IsNode
a
=>
Map
(
Key
a
)
a
>
Graph
a
fromMap
m
=
Graph
{
graphMap
=
m
 These are lazily computed!
,
graphForward
=
g
,
graphAdjoint
=
G
.
transposeG
g
,
graphVertexToNode
=
vertex_to_node
,
graphKeyToVertex
=
key_to_vertex
,
graphBroken
=
broke
}
where
try_key_to_vertex
k
=
maybe
(
Left
k
)
Right
(
key_to_vertex
k
)
(
brokenEdges
,
edges
)
=
unzip
$
[
partitionEithers
(
map
try_key_to_vertex
(
nodeNeighbors
n
))

n
<
ns
]
broke
=
filter
(
not
.
Prelude
.
null
.
snd
)
(
zip
ns
brokenEdges
)
g
=
Array
.
listArray
bounds
edges
ns
=
Map
.
elems
m
 sorted ascending
vertices
=
zip
(
map
nodeKey
ns
)
[
0
..
]
vertex_map
=
Map
.
fromAscList
vertices
key_to_vertex
k
=
Map
.
lookup
k
vertex_map
vertex_to_node
vertex
=
nodeTable
!
vertex
nodeTable
=
Array
.
listArray
bounds
ns
bounds
=
(
0
,
Map
.
size
m

1
)
  /O(V log V)/. Convert a list of nodes into a graph.
fromList
::
IsNode
a
=>
[
a
]
>
Graph
a
fromList
ns
=
fromMap
.
Map
.
fromList
.
map
(
\
n
>
n
`
seq
`
(
nodeKey
n
,
n
))
$
ns
 Maplike operations
  /O(V)/. Convert a graph into a list of nodes.
toList
::
Graph
a
>
[
a
]
toList
g
=
Map
.
elems
(
toMap
g
)
  /O(V)/. Convert a graph into a list of keys.
keys
::
Graph
a
>
[
Key
a
]
keys
g
=
Map
.
keys
(
toMap
g
)
  /O(1)/. Convert a graph into a map from keys to nodes.
 The resulting map @m@ is guaranteed to have the property that
 @'Prelude.all' (\(k,n) > k == 'nodeKey' n) ('Data.Map.toList' m)@.
toMap
::
Graph
a
>
Map
(
Key
a
)
a
toMap
=
graphMap
 Graphlike operations
  /O(1)/. Convert a graph into a 'Data.Graph.Graph'.
 Requires amortized construction of graph.
toGraph
::
Graph
a
>
(
G
.
Graph
,
G
.
Vertex
>
a
,
Key
a
>
Maybe
G
.
Vertex
)
toGraph
g
=
(
graphForward
g
,
graphVertexToNode
g
,
graphKeyToVertex
g
)
Cabal/tests/UnitTests.hs
View file @
74917562
...
...
@@ 16,6 +16,7 @@ import Distribution.Compat.Time
import
qualified
UnitTests.Distribution.Compat.CreatePipe
import
qualified
UnitTests.Distribution.Compat.ReadP
import
qualified
UnitTests.Distribution.Compat.Time
import
qualified
UnitTests.Distribution.Compat.Graph
import
qualified
UnitTests.Distribution.Simple.Program.Internal
import
qualified
UnitTests.Distribution.Simple.Utils
import
qualified
UnitTests.Distribution.System
...
...
@@ 36,6 +37,8 @@ tests mtimeChangeCalibrated =
UnitTests
.
Distribution
.
Compat
.
ReadP
.
tests
,
testGroup
"Distribution.Compat.Time"
(
UnitTests
.
Distribution
.
Compat
.
Time
.
tests
mtimeChange
)
,
testGroup
"Distribution.Compat.Graph"
UnitTests
.
Distribution
.
Compat
.
Graph
.
tests
,
testGroup
"Distribution.Simple.Program.Internal"
UnitTests
.
Distribution
.
Simple
.
Program
.
Internal
.
tests
,
testGroup
"Distribution.Simple.Utils"
...
...
Cabal/tests/UnitTests/Distribution/Compat/Graph.hs
0 → 100644
View file @
74917562
{# LANGUAGE PatternGuards #}
{# LANGUAGE FlexibleInstances #}
{# OPTIONS_GHC fnowarnorphans #}
module
UnitTests.Distribution.Compat.Graph
(
tests
,
arbitraryGraph
)
where
import
Distribution.Compat.Graph
import
qualified
Prelude
import
Prelude
hiding
(
null
)
import
Test.Tasty
import
Test.Tasty.QuickCheck
import
qualified
Data.Set
as
Set
import
Control.Monad
import
qualified
Data.Graph
as
G
import
Data.Array
((
!
))
import
Data.Maybe
import
Data.List
(
sort
)
tests
::
[
TestTree
]
tests
=
[
testProperty
"arbitrary unbroken"
(
prop_arbitrary_unbroken
::
Graph
(
Node
Int
()
)
>
Bool
)
,
testProperty
"nodes consistent"
(
prop_nodes_consistent
::
Graph
(
Node
Int
()
)
>
Bool
)
,
testProperty
"edges consistent"
(
prop_edges_consistent
::
Graph
(
Node
Int
()
)
>
Property
)
,
testProperty
"closure consistent"
(
prop_closure_consistent
::
Graph
(
Node
Int
()
)
>
Property
)
]
 Our arbitrary instance does not generate broken graphs
prop_arbitrary_unbroken
::
Graph
a
>
Bool
prop_arbitrary_unbroken
g
=
Prelude
.
null
(
broken
g
)
 Every node from 'toList' maps to a vertex which
 is present in the constructed graph, and maps back
 to a node correctly.
prop_nodes_consistent
::
(
Eq
a
,
IsNode
a
)
=>
Graph
a
>
Bool
prop_nodes_consistent
g
=
all
p
(
toList
g
)
where
(
_
,
vtn
,
ktv
)
=
toGraph
g
p
n
=
case
ktv
(
nodeKey
n
)
of
Just
v
>
vtn
v
==
n
Nothing
>
False
 A nonbroken graph has the 'nodeNeighbors' of each node
 equal the recorded adjacent edges in the node graph.
prop_edges_consistent
::
IsNode
a
=>
Graph
a
>
Property
prop_edges_consistent
g
=
Prelude
.
null
(
broken
g
)
==>
all
p
(
toList
g
)
where
(
gr
,
vtn
,
ktv
)
=
toGraph
g
p
n
=
sort
(
nodeNeighbors
n
)
==
sort
(
map
(
nodeKey
.
vtn
)
(
gr
!
fromJust
(
ktv
(
nodeKey
n
))))
 Closure is consistent with reachable
prop_closure_consistent
::
(
Show
a
,
IsNode
a
)
=>
Graph
a
>
Property
prop_closure_consistent
g
=
not
(
null
g
)
==>
forAll
(
elements
(
toList
g
))
$
\
n
>
Set
.
fromList
(
map
nodeKey
(
fromJust
(
closure
g
[
nodeKey
n
])))
==
Set
.
fromList
(
map
(
nodeKey
.
vtn
)
(
G
.
reachable
gr
(
fromJust
(
ktv
(
nodeKey
n
)))))
where
(
gr
,
vtn
,
ktv
)
=
toGraph
g
hasNoDups
::
Ord
a
=>
[
a
]
>
Bool
hasNoDups
=
loop
Set
.
empty
where
loop
_
[]
=
True
loop
s
(
x
:
xs
)

s'
<
Set
.
insert
x
s
,
Set
.
size
s'
>
Set
.
size
s
=
loop
s'
xs

otherwise
=
False
arbitraryGraph
::
(
Ord
k
,
Arbitrary
k
,
Arbitrary
a
)
=>
Int
>
Gen
(
Graph
(
Node
k
a
))
arbitraryGraph
len
=
do
 Careful! Assume k is much larger than size.
ks
<
vectorOf
len
arbitrary
`
suchThat
`
hasNoDups
ns
<
forM
ks
$
\
k
>
do
a
<
arbitrary
neighbors
<
listOf
(
elements
ks
)
 Allow duplicates!
return
(
N
a
k
neighbors
)
return
(
fromList
ns
)
instance
(
Ord
k
,
Arbitrary
k
,
Arbitrary
a
)
=>
Arbitrary
(
Graph
(
Node
k
a
))
where
arbitrary
=
sized
$
\
n
>
do
len
<
choose
(
0
,
n
)
arbitraryGraph
len
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment