AdjacencyList.hs

{-|
Module      : Data.Graph.AdjacencyList
Description : Core graph types and constructors
Copyright   : Thodoris Papakonstantinou, 2017-2026
License     : LGPL-3
Maintainer  : dev@tpapak.com
Stability   : experimental
Portability : POSIX

Core types and constructors for directed graphs using adjacency list
representation.

A 'Graph' stores its vertex set, an 'EdgeMap' for edge-attribute lookup,
and a closure-based 'Neighbors' function for O(log V) neighbor access.
Undirected graphs are represented by including both directions of each edge.
 -}

{-# LANGUAGE DeriveGeneric #-}  

module Data.Graph.AdjacencyList
    ( Vertex (..)
    , Edge (..)
    , Neighbors (..)
    , EdgeMap (..)
    -- * Graph definition
    , Graph (..)
    , fromTuple
    , toTuple
    -- * createGraph: Graph constructor
    , createGraph
    -- * graph from list of Edges
    , graphFromEdges
    , edges
    , reverseEdge
    , reverseEdges
    , reverseGraph
    -- * filterVertices
    , filterVertices
    -- * filterEdges
    , filterEdges
    -- * makeUndirected
    , makeUndirected
    , adjacentEdges
    , edgesFromNeighbors
    , adjacencyMap
    , edgeExists
    , edgeIndex
    , from
    , to
    , numVertices
    , numEdges
    , removeReverseEdges
    , completeGraph
    ) where

import Data.List
import Data.List.Unique
import Data.Maybe
import qualified Data.Map.Lazy as M
import qualified Data.IntMap.Lazy as IM
import qualified Data.Set as Set
import qualified GHC.Generics as Gen
import qualified Data.Binary as Bin

-- | A vertex identifier (non-negative integer).
type Vertex = Int

-- | A directed edge from one vertex to another.
data Edge = Edge Vertex Vertex 
  deriving (Ord, Gen.Generic)
instance Bin.Binary Edge

instance Show Edge where
 show (Edge s t) = "[" ++ show s ++ "->" ++ show t ++ "]"

instance Eq Edge where
  a == b = from a == from b && to a == to b

-- | Map from edges to their sequential index (1-based).
-- Used for edge-attribute lookup.
type EdgeMap = M.Map Edge Int

-- | Takes vertex and outputs neighboring vertices.
-- The Neighbors type is the function from a vertex to its neighbors
type Neighbors = (Vertex -> [Vertex])

-- | Graph definition of directed Graphs 
-- undirected graphs should include reverse edges.
data Graph = 
  Graph { vertices :: [Vertex] -- ^ The domain of the `neighbors` function. 
        -- It is usefull for finite graphs.
        , edgeMap :: EdgeMap -- ^ The edge map is necessary 
        -- for appointing edge attributes
        , neighbors :: Neighbors -- ^ The `Adjacency List`
        }

-- | Check whether an edge exists in the graph.
edgeExists :: Graph -> Edge -> Bool
edgeExists g e = M.member e (edgeMap g)

-- | Gives the position of the edge to the edges list
edgeIndex :: Graph -> Edge -> Maybe Int
edgeIndex g e = M.lookup e $ edgeMap g

-- | All edges of the graph, in 'EdgeMap' key order.
edges :: Graph -> [Edge]
edges g = 
  fmap fst $ M.toList $ edgeMap g

edgeMapFromEdges :: [Edge] -> EdgeMap
edgeMapFromEdges es =
  M.fromList $ zip es [1..]

-- | Source vertex of an edge.
from :: Edge -> Vertex
from (Edge s t) = s

-- | Target vertex of an edge.
to :: Edge -> Vertex
to (Edge s t) = t

-- | Construct an 'Edge' from a @(source, target)@ tuple.
fromTuple :: (Vertex, Vertex) -> Edge
fromTuple (s,t) = Edge s t

-- | Convert an 'Edge' to a @(source, target)@ tuple.
toTuple :: Edge -> (Vertex, Vertex)
toTuple (Edge s t) = (s,t)

-- | Reverse the direction of an edge.
reverseEdge :: Edge -> Edge
reverseEdge (Edge s t) = Edge t s

-- | All edges of the graph with reversed direction.
reverseEdges :: Graph -> [Edge]
reverseEdges g = fmap reverseEdge $ edges g

-- | Number of vertices in the graph.
numVertices :: Graph -> Int
numVertices g = length $ vertices g

-- | Number of edges in the graph.
numEdges :: Graph -> Int
numEdges g = length $ edges g


instance Eq Graph where
  (==) g1 g2 = (sort (vertices g1) == sort (vertices g2))
               && (sort (edges g1) == sort (edges g2))

instance Show Graph where
  show g = "vertices: " ++ show (vertices g) ++ "\n" ++
            "edges: " ++ show (edges g) ++ "\n"

-- | Graph constructor given a neighbors function
createGraph :: [Vertex] -> Neighbors -> Graph
createGraph vs neis =
  let emap = edgeMapFromEdges $ edgesFromNeighbors neis vs
   in Graph { vertices = vs
            , neighbors = neis
            , edgeMap = emap
            }

-- | Graph constructor given a list of edges.
--
-- Builds the adjacency map in a single O(E) pass using 'IM.fromListWith',
-- then wraps it in a closure for O(log V) neighbor lookup.
graphFromEdges :: [Edge] -> Graph
graphFromEdges es = 
  let vs = Set.toList $ foldl' (\ac (Edge u v) ->
             Set.insert u (Set.insert v ac)) Set.empty es
      esmap = edgeMapFromEdges es
      -- Build adjacency map in one pass: O(E log V) via fromListWith
      neimap = IM.fromListWith (++)
                  $ fmap (\(Edge u v) -> (u, [v])) es
      neis v = case IM.lookup v neimap of
                 Nothing -> []
                 Just ns -> ns
   in Graph { vertices = vs
            , edgeMap = esmap
            , neighbors = neis
            }

-- | Enumerate all edges implied by a 'Neighbors' function over a vertex set.
edgesFromNeighbors :: Neighbors -> [Vertex] -> [Edge]
edgesFromNeighbors neis vs = 
  let allneis = fmap (\v -> (v,neis v)) vs
   in foldr (\(v,nv) ac -> 
             (fmap (\n -> Edge v n) nv) ++ ac
             ) [] allneis

-- | All outgoing edges from a vertex.
adjacentEdges :: Graph -> Vertex -> [Edge]
adjacentEdges g v = fmap (\n -> Edge v n) $ neighbors g v

-- | Build an explicit adjacency map from the graph's 'Neighbors' closure.
adjacencyMap :: Graph -> IM.IntMap [Vertex]
adjacencyMap g = IM.fromList $ fmap (\v -> (v, (neighbors g v))) vs
                 where vs = vertices g

-- | Reverse all edges in the graph.
reverseGraph :: Graph -> Graph
reverseGraph g =
  graphFromEdges $ reverseEdges g

-- | Get the subgraph of a graph by including vertices satisfying given predicate.
filterVertices :: (Vertex -> Bool) -- ^ filter predicate
               -> Graph
               -> Graph
filterVertices f g =
  let oldvs = vertices g
      vs = filter f oldvs 
      neis v = 
        let ns = neighbors g v
         in filter f ns
   in createGraph vs neis

-- | Get the subgraph of a graph by including edges satisfying given predicate.
filterEdges :: (Edge -> Bool) -> Graph -> Graph
filterEdges f g =
  let vs = vertices g
      neis v = 
        let neis = neighbors g v
         in filter (\n -> f (Edge v n)) neis
   in createGraph vs neis

-- | Make a graph undirected by adding all missing reverse edges.
makeUndirected :: Graph -- ^ directed graph
               -> Graph -- ^ undirected graph
makeUndirected g =
  let rg = reverseGraph g
      vs = vertices g
      newnei v = 
        let nei = neighbors g v
            rnei = neighbors rg v
         in sortUniq $ nei ++ rnei
   in createGraph vs newnei

-- | Make a graph directed by removing randomly reverse edges
removeReverseEdges :: Graph -- ^ Graph with reverse edges
                   -> Graph -- ^ Directected graph
removeReverseEdges g =
  let unes = sort $ edges g
      dires = filter (\e -> elem (reverseEdge e) 
                             (filter (\e' -> e' > e) unes) 
                     ) unes
   in graphFromEdges dires


-- | Complete undirected graph from number of vertices
completeGraph :: Int -> Graph
completeGraph n =
  let es = [e | e <- Edge <$> [1..n] <*> [1..n], (\(Edge s t) -> s /= t ) e]
   in graphFromEdges es