{-# LANGUAGE OverloadedStrings #-}
module Nauty.Sparse6.Internal where
import Control.Monad.Trans.State
import Data.Bits
import Data.List
import Data.Word
import Data.Maybe
import Control.Monad.Trans.Class
import Nauty.Internal.Encoding
import Nauty.Internal.Parsing
import Nauty.Internal.Utils
import qualified Data.Array.Unboxed as A
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.Set as S
data AdjacencyList = AdjacencyList
{ AdjacencyList -> Word64
numberOfVertices :: Word64
, AdjacencyList -> UArray Word64 Word64
adjacency :: A.UArray Word64 Word64
} deriving (AdjacencyList -> AdjacencyList -> Bool
(AdjacencyList -> AdjacencyList -> Bool)
-> (AdjacencyList -> AdjacencyList -> Bool) -> Eq AdjacencyList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdjacencyList -> AdjacencyList -> Bool
== :: AdjacencyList -> AdjacencyList -> Bool
$c/= :: AdjacencyList -> AdjacencyList -> Bool
/= :: AdjacencyList -> AdjacencyList -> Bool
Eq, Int -> AdjacencyList -> ShowS
[AdjacencyList] -> ShowS
AdjacencyList -> String
(Int -> AdjacencyList -> ShowS)
-> (AdjacencyList -> String)
-> ([AdjacencyList] -> ShowS)
-> Show AdjacencyList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdjacencyList -> ShowS
showsPrec :: Int -> AdjacencyList -> ShowS
$cshow :: AdjacencyList -> String
show :: AdjacencyList -> String
$cshowList :: [AdjacencyList] -> ShowS
showList :: [AdjacencyList] -> ShowS
Show)
parse :: T.Text -> [Either T.Text AdjacencyList]
parse :: Text -> [Either Text AdjacencyList]
parse Text
t =
let t' :: Text
t' = Text -> Text -> Text
header Text
">>sparse6<<" Text
t
in (Text -> Either Text AdjacencyList)
-> [Text] -> [Either Text AdjacencyList]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text AdjacencyList
graph ([Text] -> [Either Text AdjacencyList])
-> [Text] -> [Either Text AdjacencyList]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t'
graph :: T.Text -> Either T.Text AdjacencyList
graph :: Text -> Either Text AdjacencyList
graph Text
str = ((StateT ByteString (Either Text) AdjacencyList
-> ByteString -> Either Text AdjacencyList)
-> ByteString
-> StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ByteString (Either Text) AdjacencyList
-> ByteString -> Either Text AdjacencyList
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT) (Text -> ByteString
T.encodeUtf8 Text
str) (StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList)
-> StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList
forall a b. (a -> b) -> a -> b
$ do
ByteString
h <- Word64 -> StateT ByteString (Either Text) ByteString
consume Word64
1
if ByteString -> [Word8]
B.unpack ByteString
h [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
':'] then
Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList
forall (m :: * -> *) a. Monad m => m a -> StateT ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList)
-> Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AdjacencyList
forall a b. a -> Either a b
Left (Text -> Either Text AdjacencyList)
-> Text -> Either Text AdjacencyList
forall a b. (a -> b) -> a -> b
$ Text
"Expected ':', but found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
h)
else do
Word64
n <- StateT ByteString (Either Text) Word64
parseNumber
if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then
AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return AdjacencyList{ numberOfVertices :: Word64
numberOfVertices = Word64
0, adjacency :: UArray Word64 Word64
adjacency = (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
0) [(Word64
0,Word64
0)]}
else do
let k :: Word64
k = Word64 -> Word64
forall a. Num a => Word64 -> a
numBits (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
Word64 -> Word64 -> StateT ByteString (Either Text) AdjacencyList
parseEdgeList Word64
n Word64
k
symmetricDifference :: AdjacencyList
-> T.Text
-> Either T.Text AdjacencyList
symmetricDifference :: AdjacencyList -> Text -> Either Text AdjacencyList
symmetricDifference AdjacencyList
g Text
hTxt =
((StateT ByteString (Either Text) AdjacencyList
-> ByteString -> Either Text AdjacencyList)
-> ByteString
-> StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ByteString (Either Text) AdjacencyList
-> ByteString -> Either Text AdjacencyList
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT) (Text -> ByteString
T.encodeUtf8 Text
hTxt) (StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList)
-> StateT ByteString (Either Text) AdjacencyList
-> Either Text AdjacencyList
forall a b. (a -> b) -> a -> b
$ do
ByteString
h <- Word64 -> StateT ByteString (Either Text) ByteString
consume Word64
1
let hu :: [Word8]
hu = ByteString -> [Word8]
B.unpack ByteString
h
if [Word8]
hu [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
';'] then do
let n :: Word64
n = (AdjacencyList -> Word64
numberOfVertices AdjacencyList
g)
let k :: Word64
k = Word64 -> Word64
forall a. Num a => Word64 -> a
numBits (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
AdjacencyList
g1 <- Word64 -> Word64 -> StateT ByteString (Either Text) AdjacencyList
parseEdgeList Word64
n Word64
k
let es0 :: Set (Word64, Word64)
es0 = [(Word64, Word64)] -> Set (Word64, Word64)
forall a. Ord a => [a] -> Set a
S.fromList ([(Word64, Word64)] -> Set (Word64, Word64))
-> [(Word64, Word64)] -> Set (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a, b) -> b
snd ((Word64, [(Word64, Word64)]) -> [(Word64, Word64)])
-> (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> (Word64, [(Word64, Word64)])
toEdgeList AdjacencyList
g
es1 :: Set (Word64, Word64)
es1 = [(Word64, Word64)] -> Set (Word64, Word64)
forall a. Ord a => [a] -> Set a
S.fromList ([(Word64, Word64)] -> Set (Word64, Word64))
-> [(Word64, Word64)] -> Set (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a, b) -> b
snd ((Word64, [(Word64, Word64)]) -> [(Word64, Word64)])
-> (Word64, [(Word64, Word64)]) -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> (Word64, [(Word64, Word64)])
toEdgeList AdjacencyList
g1
AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AdjacencyList -> StateT ByteString (Either Text) AdjacencyList)
-> AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a b. (a -> b) -> a -> b
$ Word64 -> [(Word64, Word64)] -> AdjacencyList
fromEdgeList (AdjacencyList -> Word64
numberOfVertices AdjacencyList
g) (Set (Word64, Word64) -> [(Word64, Word64)]
forall a. Set a -> [a]
S.toList (Set (Word64, Word64) -> [(Word64, Word64)])
-> Set (Word64, Word64) -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ (Set (Word64, Word64)
es0 Set (Word64, Word64)
-> Set (Word64, Word64) -> Set (Word64, Word64)
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set (Word64, Word64)
es1) Set (Word64, Word64)
-> Set (Word64, Word64) -> Set (Word64, Word64)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (Set (Word64, Word64)
es1 Set (Word64, Word64)
-> Set (Word64, Word64) -> Set (Word64, Word64)
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set (Word64, Word64)
es0))
else if [Word8]
hu [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
':'] then do
Word64
n <- StateT ByteString (Either Text) Word64
parseNumber
if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then
AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return AdjacencyList{ numberOfVertices :: Word64
numberOfVertices = Word64
0, adjacency :: UArray Word64 Word64
adjacency = (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
0) [(Word64
0,Word64
0)]}
else do
let k :: Word64
k = Word64 -> Word64
forall a. Num a => Word64 -> a
numBits (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
Word64 -> Word64 -> StateT ByteString (Either Text) AdjacencyList
parseEdgeList Word64
n Word64
k
else
Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList
forall (m :: * -> *) a. Monad m => m a -> StateT ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList)
-> Either Text AdjacencyList
-> StateT ByteString (Either Text) AdjacencyList
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AdjacencyList
forall a b. a -> Either a b
Left (Text -> Either Text AdjacencyList)
-> Text -> Either Text AdjacencyList
forall a b. (a -> b) -> a -> b
$ Text
"Expected ':' or ';', but found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
h)
data EncodeState = EncodeState
{ EncodeState -> Word64
currentV :: Word64
, EncodeState -> Word8
currentByte :: Word8
, EncodeState -> Int
usedBits :: Int
, EncodeState -> Bool
n2HasEdge :: Bool
, EncodeState -> Bool
n1HasEdge :: Bool
, EncodeState -> [Word8]
encoding :: [Word8]
} deriving (EncodeState -> EncodeState -> Bool
(EncodeState -> EncodeState -> Bool)
-> (EncodeState -> EncodeState -> Bool) -> Eq EncodeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodeState -> EncodeState -> Bool
== :: EncodeState -> EncodeState -> Bool
$c/= :: EncodeState -> EncodeState -> Bool
/= :: EncodeState -> EncodeState -> Bool
Eq, Int -> EncodeState -> ShowS
[EncodeState] -> ShowS
EncodeState -> String
(Int -> EncodeState -> ShowS)
-> (EncodeState -> String)
-> ([EncodeState] -> ShowS)
-> Show EncodeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodeState -> ShowS
showsPrec :: Int -> EncodeState -> ShowS
$cshow :: EncodeState -> String
show :: EncodeState -> String
$cshowList :: [EncodeState] -> ShowS
showList :: [EncodeState] -> ShowS
Show)
encode :: AdjacencyList -> T.Text
encode :: AdjacencyList -> Text
encode AdjacencyList
g =
Text
":"
Text -> Text -> Text
`T.append`
(Word64 -> Text
encodeNumber (Word64 -> Text) -> Word64 -> Text
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> Word64
numberOfVertices AdjacencyList
g)
Text -> Text -> Text
`T.append`
(Word64 -> [(Word64, Word64)] -> Text
encodeEdgeList (AdjacencyList -> Word64
numberOfVertices AdjacencyList
g) ([(Word64, Word64)] -> Text) -> [(Word64, Word64)] -> Text
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 (UArray Word64 Word64 -> [Word64])
-> UArray Word64 Word64 -> [Word64]
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> UArray Word64 Word64
adjacency AdjacencyList
g)
encodeSymmetricDifference :: Word64 -> [(Word64, Word64)] -> T.Text
encodeSymmetricDifference :: Word64 -> [(Word64, Word64)] -> Text
encodeSymmetricDifference Word64
n [(Word64, Word64)]
es =
Text
";"
Text -> Text -> Text
`T.append`
(Word64 -> [(Word64, Word64)] -> Text
encodeEdgeList Word64
n [(Word64, Word64)]
es)
encodeEdgeList :: Word64 -> [(Word64, Word64)] -> T.Text
encodeEdgeList :: Word64 -> [(Word64, Word64)] -> Text
encodeEdgeList Word64
n [(Word64, Word64)]
es =
let k :: Int
k = Word64 -> Int
forall a. Num a => Word64 -> a
numBits (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 :: Int
encodeEdges :: [(Word64, Word64)] -> StateT EncodeState Maybe T.Text
encodeEdges :: [(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges [] = do
EncodeState
st <- StateT EncodeState Maybe EncodeState
forall (m :: * -> *) s. Monad m => StateT s m s
get
if EncodeState -> Int
usedBits EncodeState
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
Text -> StateT EncodeState Maybe Text
forall a. a -> StateT EncodeState Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EncodeState Maybe Text)
-> Text -> StateT EncodeState Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
63) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$
EncodeState -> [Word8]
encoding EncodeState
st
else
let padding :: Int
padding = Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- EncodeState -> Int
usedBits EncodeState
st in
if (Word64
n,Int
k) (Word64, Int) -> [(Word64, Int)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Word64
2,Int
1), (Word64
4,Int
2), (Word64
8,Int
3), (Word64
16,Int
4)]
Bool -> Bool -> Bool
&& Int
padding Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Bool -> Bool -> Bool
&& EncodeState -> Bool
n2HasEdge EncodeState
st
Bool -> Bool -> Bool
&& Bool -> Bool
not (EncodeState -> Bool
n1HasEdge EncodeState
st)
then
Text -> StateT EncodeState Maybe Text
forall a. a -> StateT EncodeState Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EncodeState Maybe Text)
-> Text -> StateT EncodeState Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
63) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$
(((Int -> Word8 -> Word8) -> Word8 -> [Int] -> Word8
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\Int
i Word8
b -> Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Word8
b Int
i)
(Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (EncodeState -> Word8
currentByte EncodeState
st) Int
padding)
[Int
0..Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2])
Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: EncodeState -> [Word8]
encoding EncodeState
st)
else
Text -> StateT EncodeState Maybe Text
forall a. a -> StateT EncodeState Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT EncodeState Maybe Text)
-> Text -> StateT EncodeState Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
63) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$
(((Int -> Word8 -> Word8) -> Word8 -> [Int] -> Word8
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\Int
i Word8
b -> Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Word8
b Int
i)
(Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (EncodeState -> Word8
currentByte EncodeState
st) Int
padding)
[Int
0..Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: EncodeState -> [Word8]
encoding EncodeState
st)
encodeEdges ((Word64
v', Word64
u) : [(Word64, Word64)]
es') = do
if Word64
v' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u then
[(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges ((Word64
u, Word64
v') (Word64, Word64) -> [(Word64, Word64)] -> [(Word64, Word64)]
forall a. a -> [a] -> [a]
: [(Word64, Word64)]
es')
else do
EncodeState
st <- StateT EncodeState Maybe EncodeState
forall (m :: * -> *) s. Monad m => StateT s m s
get
if Word64
v' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> (EncodeState -> Word64
currentV EncodeState
st) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 then do
if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2 then
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v', n2HasEdge = True}
else if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 then
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v', n1HasEdge = True}
else
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v'}
StateT EncodeState Maybe ()
forall (m :: * -> *). Monad m => StateT EncodeState m ()
zeroBit
Word64 -> StateT EncodeState Maybe ()
encodeVertex Word64
v'
StateT EncodeState Maybe ()
forall (m :: * -> *). Monad m => StateT EncodeState m ()
zeroBit
Word64 -> StateT EncodeState Maybe ()
encodeVertex Word64
u
[(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges [(Word64, Word64)]
es'
else if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (EncodeState -> Word64
currentV EncodeState
st) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 then do
if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2 then
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v', n2HasEdge = True}
else if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 then
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v', n1HasEdge = True}
else
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{currentV = v'}
StateT EncodeState Maybe ()
forall (m :: * -> *). Monad m => StateT EncodeState m ()
oneBit
Word64 -> StateT EncodeState Maybe ()
encodeVertex Word64
u
[(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges [(Word64, Word64)]
es'
else if Word64
v' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (EncodeState -> Word64
currentV EncodeState
st) then do
StateT EncodeState Maybe ()
forall (m :: * -> *). Monad m => StateT EncodeState m ()
zeroBit
Word64 -> StateT EncodeState Maybe ()
encodeVertex Word64
u
[(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges [(Word64, Word64)]
es'
else
String -> StateT EncodeState Maybe Text
forall a. String -> StateT EncodeState Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
encodeVertex :: Word64 -> StateT EncodeState (Maybe) ()
encodeVertex :: Word64 -> StateT EncodeState Maybe ()
encodeVertex Word64
u = do
EncodeState
st <- StateT EncodeState Maybe EncodeState
forall (m :: * -> *) s. Monad m => StateT s m s
get
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- EncodeState -> Int
usedBits EncodeState
st then
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{ currentByte = (shiftL (currentByte st ) k) .|. (fromIntegral u)
, usedBits = usedBits st + k }
else do
let ([Word8]
blocks, Word8
b', Int
i') = Word64 -> Int -> [Word8] -> Word8 -> Int -> ([Word8], Word8, Int)
encodeVertex' Word64
u Int
k [] (EncodeState -> Word8
currentByte EncodeState
st) (EncodeState -> Int
usedBits EncodeState
st)
EncodeState -> StateT EncodeState Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st { currentByte = b'
, usedBits = i'
, encoding = blocks ++ encoding st
}
in
case StateT EncodeState Maybe Text -> EncodeState -> Maybe Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ([(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges [(Word64, Word64)]
es)
EncodeState
encodeStartState
of
Just Text
txt -> Text
txt
Maybe Text
Nothing -> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ StateT EncodeState Maybe Text -> EncodeState -> Maybe Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
( [(Word64, Word64)] -> StateT EncodeState Maybe Text
encodeEdges ([(Word64, Word64)] -> StateT EncodeState Maybe Text)
-> [(Word64, Word64)] -> StateT EncodeState Maybe Text
forall a b. (a -> b) -> a -> b
$
((Word64, Word64) -> (Word64, Word64) -> Ordering)
-> [(Word64, Word64)] -> [(Word64, Word64)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Word64
v0, Word64
u0) (Word64
v1, Word64
u1) -> (Word64, Word64) -> (Word64, Word64) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word64
u0, Word64
v0) (Word64
u1, Word64
v1)) ([(Word64, Word64)] -> [(Word64, Word64)])
-> [(Word64, Word64)] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$
((Word64, Word64) -> (Word64, Word64))
-> [(Word64, Word64)] -> [(Word64, Word64)]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Word64
v,Word64
u) -> if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u then (Word64
u,Word64
v) else (Word64
v,Word64
u))
[(Word64, Word64)]
es
) EncodeState
encodeStartState
encodeVertex' :: Word64
-> Int
-> [Word8]
-> Word8
-> Int
-> ([Word8], Word8, Int)
encodeVertex' :: Word64 -> Int -> [Word8] -> Word8 -> Int -> ([Word8], Word8, Int)
encodeVertex' Word64
u Int
k' [Word8]
bs Word8
b Int
i
| Int
k' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i =
let b' :: Word8
b' = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b Int
k') Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u)
in (Word8
b' Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
bs, Word8
0, Int
0 )
| Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i =
let b' :: Word8
b' = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b Int
k') Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u)
in ([Word8]
bs, Word8
b', Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k' )
| Bool
otherwise =
let k'' :: Int
k'' = (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
u' :: Word64
u' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
u Int
k''
u'' :: Word64
u'' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
u (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k'')) (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k'')
b' :: Word8
b' = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u')
in Word64 -> Int -> [Word8] -> Word8 -> Int -> ([Word8], Word8, Int)
encodeVertex' Word64
u'' (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Word8
b' Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
bs) Word8
0 Int
0
oneBit :: (Monad m) => StateT EncodeState m ()
oneBit :: forall (m :: * -> *). Monad m => StateT EncodeState m ()
oneBit = do
EncodeState
st <- StateT EncodeState m EncodeState
forall (m :: * -> *) s. Monad m => StateT s m s
get
if EncodeState -> Int
usedBits EncodeState
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 then
EncodeState -> StateT EncodeState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{ currentByte = 1
, usedBits = 1
, encoding = (currentByte st) : encoding st}
else
EncodeState -> StateT EncodeState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{ currentByte = setBit (shiftL (currentByte st) 1) 0
, usedBits = usedBits st + 1
}
zeroBit :: (Monad m) => StateT EncodeState m ()
zeroBit :: forall (m :: * -> *). Monad m => StateT EncodeState m ()
zeroBit = do
EncodeState
st <- StateT EncodeState m EncodeState
forall (m :: * -> *) s. Monad m => StateT s m s
get
if EncodeState -> Int
usedBits EncodeState
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 then
EncodeState -> StateT EncodeState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{ currentByte = 0
, usedBits = 1
, encoding = (currentByte st) : encoding st}
else
EncodeState -> StateT EncodeState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put EncodeState
st{ currentByte = shiftL (currentByte st) 1
, usedBits = usedBits st + 1
}
encodeStartState :: EncodeState
encodeStartState :: EncodeState
encodeStartState = EncodeState
{ currentV :: Word64
currentV = Word64
0
, currentByte :: Word8
currentByte = Word8
0
, usedBits :: Int
usedBits = Int
0
, n2HasEdge :: Bool
n2HasEdge = Bool
False
, n1HasEdge :: Bool
n1HasEdge = Bool
False
, encoding :: [Word8]
encoding = []
}
data EdgeListState = EdgeListState
{ EdgeListState -> Word64
elV :: Word64
, EdgeListState -> Word64
elU :: Word64
, EdgeListState -> Int
uMissing :: Int
, EdgeListState -> [(Word64, Word64)]
edges :: [(Word64, Word64)]
}
deriving (EdgeListState -> EdgeListState -> Bool
(EdgeListState -> EdgeListState -> Bool)
-> (EdgeListState -> EdgeListState -> Bool) -> Eq EdgeListState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EdgeListState -> EdgeListState -> Bool
== :: EdgeListState -> EdgeListState -> Bool
$c/= :: EdgeListState -> EdgeListState -> Bool
/= :: EdgeListState -> EdgeListState -> Bool
Eq, Int -> EdgeListState -> ShowS
[EdgeListState] -> ShowS
EdgeListState -> String
(Int -> EdgeListState -> ShowS)
-> (EdgeListState -> String)
-> ([EdgeListState] -> ShowS)
-> Show EdgeListState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EdgeListState -> ShowS
showsPrec :: Int -> EdgeListState -> ShowS
$cshow :: EdgeListState -> String
show :: EdgeListState -> String
$cshowList :: [EdgeListState] -> ShowS
showList :: [EdgeListState] -> ShowS
Show)
parseEdgeList :: Word64
-> Word64
-> StateT B.ByteString (Either T.Text) AdjacencyList
parseEdgeList :: Word64 -> Word64 -> StateT ByteString (Either Text) AdjacencyList
parseEdgeList Word64
n Word64
k = do
ByteString
bs <- StateT ByteString (Either Text) ByteString
forall (m :: * -> *) s. Monad m => StateT s m s
get
ByteString -> StateT ByteString (Either Text) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put ByteString
B.empty
let els :: EdgeListState
els = (EdgeListState -> Word8 -> EdgeListState)
-> EdgeListState -> ByteString -> EdgeListState
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl'
(Word64 -> Word64 -> EdgeListState -> Word8 -> EdgeListState
edgeList Word64
n Word64
k)
EdgeListState
{ elV :: Word64
elV = Word64
0
, elU :: Word64
elU = Word64
0
, uMissing :: Int
uMissing = Int
0
, edges :: [(Word64, Word64)]
edges = []
}
ByteString
bs
es :: [(Word64, Word64)]
es = EdgeListState -> [(Word64, Word64)]
edges EdgeListState
els
AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AdjacencyList -> StateT ByteString (Either Text) AdjacencyList)
-> AdjacencyList -> StateT ByteString (Either Text) AdjacencyList
forall a b. (a -> b) -> a -> b
$ AdjacencyList
{ numberOfVertices :: Word64
numberOfVertices = Word64
n
, adjacency :: UArray Word64 Word64
adjacency = (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
* (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) 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)] -> [Word64]) -> [(Word64, Word64)] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [(Word64, Word64)] -> [(Word64, Word64)]
forall a. [a] -> [a]
reverse [(Word64, Word64)]
es
}
consumeByte :: Word64
-> Word64
-> EdgeListState
-> Word8
-> Int
-> EdgeListState
consumeByte :: Word64 -> Word64 -> EdgeListState -> Word8 -> Int -> EdgeListState
consumeByte Word64
n Word64
k EdgeListState
st' Word8
b Int
l' = EdgeListState -> Int -> EdgeListState
consumeByte' EdgeListState
st' Int
l'
where
consumeByte' :: EdgeListState -> Int -> EdgeListState
consumeByte' EdgeListState
st Int
0 = EdgeListState
st
consumeByte' EdgeListState
st Int
l
| EdgeListState -> Int
uMissing EdgeListState
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
if EdgeListState -> Word64
elV EdgeListState
st Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 then
EdgeListState
st
else
EdgeListState -> Int -> EdgeListState
consumeByte' EdgeListState
st{elV = elV st + 1, uMissing = fromIntegral k} (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else
EdgeListState -> Int -> EdgeListState
consumeByte' EdgeListState
st{uMissing = fromIntegral k} (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| EdgeListState -> Int
uMissing EdgeListState
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l =
let u' :: Word64
u' = (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (EdgeListState -> Word64
elU EdgeListState
st) (EdgeListState -> Int
uMissing EdgeListState
st)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)) (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (EdgeListState -> Int
uMissing EdgeListState
st)))
in
EdgeListState -> Int -> EdgeListState
consumeByte'
(if Word64
u' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> EdgeListState -> Word64
elV EdgeListState
st then
EdgeListState
st
{ elV = u'
, elU = 0
, uMissing = 0
}
else
EdgeListState
st
{ elU = 0
, uMissing = 0
, edges = (elV st, u') : edges st
})
(Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- (EdgeListState -> Int
uMissing EdgeListState
st))
| Bool
otherwise =
let u' :: Word64
u' = (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (EdgeListState -> Word64
elU EdgeListState
st) Int
l) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)) (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)))
in
EdgeListState
st
{ elU = u'
, uMissing = (uMissing st) - fromIntegral l
}
edgeList :: Word64 -> Word64 -> EdgeListState -> Word8 -> EdgeListState
edgeList :: Word64 -> Word64 -> EdgeListState -> Word8 -> EdgeListState
edgeList Word64
n Word64
k EdgeListState
st Word8
b = Word64 -> Word64 -> EdgeListState -> Word8 -> Int -> EdgeListState
consumeByte Word64
n Word64
k EdgeListState
st (Word8
b Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
63) Int
6
fromEdgeList :: Word64 -> [(Word64, Word64)] -> AdjacencyList
fromEdgeList :: Word64 -> [(Word64, Word64)] -> AdjacencyList
fromEdgeList Word64
n [(Word64, Word64)]
es = AdjacencyList
{ numberOfVertices :: Word64
numberOfVertices = Word64
n
, adjacency :: UArray Word64 Word64
adjacency = (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, Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([(Word64, Word64)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word64, Word64)]
es) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
}
toEdgeList :: AdjacencyList -> (Word64, [(Word64, Word64)])
toEdgeList :: AdjacencyList -> (Word64, [(Word64, Word64)])
toEdgeList AdjacencyList
g = (AdjacencyList -> Word64
numberOfVertices AdjacencyList
g, [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 (UArray Word64 Word64 -> [Word64])
-> UArray Word64 Word64 -> [Word64]
forall a b. (a -> b) -> a -> b
$ AdjacencyList -> UArray Word64 Word64
adjacency AdjacencyList
g)
areAdjacent :: AdjacencyList -> Word64 -> Word64 -> Bool
areAdjacent :: AdjacencyList -> Word64 -> Word64 -> Bool
areAdjacent AdjacencyList
g Word64
v Word64
u =
let e :: (Word64, Word64)
e = if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u then (Word64
v,Word64
u) else (Word64
u,Word64
v) in
(Word64, Word64)
e (Word64, Word64) -> [(Word64, Word64)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([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 (AdjacencyList -> UArray Word64 Word64
adjacency AdjacencyList
g))