{- | graph6 graph encoding
-}
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 fn = do
s <- readFile fn
let s' = if take 6 s == ">>graph6<<" then drop 6 s else s
return (lines s')
-- | Load G6 file variant where each line is "Description\tG6"
g6_dsc_load :: FilePath -> IO [(String,String)]
g6_dsc_load fn = do
s <- readFile fn
let r = map (T.split_on_1_err "\t") (lines s)
return r
-- | Call nauty-listg to transform a sequence of G6. (debian = nauty)
g6_to_edg :: [String] -> IO [T.Edg]
g6_to_edg g6 = do
r <- Process.readProcess "nauty-listg" ["-q","-l0","-e"] (unlines g6)
return (map T.edg_parse (Split.chunksOf 2 (lines r)))
-- | 'T.edg_to_g' of 'g6_to_edg'
g6_to_g :: [String] -> IO [T.G]
g6_to_g = fmap (map T.edg_to_g) . g6_to_edg
-- | 'g6_to_edg' of 'g6_dsc_load'.
g6_dsc_load_edg :: FilePath -> IO [(String,T.Edg)]
g6_dsc_load_edg fn = do
dat <- g6_dsc_load fn
let (dsc,g6) = unzip dat
gr <- g6_to_edg g6
return (zip dsc gr)
-- | 'T.edg_to_g' of 'g6_dsc_load_edg'
g6_dsc_load_gr :: FilePath -> IO [(String,T.G)]
g6_dsc_load_gr = fmap (map (second T.edg_to_g)) . 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 (nv,mtx) =
unlines ["n=" ++ show nv
,"m"
,unlines (map (unwords . map show) 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 = do
r <- Process.readProcess "nauty-amtog" ["-q"] (unlines (map adj_mtx_to_am adj))
return (lines r)
-- | 'adj_mtx_to_g6' of 'T.g_to_adj_mtx_undir'
g_to_g6 :: [T.G] -> IO [String]
g_to_g6 = adj_mtx_to_g6 . map (T.g_to_adj_mtx_undir (0,1))
-- | 'writeFile' of 'g_to_g6'
g_store_g6 :: FilePath -> [T.G] -> IO ()
g_store_g6 fn gr = g_to_g6 gr >>= writeFile fn . unlines
-- | Call nauty-labelg to canonise a set of graphs.
g6_labelg :: [String] -> IO [String]
g6_labelg = fmap lines . Process.readProcess "nauty-labelg" ["-q"] . 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 = g_to_g6 g >>= g6_labelg >>= g6_to_g