module HGraph.Undirected.Expanders
       ( edgeExpansion
       , vertexExpansion
       )
where

import HGraph.Undirected
import qualified Data.Map as M

edgeExpansion :: (UndirectedGraph g, Adjacency g) => g a -> (Double, [a])
-- | Edge expansion of a graph, together with a set of verticies certifying that the expansion is not greater.
edgeExpansion :: g a -> (Double, [a])
edgeExpansion g a
g = (Double
expansion, [a]
cert)
  where
    (Double
expansion, [Int]
cert') = Integer -> [Int] -> [Int] -> (Double, [Int])
edgeExpansion' (g Int -> Integer
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices g Int
gi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2) (g Int -> [Int]
forall (t :: * -> *) a. UndirectedGraph t => t a -> [a]
vertices g Int
gi) []
    cert :: [a]
cert = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int a
idT Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
M.!) [Int]
cert'
    (g Int
gi, [(Int, a)]
itol) = g a -> (g Int, [(Int, a)])
forall (t :: * -> *) a.
UndirectedGraph t =>
t a -> (t Int, [(Int, a)])
linearizeVertices g a
g
    idT :: Map Int a
idT = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int, a)]
itol
    edgeExpansion' :: Integer -> [Int] -> [Int] -> (Double, [Int])
edgeExpansion' Integer
budget [] [] = (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ g Int -> Integer
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices g Int
gi, [])
    edgeExpansion' Integer
budget [] [Int]
as = (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
as), [Int]
as)
      where
        e :: Integer
e = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [g Int -> Int -> Integer
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
degree g Int
gi Int
v | Int
v <- [Int]
as]
    edgeExpansion' Integer
0 [Int]
_ [Int]
as = Integer -> [Int] -> [Int] -> (Double, [Int])
edgeExpansion' Integer
0 [] [Int]
as
    edgeExpansion' Integer
budget (Int
v:[Int]
vs) [Int]
as = (Double
e, [Int]
c)
      where
        (Double
e0,[Int]
c0) = Integer -> [Int] -> [Int] -> (Double, [Int])
edgeExpansion' (Integer
budget Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) [Int]
vs (Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
as)
        (Double
e1,[Int]
c1) = Integer -> [Int] -> [Int] -> (Double, [Int])
edgeExpansion' Integer
budget [Int]
vs [Int]
as
        (Double
e,[Int]
c) = if Double
e0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
e1 then (Double
e0,[Int]
c0) else (Double
e1,[Int]
c1)

vertexExpansion :: (Adjacency g) => g a -> (Double, [a])
-- | Vertex expansion of a graph, together with a set of verticies certifying that the expansion is not greater.
vertexExpansion :: g a -> (Double, [a])
vertexExpansion g a
g = (Double
0,[])