{- | LGL = Large Graph Layout (NCOL, LGL)

<http://lgl.sourceforge.net/#FileFormat>
-}
module Music.Theory.Graph.Lgl where

import Data.Bifunctor {- base -}
import Data.List {- base -}

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

-- * Ncol

-- | (edge,weight)
type Ncol_Ent t = ((t,t),Maybe Double)

-- | [ncol-entry]
type Ncol t = [Ncol_Ent t]

-- | Parse 'Ncol_Ent' from 'String'
ncol_parse :: Read t => String -> Ncol_Ent t
ncol_parse :: forall t. Read t => String -> Ncol_Ent t
ncol_parse String
s =
  case String -> [String]
words String
s of
    [String
i,String
j] -> ((forall a. Read a => String -> a
read String
i,forall a. Read a => String -> a
read String
j),forall a. Maybe a
Nothing)
    [String
i,String
j,String
k] -> ((forall a. Read a => String -> a
read String
i,forall a. Read a => String -> a
read String
j),forall a. Read a => String -> a
read String
k)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"ncol_parse"

-- | Load 'Ncol' from .ncol file.
ncol_load :: Read t => FilePath -> IO (Ncol t)
ncol_load :: forall t. Read t => String -> IO (Ncol t)
ncol_load = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall t. Read t => String -> Ncol_Ent t
ncol_parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Type-specialised.
ncol_load_int :: FilePath -> IO (Ncol Int)
ncol_load_int :: String -> IO (Ncol Int)
ncol_load_int = forall t. Read t => String -> IO (Ncol t)
ncol_load

{- | Format Ncol_Ent.

> ncol_ent_format 4 ((0,1),Nothing) == "0 1"
> ncol_ent_format 4 ((0,1),Just 2.0) == "0 1 2.0000"
-}
ncol_ent_format :: Show t => Int -> Ncol_Ent t -> String
ncol_ent_format :: forall t. Show t => Int -> Ncol_Ent t -> String
ncol_ent_format Int
k ((t
i,t
j),Maybe Double
w) = [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [t
i,t
j]) forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((Char
' 'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> String
T.double_pp Int
k) Maybe Double
w

-- | Store 'Ncol' of 'Int' to .ncol file
ncol_store :: Show t => Int -> FilePath -> Ncol t -> IO ()
ncol_store :: forall t. Show t => Int -> String -> Ncol t -> IO ()
ncol_store Int
k String
fn Ncol t
dat = String -> String -> IO ()
writeFile String
fn ([String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Show t => Int -> Ncol_Ent t -> String
ncol_ent_format Int
k) Ncol t
dat))

-- | Type-specialised.
ncol_store_int :: Int -> FilePath -> Ncol Int -> IO ()
ncol_store_int :: Int -> String -> Ncol Int -> IO ()
ncol_store_int = forall t. Show t => Int -> String -> Ncol t -> IO ()
ncol_store

-- | Ncol data must be un-directed and have no self-arcs.
--   This function sorts edges (i,j) so that i <= j and deletes edges where i == j.
ncol_rewrite_eset :: Ord t => [(t,t)] -> [(t,t)]
ncol_rewrite_eset :: forall t. Ord t => [(t, t)] -> [(t, t)]
ncol_rewrite_eset [(t, t)]
e = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(/=)) (forall a. Eq a => [a] -> [a]
nub (forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map forall t. Ord t => (t, t) -> (t, t)
T.t2_sort [(t, t)]
e)))

-- | eset (edge-set) to Ncol (runs 'ncol_rewrite_eset')
eset_to_ncol :: Ord t => [(t,t)] -> Ncol t
eset_to_ncol :: forall t. Ord t => [(t, t)] -> Ncol t
eset_to_ncol = forall a b. (a -> b) -> [a] -> [b]
map (\(t, t)
e -> ((t, t)
e,forall a. Maybe a
Nothing)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Ord t => [(t, t)] -> [(t, t)]
ncol_rewrite_eset

-- | Inverse of 'eset_to_ncol', 'error' if 'Ncol' is weighted
ncol_to_eset :: Ncol t -> [(t,t)]
ncol_to_eset :: forall t. Ncol t -> [(t, t)]
ncol_to_eset = forall a b. (a -> b) -> [a] -> [b]
map (\((t, t)
e,Maybe Double
w) -> case Maybe Double
w of {Maybe Double
Nothing -> (t, t)
e;Maybe Double
_ -> forall a. HasCallStack => String -> a
error String
"ncol_to_eset?"})

-- | 'ncol_store' of 'eset_to_ncol'
ncol_store_eset :: (Ord t,Show t) => FilePath -> [(t,t)] -> IO ()
ncol_store_eset :: forall t. (Ord t, Show t) => String -> [(t, t)] -> IO ()
ncol_store_eset String
fn = forall t. Show t => Int -> String -> Ncol t -> IO ()
ncol_store forall a. HasCallStack => a
undefined String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Ord t => [(t, t)] -> Ncol t
eset_to_ncol

-- * Lgl

-- | Lgl is an adjaceny set with optional weights.
type Lgl t = [(t,[(t,Maybe Double)])]

-- | Format 'Lgl', k is floating point precision for optional weights.
lgl_format :: Show t => Int -> Lgl t -> String
lgl_format :: forall t. Show t => Int -> Lgl t -> String
lgl_format Int
k =
  let f :: (a, Maybe Double) -> String
f (a
i,Maybe Double
j) = forall a. Show a => a -> String
show a
i forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((Char
' ' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> String
T.double_pp Int
k) Maybe Double
j
      g :: (a, [(a, Maybe Double)]) -> String
g (a
i,[(a, Maybe Double)]
j) = [String] -> String
unlines ((Char
'#' forall a. a -> [a] -> [a]
: Char
' ' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show a
i) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, Maybe Double) -> String
f [(a, Maybe Double)]
j)
  in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}.
(Show a, Show a) =>
(a, [(a, Maybe Double)]) -> String
g

-- | 'writeFile' of 'lgl_format'
lgl_store :: Show t => Int -> FilePath -> Lgl t -> IO ()
lgl_store :: forall t. Show t => Int -> String -> Lgl t -> IO ()
lgl_store Int
k String
fn = String -> String -> IO ()
writeFile String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Show t => Int -> Lgl t -> String
lgl_format Int
k

-- | adj (adjaceny-set) to 'Lgl'.
adj_to_lgl :: T.Adj t -> Lgl t
adj_to_lgl :: forall t. Adj t -> Lgl t
adj_to_lgl = forall a b. (a -> b) -> [a] -> [b]
map (\(t
i,[t]
j) -> (t
i,forall a b. [a] -> [b] -> [(a, b)]
zip [t]
j (forall a. a -> [a]
repeat forall a. Maybe a
Nothing)))

-- | Inverse of 'adj_to_lgl', 'error' if 'Lgl' is weighted
lgl_to_adj :: Lgl t -> T.Adj t
lgl_to_adj :: forall t. Lgl t -> Adj t
lgl_to_adj = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (a -> b) -> [a] -> [b]
map (\(t
k,Maybe Double
w) -> case Maybe Double
w of {Maybe Double
Nothing -> t
k;Maybe Double
_ -> forall a. HasCallStack => String -> a
error String
"lgl_to_adj?"})))

-- | 'lgl_store' of 'adj_to_lgl'
lgl_store_adj :: Show t => FilePath -> T.Adj t -> IO ()
lgl_store_adj :: forall t. Show t => String -> Adj t -> IO ()
lgl_store_adj String
fn = forall t. Show t => Int -> String -> Lgl t -> IO ()
lgl_store forall a. HasCallStack => a
undefined String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Adj t -> Lgl t
adj_to_lgl

-- > putStrLn $ lgl_format 4 $ adj_to_lgl [(0,[1,2,3]),(1,[2,3]),(2,[3])]