{-| Module      :  Data.Graph.Construction
    Copyright   :  (c) Jean-Philippe Bernardy 2003
    License     :  GPL

    Maintainer  :  JeanPhilippe.Bernardy@gmail.com
    Stability   :  proposal
    Portability :  GHC


Various functions to build graphs.

-}


module Data.Graph.Construction (hCubeG, cycleG, prismG, productG, linearG, arcG,
                                starG, unionG, undirG, tensorG, kG, cliqueG,
                                emptyG
                               ) where

import Data.Graph
import Data.Array (bounds, (!))


arcG :: Graph
arcG :: Graph
arcG = Graph -> Graph
undirG (Graph -> Graph) -> Graph -> Graph
forall a b. (a -> b) -> a -> b
$ Bounds -> [Bounds] -> Graph
buildG (Vertex
0,Vertex
1) [(Vertex
0,Vertex
1)]

vertexG :: Graph
vertexG :: Graph
vertexG = Bounds -> [Bounds] -> Graph
buildG (Vertex
0, Vertex
0) []

-- triG :: Graph
-- triG = cycleG 3

-- cubeG :: Graph
-- cubeG = hCubeG 3

prismG :: Int -> Graph
prismG :: Vertex -> Graph
prismG Vertex
n = Graph -> Graph -> Graph
productG Graph
arcG (Vertex -> Graph
cycleG Vertex
n)

hCubeG :: Int -> Graph
hCubeG :: Vertex -> Graph
hCubeG Vertex
n = Vertex -> Graph -> Graph
powerG Vertex
n Graph
arcG

powerG :: Int -> Graph -> Graph
powerG :: Vertex -> Graph -> Graph
powerG Vertex
n Graph
gr = (Graph -> Graph -> Graph) -> Graph -> [Graph] -> Graph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Graph -> Graph -> Graph
productG Graph
vertexG (Vertex -> Graph -> [Graph]
forall a. Vertex -> a -> [a]
replicate Vertex
n Graph
gr)

kG :: Int -> Int -> Graph
kG :: Vertex -> Vertex -> Graph
kG Vertex
n Vertex
m = Graph -> Graph
undirG (Graph -> Graph) -> Graph -> Graph
forall a b. (a -> b) -> a -> b
$ Bounds -> [Bounds] -> Graph
buildG (Vertex
1, Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
m) [(Vertex
x,Vertex
y) | Vertex
x <- [Vertex
1..Vertex
n], Vertex
y <- [Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1..Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
m]]

linearG :: Int -> Graph
linearG :: Vertex -> Graph
linearG Vertex
n = Bounds -> [Bounds] -> Graph
buildG (Vertex
1,Vertex
n)         [(Vertex
i, Vertex
iVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) | Vertex
i <- [Vertex
1..Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
1] ]

emptyG :: Int -> Graph
emptyG :: Vertex -> Graph
emptyG Vertex
n = Bounds -> [Bounds] -> Graph
buildG (Vertex
1,Vertex
n) []

cycleG :: Int -> Graph
cycleG :: Vertex -> Graph
cycleG Vertex
n = Bounds -> [Bounds] -> Graph
buildG (Vertex
1,Vertex
n) ((Vertex
n,Vertex
1) Bounds -> [Bounds] -> [Bounds]
forall a. a -> [a] -> [a]
: [(Vertex
i, Vertex
iVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) | Vertex
i <- [Vertex
1..Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
1] ])

starG :: (Vertex, Vertex) -> Graph
starG :: Bounds -> Graph
starG (Vertex
l,Vertex
h) = Bounds -> [Bounds] -> Graph
buildG (Vertex
l,Vertex
h) [(Vertex
l,Vertex
i) | Vertex
i <- [Vertex
lVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1..Vertex
h]]

cliqueG :: (Vertex, Vertex) -> Graph
cliqueG :: Bounds -> Graph
cliqueG (Vertex
l,Vertex
h)
    | Vertex
l Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
h = Bounds -> [Bounds] -> Graph
buildG (Vertex
l,Vertex
h) []
    | Vertex
l Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<  Vertex
h = Graph -> Graph -> Graph
unionG (Bounds -> Graph
starG (Vertex
l,Vertex
h)) (Bounds -> Graph
cliqueG (Vertex
lVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1, Vertex
h))
    | Bool
otherwise = [Char] -> Graph
forall a. HasCallStack => [Char] -> a
error [Char]
"cliqueG not defined on input."

unionG :: Graph -> Graph -> Graph
unionG :: Graph -> Graph -> Graph
unionG Graph
g1 Graph
g2 = Bounds -> [Bounds] -> Graph
buildG (Vertex
low, Vertex
high) (Graph -> [Bounds]
edges Graph
g1 [Bounds] -> [Bounds] -> [Bounds]
forall a. [a] -> [a] -> [a]
++ Graph -> [Bounds]
edges Graph
g2)
               where low :: Vertex
low = Vertex -> Vertex -> Vertex
forall a. Ord a => a -> a -> a
min Vertex
low1 Vertex
low2
                     high :: Vertex
high = Vertex -> Vertex -> Vertex
forall a. Ord a => a -> a -> a
max Vertex
high1 Vertex
high2
                     (Vertex
low1, Vertex
high1) = Graph -> Bounds
forall i e. Array i e -> (i, i)
bounds Graph
g1
                     (Vertex
low2, Vertex
high2) = Graph -> Bounds
forall i e. Array i e -> (i, i)
bounds Graph
g2

tensorG :: [Int] -> Graph
tensorG :: [Vertex] -> Graph
tensorG = (Vertex -> Graph -> Graph) -> Graph -> [Vertex] -> Graph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Graph -> Graph -> Graph
productG (Graph -> Graph -> Graph)
-> (Vertex -> Graph) -> Vertex -> Graph -> Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Graph
linearG) Graph
vertexG

undirG :: Graph -> Graph
undirG :: Graph -> Graph
undirG Graph
g = Graph -> Graph -> Graph
unionG Graph
g (Graph -> Graph
transposeG Graph
g)

type PVertex = (Vertex, Vertex)


isNeighbour :: Graph -> Vertex -> Vertex -> Bool
isNeighbour :: Graph -> Vertex -> Vertex -> Bool
isNeighbour Graph
gr Vertex
n1 Vertex
n2 = Vertex
n2 Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Graph
grGraph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
!Vertex
n1

gen1 :: Graph -> Graph -> (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
gen1 :: Graph -> Graph -> Bounds -> Bounds -> Bool
gen1 Graph
g1 Graph
g2 (Vertex
x1, Vertex
x2) (Vertex
y1, Vertex
y2) =
        Graph -> Vertex -> Vertex -> Bool
isNeighbour Graph
g1 Vertex
x1 Vertex
y1 Bool -> Bool -> Bool
&& Vertex
x2 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
y2 Bool -> Bool -> Bool
||
        Graph -> Vertex -> Vertex -> Bool
isNeighbour Graph
g2 Vertex
x2 Vertex
y2 Bool -> Bool -> Bool
&& Vertex
x1 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
y1

-- gen2 g1 g2 (x1, x2) (y1, y2) =
--         isNeighbour g1 x1 y1 ||
--         isNeighbour g2 x2 y2

-- gen3 g1 g2 (x1, x2) (y1, y2) =
--      isNeighbour g1 x1 y1 &&
--      isNeighbour g2 x2 y2

productGen :: (Graph -> Graph -> PVertex -> PVertex -> Bool) -> Graph -> Graph -> Graph
productGen :: (Graph -> Graph -> Bounds -> Bounds -> Bool)
-> Graph -> Graph -> Graph
productGen Graph -> Graph -> Bounds -> Bounds -> Bool
f Graph
g1 Graph
g2 =
        Bounds -> [Bounds] -> Graph
buildG Bounds
bnds [ (Bounds -> Vertex
renumber Bounds
v1, Bounds -> Vertex
renumber Bounds
v2) | Bounds
v1 <- [Bounds]
vx, Bounds
v2 <- [Bounds]
vx, Graph -> Graph -> Bounds -> Bounds -> Bool
f Graph
g1 Graph
g2 Bounds
v1 Bounds
v2]
  where vx :: [Bounds]
vx = [ (Vertex
x, Vertex
y) | Vertex
x <- [Vertex]
vertices1, Vertex
y <- [Vertex]
vertices2 ]
        vertices1 :: [Vertex]
vertices1 = Graph -> [Vertex]
vertices Graph
g1
        vertices2 :: [Vertex]
vertices2 = Graph -> [Vertex]
vertices Graph
g2
        (Vertex
low1, Vertex
high1) = Graph -> Bounds
forall i e. Array i e -> (i, i)
bounds Graph
g1
        (Vertex
low2, Vertex
high2) = Graph -> Bounds
forall i e. Array i e -> (i, i)
bounds Graph
g2
        renumber :: Bounds -> Vertex
renumber (Vertex
v1, Vertex
v2) = (Vertex
v1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
low1) Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+ (Vertex
high1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
low1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
* (Vertex
v2Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
low2)
        bnds :: Bounds
bnds = (Bounds -> Vertex
renumber (Vertex
low1, Vertex
low2), Bounds -> Vertex
renumber (Vertex
high1, Vertex
high2))

productG :: Graph -> Graph -> Graph
productG :: Graph -> Graph -> Graph
productG = (Graph -> Graph -> Bounds -> Bounds -> Bool)
-> Graph -> Graph -> Graph
productGen Graph -> Graph -> Bounds -> Bounds -> Bool
gen1