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

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 = undirG \$ buildG (0,1) [(0,1)]

vertexG :: Graph
vertexG = buildG (0, 0) []

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

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

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

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

powerG :: Int -> Graph -> Graph
powerG n gr = foldr productG vertexG (take n \$ repeat gr)

kG :: Int -> Int -> Graph
kG n m = undirG \$ buildG (1, n+m) [(x,y) | x <- [1..n], y <- [n+1..n+m]]

linearG :: Int -> Graph
linearG n = buildG (1,n)         [(i, i+1) | i <- [1..n-1] ]

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

cycleG :: Int -> Graph
cycleG n = buildG (1,n) ((n,1) : [(i, i+1) | i <- [1..n-1] ])

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

cliqueG :: (Vertex, Vertex) -> Graph
cliqueG (l,h)
| l == h = buildG (l,h) []
| l <  h = unionG (starG (l,h)) (cliqueG (l+1, h))
| otherwise = error "cliqueG not defined on input."

unionG :: Graph -> Graph -> Graph
unionG g1 g2 = buildG (low, high) (edges g1 ++ edges g2)
where low = min low1 low2
high = max high1 high2
(low1, high1) = bounds g1
(low2, high2) = bounds g2

tensorG :: [Int] -> Graph
tensorG = foldr productG vertexG . map linearG

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

type PVertex = (Vertex, Vertex)

isNeighbour :: Graph -> Vertex -> Vertex -> Bool
isNeighbour gr n1 n2 = n2 `elem` gr!n1

gen1 :: Graph -> Graph -> (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
gen1 g1 g2 (x1, x2) (y1, y2) =
isNeighbour g1 x1 y1 && x2 == y2 ||
isNeighbour g2 x2 y2 && x1 == 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 f g1 g2 =
buildG bnds [ (renumber v1, renumber v2) | v1 <- vx, v2 <- vx, f g1 g2 v1 v2]
where vx = [ (x, y) | x <- vertices1, y <- vertices2 ]
vertices1 = vertices g1
vertices2 = vertices g2
(low1, high1) = bounds g1
(low2, high2) = bounds g2
renumber (v1, v2) = (v1-low1) + (high1-low1+1) * (v2-low2)
bnds = (renumber (low1, low2), renumber (high1, high2))

productG :: Graph -> Graph -> Graph
productG = productGen gen1

```