-- | <https://users.cecs.anu.edu.au/~bdm/plantri/plantri-guide.txt>
module Music.Theory.Graph.Planar where

import System.FilePath {- filepath -}
import System.Process {- process -}
import Text.Printf {- base -}

import qualified Data.ByteString as B {- bytestring -}
import qualified Data.List.Split as S {- split -}

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

-- | The 15-character header text indicating a Planar-Code file.
plc_header_txt :: String
plc_header_txt :: String
plc_header_txt = String
">>planar_code<<"

-- | Read Plc header
plc_header :: B.ByteString -> String
plc_header :: ByteString -> String
plc_header = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
15

-- | Read Plc data as list of 'Int'
plc_data :: B.ByteString -> [Int]
plc_data :: ByteString -> [Int]
plc_data = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
15

-- | Calculate length of Plc data given (n-vertices,n-edges).
plc_length :: (Int,Int) -> Int
plc_length :: (Int, Int) -> Int
plc_length (Int
v,Int
e) = Int
v forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
e

-- | Scan Plc data and segment after /k/ zeros.
plc_scanner :: Int -> [Int] -> ([Int],[Int])
plc_scanner :: Int -> [Int] -> ([Int], [Int])
plc_scanner =
  let f :: [a] -> t -> [a] -> ([a], [a])
f [a]
r t
k [a]
i = case [a]
i of
                  a
0:[a]
j -> if t
k forall a. Eq a => a -> a -> Bool
== t
1 then (forall a. [a] -> [a]
reverse (a
0 forall a. a -> [a] -> [a]
: [a]
r),[a]
j) else [a] -> t -> [a] -> ([a], [a])
f (a
0 forall a. a -> [a] -> [a]
: [a]
r) (t
k forall a. Num a => a -> a -> a
- t
1) [a]
j
                  a
e:[a]
j -> [a] -> t -> [a] -> ([a], [a])
f (a
e forall a. a -> [a] -> [a]
: [a]
r) t
k [a]
j
                  [a]
_ -> forall a. HasCallStack => String -> a
error String
"plc_scanner?"
  in forall {a} {t}.
(Eq a, Eq t, Num a, Num t) =>
[a] -> t -> [a] -> ([a], [a])
f []

-- | (n-vertices,clockwise-edge-sequences)
type Plc = (Int,[[Int]])

plc_n_vertices :: Plc -> Int
plc_n_vertices :: Plc -> Int
plc_n_vertices (Int
k,[[Int]]
_) = Int
k

-- | Group Plc data into Plc structure.
plc_group :: Int -> [Int] -> Plc
plc_group :: Int -> [Int] -> Plc
plc_group Int
k [Int]
i =
  let c :: [[Int]]
c = forall a. Eq a => [a] -> [a] -> [[a]]
S.endBy [Int
0] [Int]
i
  in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
c forall a. Eq a => a -> a -> Bool
== Int
k then (Int
k,[[Int]]
c) else forall a. HasCallStack => String -> a
error String
"plc_group?"

-- | Segment input data into sequence of Plc.
plc_segment :: [Int] -> [Plc]
plc_segment :: [Int] -> [Plc]
plc_segment [Int]
i =
  case [Int]
i of
    [] -> []
    Int
k:[Int]
j -> case Int -> [Int] -> ([Int], [Int])
plc_scanner Int
k [Int]
j of
             ([Int]
r,[]) -> [Int -> [Int] -> Plc
plc_group Int
k [Int]
r]
             ([Int]
r,[Int]
l) -> Int -> [Int] -> Plc
plc_group Int
k [Int]
r forall a. a -> [a] -> [a]
: [Int] -> [Plc]
plc_segment [Int]
l

plc_parse :: B.ByteString -> [Plc]
plc_parse :: ByteString -> [Plc]
plc_parse ByteString
b =
  if ByteString -> String
plc_header ByteString
b forall a. Eq a => a -> a -> Bool
== String
plc_header_txt
  then [Int] -> [Plc]
plc_segment (ByteString -> [Int]
plc_data ByteString
b)
  else forall a. HasCallStack => String -> a
error String
"plc_load?"

-- | Load sequence of Plc from binary Planar-Code file.
plc_load :: FilePath -> IO [Plc]
plc_load :: String -> IO [Plc]
plc_load = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Plc]
plc_parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
B.readFile

-- | All edges (one-indexed) at Plc
plc_edge_set :: Plc -> [(Int,Int)]
plc_edge_set :: Plc -> [(Int, Int)]
plc_edge_set (Int
k,[[Int]]
n) =
  let v :: [Int]
v = [Int
1 .. Int
k]
      f :: (a, [b]) -> [(a, b)]
f (a
i,[b]
j) = forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (a
i,b
x)) [b]
j
  in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b}. (a, [b]) -> [(a, b)]
f (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
v [[Int]]
n)

-- | Element in /x/ after /i/, the element after the last is the first.
--
-- > map (plc_next_elem "abcd") "abcd" == "bcda"
plc_next_elem :: Eq t => [t] -> t -> t
plc_next_elem :: forall t. Eq t => [t] -> t -> t
plc_next_elem [t]
x t
i =
  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= t
i) [t]
x of
    [] -> forall a. HasCallStack => String -> a
error String
"plc_next_elem?"
    [t
_] -> forall a. [a] -> a
head [t]
x
    t
_:t
j:[t]
_ -> t
j

-- | The next edge in Plc following /e/.
plc_next_edge :: Plc -> (Int,Int) -> (Int,Int)
plc_next_edge :: Plc -> (Int, Int) -> (Int, Int)
plc_next_edge (Int
_,[[Int]]
e) (Int
i,Int
j) = let k :: Int
k = forall t. Eq t => [t] -> t -> t
plc_next_elem ([[Int]]
e forall a. [a] -> Int -> a
!! (Int
j forall a. Num a => a -> a -> a
- Int
1)) Int
i in (Int
j,Int
k)

-- | The face of Plc starting at /e/ (one-indexed edges).
plc_face_from :: Plc -> (Int,Int) -> [(Int,Int)]
plc_face_from :: Plc -> (Int, Int) -> [(Int, Int)]
plc_face_from Plc
p (Int, Int)
e = (Int, Int)
e forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= (Int, Int)
e) (forall a. [a] -> [a]
tail (forall a. (a -> a) -> a -> [a]
iterate (Plc -> (Int, Int) -> (Int, Int)
plc_next_edge Plc
p) (Int, Int)
e))

-- | The set of all faces at Plc (one-indexed edges).
plc_face_set :: Plc -> [[(Int,Int)]]
plc_face_set :: Plc -> [[(Int, Int)]]
plc_face_set Plc
p =
  let f :: [[(Int, Int)]] -> [(Int, Int)] -> [[(Int, Int)]]
f [[(Int, Int)]]
r [(Int, Int)]
e =
        case [(Int, Int)]
e of
          [] -> forall a. [a] -> [a]
reverse [[(Int, Int)]]
r
          (Int, Int)
e0:[(Int, Int)]
eN -> if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int, Int)
e0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [[(Int, Int)]]
r
                   then [[(Int, Int)]] -> [(Int, Int)] -> [[(Int, Int)]]
f [[(Int, Int)]]
r [(Int, Int)]
eN
                   else [[(Int, Int)]] -> [(Int, Int)] -> [[(Int, Int)]]
f (Plc -> (Int, Int) -> [(Int, Int)]
plc_face_from Plc
p (Int, Int)
e0 forall a. a -> [a] -> [a]
: [[(Int, Int)]]
r) [(Int, Int)]
eN
  in [[(Int, Int)]] -> [(Int, Int)] -> [[(Int, Int)]]
f [] (Plc -> [(Int, Int)]
plc_edge_set Plc
p)

-- | Translate 'Plc' into un-directed 'T.G'.  Plc is one-indexed, G is zero-indexed.
plc_to_g :: Plc -> T.G
plc_to_g :: Plc -> G
plc_to_g Plc
p =
  let (Int
k,[[Int]]
_) = Plc
p
      v :: [Int]
v = [Int
0 .. Int
k forall a. Num a => a -> a -> a
- Int
1]
      f :: (a, b) -> (a, b)
f (a
i,b
j) = (a
i forall a. Num a => a -> a -> a
- a
1,b
j forall a. Num a => a -> a -> a
- b
1)
      g :: (a, a) -> Bool
g (a
i,a
j) = a
i forall a. Ord a => a -> a -> Bool
<= a
j
  in ([Int]
v,forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. Ord a => (a, a) -> Bool
g (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
f (Plc -> [(Int, Int)]
plc_edge_set Plc
p)))

plc_stat :: FilePath -> IO (Int, [(Int, Int, Int)])
plc_stat :: String -> IO (Int, [(Int, Int, Int)])
plc_stat String
plc_fn = do
  [Plc]
p_seq <- String -> IO [Plc]
plc_load String
plc_fn
  let f :: Plc -> (Int, Int, Int)
f Plc
p = (Plc -> Int
plc_n_vertices Plc
p,forall (t :: * -> *) a. Foldable t => t a -> Int
length (Plc -> [(Int, Int)]
plc_edge_set Plc
p) forall a. Integral a => a -> a -> a
`div` Int
2,forall (t :: * -> *) a. Foldable t => t a -> Int
length (Plc -> [[(Int, Int)]]
plc_face_set Plc
p))
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Plc]
p_seq,forall a b. (a -> b) -> [a] -> [b]
map Plc -> (Int, Int, Int)
f [Plc]
p_seq)

plc_stat_txt :: FilePath -> (Int, [(Int, Int, Int)]) -> [String]
plc_stat_txt :: String -> (Int, [(Int, Int, Int)]) -> [String]
plc_stat_txt String
fn (Int
k,[(Int, Int, Int)]
g) =
  let hdr :: String
hdr = forall r. PrintfType r => String -> r
printf String
"%s G=%d" (String -> String
takeBaseName String
fn) Int
k
      gr :: t -> (t, t, t) -> t
gr t
ix (t
v,t
e,t
f) = forall r. PrintfType r => String -> r
printf String
" %d: V=%d E=%d F=%d" t
ix t
v t
e t
f
  in String
hdr forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t} {t} {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfArg t, PrintfArg t,
 PrintfType t) =>
t -> (t, t, t) -> t
gr [Int
1::Int ..] [(Int, Int, Int)]
g

-- | Run "nauty-planarg" to convert (if possible) a set of G6 graphs to Planar-Code.
g6_planarg :: [String] -> IO B.ByteString
g6_planarg :: [String] -> IO ByteString
g6_planarg =
  -- else see process-extras:readProcessWithExitCode
  let str_to_b :: String -> B.ByteString
      str_to_b :: String -> ByteString
str_to_b = [Word8] -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum)
  in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
str_to_b forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String -> IO String
readProcess String
"nauty-planarg" [String
"-q"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines

-- | 'plc_parse' of 'g6_planarg' of 'G6.g_to_g6'
g_to_plc :: [T.G] -> IO [Plc]
g_to_plc :: [G] -> IO [Plc]
g_to_plc [G]
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Plc]
plc_parse ([G] -> IO [String]
G6.g_to_g6 [G]
g forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ByteString
g6_planarg)

-- | Run "nauty-planarg" to translate named G6 file to named PL file.
g6_to_pl_wr :: FilePath -> FilePath -> IO ()
g6_to_pl_wr :: String -> String -> IO ()
g6_to_pl_wr String
g6_fn String
pl_fn = String -> [String] -> IO ()
callProcess String
"nauty-planarg" [String
"-q",String
"-p",String
g6_fn,String
pl_fn]