{-|
Module      : Nauty.Internal
Description : Internal functions.
Copyright   : (c) Marcelo Garlet Milani, 2025
License     : GPL-3
Maintainer  : mgmilani@pm.me
Stability   : unstable

This module contains internal functions used by the "Nauty" module.
Except for test cases, you should not import this module.
-}

module Nauty.Internal where

import Data.Word
import qualified Data.Set       as Set
import qualified Data.Text.Lazy as T
import qualified Nauty.Digraph6 as D
import           Nauty.Internal.Utils
import           Nauty.Internal.Parsing
import qualified Nauty.Graph6   as G
import qualified Nauty.Sparse6  as S
import qualified Data.Array.Unboxed as A

-- |Whether the graph has undirected or directed edges.
data GraphType = Undirected | Directed deriving (GraphType -> GraphType -> Bool
(GraphType -> GraphType -> Bool)
-> (GraphType -> GraphType -> Bool) -> Eq GraphType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphType -> GraphType -> Bool
== :: GraphType -> GraphType -> Bool
$c/= :: GraphType -> GraphType -> Bool
/= :: GraphType -> GraphType -> Bool
Eq, Int -> GraphType -> ShowS
[GraphType] -> ShowS
GraphType -> String
(Int -> GraphType -> ShowS)
-> (GraphType -> String)
-> ([GraphType] -> ShowS)
-> Show GraphType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphType -> ShowS
showsPrec :: Int -> GraphType -> ShowS
$cshow :: GraphType -> String
show :: GraphType -> String
$cshowList :: [GraphType] -> ShowS
showList :: [GraphType] -> ShowS
Show)

-- |Format in used for encoding and decoding.
data Format = Graph6 | Sparse6 | Digraph6 | Incremental deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show)

-- |A directed or undirected graph.
-- See nauty documentation for an explanation of the format used by the adjacency matrix.
data Graph = Graph
  { Graph -> Word64
numberOfVertices :: Word64
  , Graph -> GraphType
graphType        :: GraphType
  , Graph -> UArray Word64 Word64
adjacencyList    :: A.UArray Word64 Word64 -- ^ List of edges. Computed from adjacency matrix in graph6 and digraph6 formats. Edges have the form (A[2i], A[2i + 1]), for every i from 0 to half the array size.
  , Graph -> UArray Word64 Word8
adjacencyMatrix  :: A.UArray Word64 Word8 -- ^ Adjacency matrix. Computed from edge list in sparse6 formats.
  , Graph -> Format
format           :: Format
  }
  deriving (Graph -> Graph -> Bool
(Graph -> Graph -> Bool) -> (Graph -> Graph -> Bool) -> Eq Graph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Graph -> Graph -> Bool
== :: Graph -> Graph -> Bool
$c/= :: Graph -> Graph -> Bool
/= :: Graph -> Graph -> Bool
Eq, Int -> Graph -> ShowS
[Graph] -> ShowS
Graph -> String
(Int -> Graph -> ShowS)
-> (Graph -> String) -> ([Graph] -> ShowS) -> Show Graph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Graph -> ShowS
showsPrec :: Int -> Graph -> ShowS
$cshow :: Graph -> String
show :: Graph -> String
$cshowList :: [Graph] -> ShowS
showList :: [Graph] -> ShowS
Show)

-- |Parse a list of graphs encoded in graph6, sparse6 or digraph6 format. Each line encodes one graph.
-- Optionally, the first line might be a header of the form @>>graph6\<\<@, @>>sparse6\<\<@ or @>>digraph6\<\<@.
parse :: T.Text -> [Either T.Text Graph]
parse :: Text -> [Either Text Graph]
parse Text
t = 
  let t' :: Text
t' = Text -> Text
ignoreHeader Text
t
  in Maybe Graph -> [Text] -> [Either Text Graph]
parse' Maybe Graph
forall a. Maybe a
Nothing (Text -> [Text]
T.lines Text
t')

-- |Parse a list of graphs in graph6, digraph6, sparse6 or incremental sparse6 format.
parse' :: (Maybe Graph) -- ^ Used in case the first graph of the list uses incremental sparse6 format.
       -> [T.Text]
       -> [Either T.Text Graph]
parse' :: Maybe Graph -> [Text] -> [Either Text Graph]
parse' Maybe Graph
_ [] = []
parse' Maybe Graph
g0 (Text
g:[Text]
gs) = 
  case Text -> Format
getFormat Text
g of
    Format
Incremental -> case Maybe Graph
g0 of
            Maybe Graph
Nothing ->
               (Text -> Either Text Graph
forall a b. a -> Either a b
Left (Text -> Either Text Graph) -> Text -> Either Text Graph
forall a b. (a -> b) -> a -> b
$ Text
"The graph [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] is in incremental sparse6 format but it is not preceded by a graph in graph6 or sparse6 format.")
               Either Text Graph -> [Either Text Graph] -> [Either Text Graph]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Text] -> [Either Text Graph]
parse' Maybe Graph
g0 ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Text
h -> Text -> Format
getFormat Text
h Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Incremental) [Text]
gs)
            Just Graph
g0' ->
               case AdjacencyList -> Text -> Either Text AdjacencyList
S.symmetricDifference 
                      (S.AdjacencyList
                        { numberOfVertices :: Word64
S.numberOfVertices = Graph
g0'.numberOfVertices
                        , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g0'.adjacencyList
                        }) Text
g of
              Left Text
err -> [Text -> Either Text Graph
forall a b. a -> Either a b
Left Text
err]
              Right AdjacencyList
g' ->
                let g6 :: AdjacencyMatrix
g6 = ((Word64 -> [(Word64, Word64)] -> AdjacencyMatrix)
-> (Word64, [(Word64, Word64)]) -> AdjacencyMatrix
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> [(Word64, Word64)] -> AdjacencyMatrix
G.fromEdgeList) ((Word64, [(Word64, Word64)]) -> AdjacencyMatrix)
-> (Word64, [(Word64, Word64)]) -> AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> (Word64, [(Word64, Word64)])
S.toEdgeList AdjacencyList
g'
                    g1 :: Graph
g1 = Graph
                           { numberOfVertices :: Word64
numberOfVertices = AdjacencyList -> Word64
S.numberOfVertices AdjacencyList
g'
                           , adjacencyList :: UArray Word64 Word64
adjacencyList = AdjacencyList -> UArray Word64 Word64
S.adjacency AdjacencyList
g'
                           , graphType :: GraphType
graphType = GraphType
Undirected
                           , format :: Format
format = Format
Incremental
                           , adjacencyMatrix :: UArray Word64 Word8
adjacencyMatrix = AdjacencyMatrix -> UArray Word64 Word8
G.adjacency AdjacencyMatrix
g6
                           }
                in Graph -> Either Text Graph
forall a b. b -> Either a b
Right Graph
g1 Either Text Graph -> [Either Text Graph] -> [Either Text Graph]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Text] -> [Either Text Graph]
parse' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g1) [Text]
gs
             
    Format
Sparse6 ->
      case Text -> Either Text AdjacencyList
S.graph Text
g of
        Left Text
err -> [Text -> Either Text Graph
forall a b. a -> Either a b
Left Text
err]
        Right AdjacencyList
g' ->
          let g6 :: AdjacencyMatrix
g6 = ((Word64 -> [(Word64, Word64)] -> AdjacencyMatrix)
-> (Word64, [(Word64, Word64)]) -> AdjacencyMatrix
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> [(Word64, Word64)] -> AdjacencyMatrix
G.fromEdgeList) ((Word64, [(Word64, Word64)]) -> AdjacencyMatrix)
-> (Word64, [(Word64, Word64)]) -> AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> (Word64, [(Word64, Word64)])
S.toEdgeList AdjacencyList
g'
              g1 :: Graph
g1 = Graph
                     { numberOfVertices :: Word64
numberOfVertices = AdjacencyList -> Word64
S.numberOfVertices AdjacencyList
g'
                     , adjacencyList :: UArray Word64 Word64
adjacencyList = AdjacencyList -> UArray Word64 Word64
S.adjacency AdjacencyList
g'
                     , graphType :: GraphType
graphType = GraphType
Undirected
                     , format :: Format
format = Format
Sparse6
                     , adjacencyMatrix :: UArray Word64 Word8
adjacencyMatrix = AdjacencyMatrix -> UArray Word64 Word8
G.adjacency AdjacencyMatrix
g6
                     }
          in Graph -> Either Text Graph
forall a b. b -> Either a b
Right Graph
g1 Either Text Graph -> [Either Text Graph] -> [Either Text Graph]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Text] -> [Either Text Graph]
parse' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g1) [Text]
gs
    Format
Digraph6 ->
      case Text -> Either Text AdjacencyMatrix
D.digraph Text
g of
        Left Text
err -> [Text -> Either Text Graph
forall a b. a -> Either a b
Left Text
err]
        Right AdjacencyMatrix
g' ->
           let g1 :: Graph
g1 = Graph
                      { numberOfVertices :: Word64
numberOfVertices = AdjacencyMatrix -> Word64
D.numberOfVertices AdjacencyMatrix
g'
                      , adjacencyList :: UArray Word64 Word64
adjacencyList = 
                          let es :: [(Word64, Word64)]
es = (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a, b) -> b
snd (AdjacencyMatrix -> (Word64, [(Word64, Word64)])
D.toArcList AdjacencyMatrix
g')
                              m :: Word64
m = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [(Word64, Word64)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word64, Word64)]
es
                          in (Word64, Word64) -> [(Word64, Word64)] -> UArray Word64 Word64
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Word64
0, Word64
2Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
*Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) ([(Word64, Word64)] -> UArray Word64 Word64)
-> [(Word64, Word64)] -> UArray Word64 Word64
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64] -> [(Word64, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0..] ([Word64] -> [(Word64, Word64)]) -> [Word64] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ [(Word64, Word64)] -> [Word64]
forall a. [(a, a)] -> [a]
ungroupByTwo [(Word64, Word64)]
es
                      , graphType :: GraphType
graphType = GraphType
Directed
                      , format :: Format
format = Format
Digraph6
                      , adjacencyMatrix :: UArray Word64 Word8
adjacencyMatrix = AdjacencyMatrix -> UArray Word64 Word8
D.adjacency AdjacencyMatrix
g'
                      }
           in Graph -> Either Text Graph
forall a b. b -> Either a b
Right Graph
g1 Either Text Graph -> [Either Text Graph] -> [Either Text Graph]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Text] -> [Either Text Graph]
parse' Maybe Graph
forall a. Maybe a
Nothing [Text]
gs
    Format
Graph6 ->
      case Text -> Either Text AdjacencyMatrix
G.graph Text
g of
        Left Text
err -> [Text -> Either Text Graph
forall a b. a -> Either a b
Left Text
err]
        Right AdjacencyMatrix
g' ->
           let g1 :: Graph
g1 = Graph
                      { numberOfVertices :: Word64
numberOfVertices = AdjacencyMatrix -> Word64
G.numberOfVertices AdjacencyMatrix
g'
                      , adjacencyList :: UArray Word64 Word64
adjacencyList = 
                          let es :: [(Word64, Word64)]
es = (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a, b) -> b
snd (AdjacencyMatrix -> (Word64, [(Word64, Word64)])
G.toEdgeList AdjacencyMatrix
g')
                              m :: Word64
m = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [(Word64, Word64)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word64, Word64)]
es
                          in (Word64, Word64) -> [(Word64, Word64)] -> UArray Word64 Word64
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Word64
0, Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) ([(Word64, Word64)] -> UArray Word64 Word64)
-> [(Word64, Word64)] -> UArray Word64 Word64
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64] -> [(Word64, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0..] ([Word64] -> [(Word64, Word64)]) -> [Word64] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ [(Word64, Word64)] -> [Word64]
forall a. [(a, a)] -> [a]
ungroupByTwo [(Word64, Word64)]
es
                      , graphType :: GraphType
graphType = GraphType
Undirected
                      , format :: Format
format = Format
Graph6
                      , adjacencyMatrix :: UArray Word64 Word8
adjacencyMatrix = AdjacencyMatrix -> UArray Word64 Word8
G.adjacency AdjacencyMatrix
g'
                      }
           in Graph -> Either Text Graph
forall a b. b -> Either a b
Right Graph
g1 Either Text Graph -> [Either Text Graph] -> [Either Text Graph]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Text] -> [Either Text Graph]
parse' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g1) [Text]
gs
 
-- |Format used for encoding the graph.
getFormat :: T.Text -> Format
getFormat :: Text -> Format
getFormat Text
str 
  | Text
":" Text -> Text -> Bool
`T.isPrefixOf` Text
str = Format
Sparse6
  | Text
";" Text -> Text -> Bool
`T.isPrefixOf` Text
str = Format
Incremental
  | Text
"&" Text -> Text -> Bool
`T.isPrefixOf` Text
str = Format
Digraph6
  | Bool
otherwise = Format
Graph6

-- | Encode a sequence of graphs using the given formats.
-- Graphs may be encoded with the incremental format, but only if the previous graph is encoded with sparse6.
encodeMany :: [Graph] -> T.Text
encodeMany :: [Graph] -> Text
encodeMany [Graph]
gs = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Graph -> [Graph] -> [Text]
encodeMany' Maybe Graph
forall a. Maybe a
Nothing [Graph]
gs

-- | Encode a sequence of graphs using the given formats.
-- Graphs may be encoded with the incremental format, but only if the previous graph is encoded with sparse6.
encodeMany' :: Maybe Graph -- ^ Used as a predecessor in case the first graph of the list is to be encoded in incremental sparse6 format.
            -> [Graph]
            -> [T.Text]
encodeMany' :: Maybe Graph -> [Graph] -> [Text]
encodeMany' Maybe Graph
_ [] = []
encodeMany' Maybe Graph
mg0 (Graph
g:[Graph]
gs) = 
  case Graph
g.format of
    Format
Graph6 ->
      AdjacencyMatrix -> Text
G.encode
        G.AdjacencyMatrix
          { numberOfVertices :: Word64
G.numberOfVertices = Graph
g.numberOfVertices
          , adjacency :: UArray Word64 Word8
G.adjacency  = Graph
g.adjacencyMatrix
          }
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Graph] -> [Text]
encodeMany' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g) [Graph]
gs
    Format
Sparse6 ->
      AdjacencyList -> Text
S.encode
        S.AdjacencyList
          { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
          , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
          }
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Graph] -> [Text]
encodeMany' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g) [Graph]
gs
    Format
Digraph6 ->
      AdjacencyMatrix -> Text
D.encode
        D.AdjacencyMatrix
          { numberOfVertices :: Word64
D.numberOfVertices = Graph
g.numberOfVertices
          , adjacency :: UArray Word64 Word8
D.adjacency = Graph
g.adjacencyMatrix
          }
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Graph] -> [Text]
encodeMany' Maybe Graph
forall a. Maybe a
Nothing [Graph]
gs
    Format
Incremental -> 
      case Maybe Graph
mg0 of
        Maybe Graph
Nothing ->
         AdjacencyList -> Text
S.encode
           S.AdjacencyList
             { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
             , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
             }
        Just Graph
g0 ->
          if Graph
g0.graphType GraphType -> GraphType -> Bool
forall a. Eq a => a -> a -> Bool
== GraphType
Undirected then
            let es0 :: Set (Word64, Word64)
es0     = [(Word64, Word64)] -> Set (Word64, Word64)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Word64, Word64)] -> Set (Word64, Word64))
-> [(Word64, Word64)] -> Set (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ [Word64] -> [(Word64, Word64)]
forall a. [a] -> [(a, a)]
groupByTwo ([Word64] -> [(Word64, Word64)]) -> [Word64] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ UArray Word64 Word64 -> [Word64]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Graph
g0.adjacencyList
                es1 :: Set (Word64, Word64)
es1     = [(Word64, Word64)] -> Set (Word64, Word64)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Word64, Word64)] -> Set (Word64, Word64))
-> [(Word64, Word64)] -> Set (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ [Word64] -> [(Word64, Word64)]
forall a. [a] -> [(a, a)]
groupByTwo ([Word64] -> [(Word64, Word64)]) -> [Word64] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ UArray Word64 Word64 -> [Word64]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Graph
g.adjacencyList
                symdiff :: [(Word64, Word64)]
symdiff = Set (Word64, Word64) -> [(Word64, Word64)]
forall a. Set a -> [a]
Set.toList (Set (Word64, Word64) -> [(Word64, Word64)])
-> Set (Word64, Word64) -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Set (Word64, Word64)
-> Set (Word64, Word64) -> Set (Word64, Word64)
forall a. Ord a => Set a -> Set a -> Set a
Set.symmetricDifference Set (Word64, Word64)
es0 Set (Word64, Word64)
es1
            in Word64 -> [(Word64, Word64)] -> Text
S.encodeSymmetricDifference Graph
g.numberOfVertices [(Word64, Word64)]
symdiff
          else
            AdjacencyList -> Text
S.encode
              S.AdjacencyList
                { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
                , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
                }
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Graph -> [Graph] -> [Text]
encodeMany' (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
g) [Graph]
gs


-- | Encode a graph using the format given by the `format` field.
-- Graphs with the `Incremental` format are encoded using sparse6.
encode :: Graph -> T.Text
encode :: Graph -> Text
encode Graph
g =
  case Graph
g.format of
    Format
Graph6 -> AdjacencyMatrix -> Text
G.encode
                 G.AdjacencyMatrix
                   { numberOfVertices :: Word64
G.numberOfVertices = Graph
g.numberOfVertices
                   , adjacency :: UArray Word64 Word8
G.adjacency  = Graph
g.adjacencyMatrix
                   }
    Format
Sparse6 -> AdjacencyList -> Text
S.encode
                S.AdjacencyList
                  { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
                  , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
                  }
    Format
Digraph6 -> AdjacencyMatrix -> Text
D.encode
                  D.AdjacencyMatrix
                    { numberOfVertices :: Word64
D.numberOfVertices = Graph
g.numberOfVertices
                    , adjacency :: UArray Word64 Word8
D.adjacency = Graph
g.adjacencyMatrix
                    }
    Format
Incremental -> AdjacencyList -> Text
S.encode
                    S.AdjacencyList
                      { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
                      , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
                      }

-- | Whether the graph contains and edge between two vertices.
-- In digraph6 format, the edge is a directed edge from the first to the second vertex.
edgeExists :: Graph
           -> Word64 -- ^ From vertex in directed graphs.
           -> Word64 -- ^ To vertex in directed graphs.
           -> Bool
edgeExists :: Graph -> Word64 -> Word64 -> Bool
edgeExists Graph
g Word64
u Word64
v = 
  case Graph
g.format of
    Format
Graph6  -> AdjacencyMatrix -> Word64 -> Word64 -> Bool
G.areAdjacent  
                 G.AdjacencyMatrix
                   { numberOfVertices :: Word64
G.numberOfVertices = Graph
g.numberOfVertices
                   , adjacency :: UArray Word64 Word8
G.adjacency  = Graph
g.adjacencyMatrix
                   }
                 Word64
u
                 Word64
v
    Format
Incremental -> AdjacencyList -> Word64 -> Word64 -> Bool
S.areAdjacent
                    S.AdjacencyList
                      { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
                      , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
                      }
                    Word64
u
                    Word64
v
    Format
Sparse6  -> AdjacencyList -> Word64 -> Word64 -> Bool
S.areAdjacent
                  S.AdjacencyList
                    { numberOfVertices :: Word64
S.numberOfVertices = Graph
g.numberOfVertices
                    , adjacency :: UArray Word64 Word64
S.adjacency = Graph
g.adjacencyList
                    }
                  Word64
u
                  Word64
v
    Format
Digraph6 -> AdjacencyMatrix -> Word64 -> Word64 -> Bool
D.arcExists
                  D.AdjacencyMatrix
                    { numberOfVertices :: Word64
D.numberOfVertices = Graph
g.numberOfVertices
                    , adjacency :: UArray Word64 Word8
D.adjacency = Graph
g.adjacencyMatrix
                    }
                  Word64
u
                  Word64
v

-- |The number of vertices and the list of (potentially directed) edges of a graph.
toEdgeList :: Graph -> (Word64, [(Word64, Word64)])
toEdgeList :: Graph -> (Word64, [(Word64, Word64)])
toEdgeList Graph
graph = (Graph
graph.numberOfVertices, [Word64] -> [(Word64, Word64)]
forall a. [a] -> [(a, a)]
groupByTwo ([Word64] -> [(Word64, Word64)]) -> [Word64] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ UArray Word64 Word64 -> [Word64]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Graph
graph.adjacencyList)