{- | graph6 graph encoding

<http://users.cecs.anu.edu.au/~bdm/nauty/>
<https://users.cecs.anu.edu.au/~bdm/data/formats.html>
-}
module Music.Theory.Graph.G6 where

import Data.Bifunctor {- base -}

import qualified Data.List.Split as Split {- split -}
import qualified System.Process as Process {- process -}

import qualified Music.Theory.Graph.Type as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}

-- * G6 (graph6)

-- | Load Graph6 file, discard optional header if present.
g6_load :: FilePath -> IO [String]
g6_load :: FilePath -> IO [FilePath]
g6_load FilePath
fn = do
  FilePath
s <- FilePath -> IO FilePath
readFile FilePath
fn
  let s' :: FilePath
s' = if forall a. Int -> [a] -> [a]
take Int
6 FilePath
s forall a. Eq a => a -> a -> Bool
== FilePath
">>graph6<<" then forall a. Int -> [a] -> [a]
drop Int
6 FilePath
s else FilePath
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath]
lines FilePath
s')

-- | Load G6 file variant where each line is "Description\tG6"
g6_dsc_load :: FilePath -> IO [(String,String)]
g6_dsc_load :: FilePath -> IO [(FilePath, FilePath)]
g6_dsc_load FilePath
fn = do
  FilePath
s <- FilePath -> IO FilePath
readFile FilePath
fn
  let r :: [(FilePath, FilePath)]
r = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Eq t => [t] -> [t] -> ([t], [t])
T.split_on_1_err FilePath
"\t") (FilePath -> [FilePath]
lines FilePath
s)
  forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, FilePath)]
r

-- | Call nauty-listg to transform a sequence of G6. (debian = nauty)
g6_to_edg :: [String] -> IO [T.Edg]
g6_to_edg :: [FilePath] -> IO [Edg]
g6_to_edg [FilePath]
g6 = do
  FilePath
r <- FilePath -> [FilePath] -> FilePath -> IO FilePath
Process.readProcess FilePath
"nauty-listg" [FilePath
"-q",FilePath
"-l0",FilePath
"-e"] ([FilePath] -> FilePath
unlines [FilePath]
g6)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> Edg
T.edg_parse (forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
2 (FilePath -> [FilePath]
lines FilePath
r)))

-- | 'T.edg_to_g' of 'g6_to_edg'
g6_to_g :: [String] -> IO [T.G]
g6_to_g :: [FilePath] -> IO [G]
g6_to_g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map Edg -> G
T.edg_to_g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> IO [Edg]
g6_to_edg

-- | 'g6_to_edg' of 'g6_dsc_load'.
g6_dsc_load_edg :: FilePath -> IO [(String,T.Edg)]
g6_dsc_load_edg :: FilePath -> IO [(FilePath, Edg)]
g6_dsc_load_edg FilePath
fn = do
  [(FilePath, FilePath)]
dat <- FilePath -> IO [(FilePath, FilePath)]
g6_dsc_load FilePath
fn
  let ([FilePath]
dsc,[FilePath]
g6) = forall a b. [(a, b)] -> ([a], [b])
unzip [(FilePath, FilePath)]
dat
  [Edg]
gr <- [FilePath] -> IO [Edg]
g6_to_edg [FilePath]
g6
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
dsc [Edg]
gr)

-- | 'T.edg_to_g' of 'g6_dsc_load_edg'
g6_dsc_load_gr :: FilePath -> IO [(String,T.G)]
g6_dsc_load_gr :: FilePath -> IO [(FilePath, G)]
g6_dsc_load_gr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Edg -> G
T.edg_to_g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [(FilePath, Edg)]
g6_dsc_load_edg

{- | Generate the text format read by nauty-amtog.

> e = ((4,3),[(0,3),(1,3),(2,3)])
> m = T.edg_to_adj_mtx_undir (0,1) e
> putStrLn (adj_mtx_to_am m)

-}
adj_mtx_to_am :: T.Adj_Mtx Int -> String
adj_mtx_to_am :: Adj_Mtx Int -> FilePath
adj_mtx_to_am (Int
nv,[[Int]]
mtx) =
  [FilePath] -> FilePath
unlines [FilePath
"n=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
nv
          ,FilePath
"m"
          ,[FilePath] -> FilePath
unlines (forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show) [[Int]]
mtx)]

-- | Call nauty-amtog to transform a sequence of Adj_Mtx to G6.
--
-- > adj_mtx_to_g6 [m,m]
adj_mtx_to_g6 :: [T.Adj_Mtx Int] -> IO [String]
adj_mtx_to_g6 :: [Adj_Mtx Int] -> IO [FilePath]
adj_mtx_to_g6 [Adj_Mtx Int]
adj = do
  FilePath
r <- FilePath -> [FilePath] -> FilePath -> IO FilePath
Process.readProcess FilePath
"nauty-amtog" [FilePath
"-q"] ([FilePath] -> FilePath
unlines (forall a b. (a -> b) -> [a] -> [b]
map Adj_Mtx Int -> FilePath
adj_mtx_to_am [Adj_Mtx Int]
adj))
  forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath]
lines FilePath
r)

-- | 'adj_mtx_to_g6' of 'T.g_to_adj_mtx_undir'
g_to_g6 :: [T.G] -> IO [String]
g_to_g6 :: [G] -> IO [FilePath]
g_to_g6 = [Adj_Mtx Int] -> IO [FilePath]
adj_mtx_to_g6 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall t. (t, t) -> G -> Adj_Mtx t
T.g_to_adj_mtx_undir (Int
0,Int
1))

-- | 'writeFile' of 'g_to_g6'
g_store_g6 :: FilePath -> [T.G] -> IO ()
g_store_g6 :: FilePath -> [G] -> IO ()
g_store_g6 FilePath
fn [G]
gr = [G] -> IO [FilePath]
g_to_g6 [G]
gr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> IO ()
writeFile FilePath
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines

-- | Call nauty-labelg to canonise a set of graphs.
g6_labelg :: [String] -> IO [String]
g6_labelg :: [FilePath] -> IO [FilePath]
g6_labelg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath -> IO FilePath
Process.readProcess FilePath
"nauty-labelg" [FilePath
"-q"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines

{- | 'g6_to_g' of 'g6_labelg' of 'g_to_g6'

> g1 = ([0,1,2,3],[(0,3),(3,1),(3,2),(1,2)])
> g2 = ([0,1,2,3],[(1,0),(0,3),(0,2),(2,3)])
> [g3,g4] <- g_labelg [g1,g2]
> (g1 == g2,g3 == g4)
-}
g_labelg :: [T.G] -> IO [T.G]
g_labelg :: [G] -> IO [G]
g_labelg [G]
g = [G] -> IO [FilePath]
g_to_g6 [G]
g forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
g6_labelg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [G]
g6_to_g