{-# LANGUAGE NoImplicitPrelude #-}
module Combinatorial
  ( subseqs
  , partitions
  , perms
  , consl, consr
  , cup
  , interleave
  ) where

import AOPPrelude
import Data.List ((\\))

subseqs :: [a] -> [[a]]
subseqs :: forall a. [a] -> [[a]]
subseqs = ([[a]], (a, [[a]]) -> [[a]]) -> [a] -> [[a]]
forall b a. (b, (a, b) -> b) -> [a] -> b
catalist ([[a]]
forall {a}. [[a]]
e, (a, [[a]]) -> [[a]]
forall {a}. (a, [[a]]) -> [[a]]
f)
  where
    e :: [[a]]
e = [a] -> [[a]]
forall a. a -> [a]
wrap []
    f :: (a, [[a]]) -> [[a]]
f = ([[a]], [[a]]) -> [[a]]
forall a. ([a], [a]) -> [a]
cat (([[a]], [[a]]) -> [[a]])
-> ((a, [[a]]) -> ([[a]], [[a]])) -> (a, [[a]]) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [[a]]) -> [[a]], (a, [[a]]) -> [[a]])
-> (a, [[a]]) -> ([[a]], [[a]])
forall a b c. (a -> b, a -> c) -> a -> (b, c)
pair (((a, [a]) -> [a]) -> [(a, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
list (a, [a]) -> [a]
forall a. (a, [a]) -> [a]
cons ([(a, [a])] -> [[a]])
-> ((a, [[a]]) -> [(a, [a])]) -> (a, [[a]]) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [[a]]) -> [(a, [a])]
forall a b. (a, [b]) -> [(a, b)]
cpr, (a, [[a]]) -> [[a]]
forall a b. (a, b) -> b
outr)

new :: (a, [[a]]) -> [[a]]
new :: forall {a}. (a, [[a]]) -> [[a]]
new = ([a], [[a]]) -> [[a]]
forall a. (a, [a]) -> [a]
cons (([a], [[a]]) -> [[a]])
-> ((a, [[a]]) -> ([a], [[a]])) -> (a, [[a]]) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a], [[a]] -> [[a]]) -> (a, [[a]]) -> ([a], [[a]])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
cross (a -> [a]
forall a. a -> [a]
wrap, [[a]] -> [[a]]
forall a. a -> a
id)

glues :: (a, [[a]]) -> [[[a]]]
glues :: forall a. (a, [[a]]) -> [[[a]]]
glues (a
a, [])   = []
glues (a
a, [a]
x:[[a]]
xs) = [(a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
x)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
xs]

partitions :: [a] -> [[[a]]]
partitions :: forall a. [a] -> [[[a]]]
partitions = ([[[a]]], (a, [[[a]]]) -> [[[a]]]) -> [a] -> [[[a]]]
forall b a. (b, (a, b) -> b) -> [a] -> b
catalist ([[[a]]]
forall {a}. [[a]]
e, (a, [[[a]]]) -> [[[a]]]
forall {a}. (a, [[[a]]]) -> [[[a]]]
f)
  where
    e :: [[a]]
e = [a] -> [[a]]
forall a. a -> [a]
wrap []
    f :: (a, [[[a]]]) -> [[[a]]]
f = [[[[a]]]] -> [[[a]]]
forall a. [[a]] -> [a]
concat ([[[[a]]]] -> [[[a]]])
-> ((a, [[[a]]]) -> [[[[a]]]]) -> (a, [[[a]]]) -> [[[a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [[a]]) -> [[[a]]]) -> [(a, [[a]])] -> [[[[a]]]]
forall a b. (a -> b) -> [a] -> [b]
list (([[a]], [[[a]]]) -> [[[a]]]
forall a. (a, [a]) -> [a]
cons (([[a]], [[[a]]]) -> [[[a]]])
-> ((a, [[a]]) -> ([[a]], [[[a]]])) -> (a, [[a]]) -> [[[a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [[a]]) -> [[a]], (a, [[a]]) -> [[[a]]])
-> (a, [[a]]) -> ([[a]], [[[a]]])
forall a b c. (a -> b, a -> c) -> a -> (b, c)
pair ((a, [[a]]) -> [[a]]
forall {a}. (a, [[a]]) -> [[a]]
new, (a, [[a]]) -> [[[a]]]
forall a. (a, [[a]]) -> [[[a]]]
glues)) ([(a, [[a]])] -> [[[[a]]]])
-> ((a, [[[a]]]) -> [(a, [[a]])]) -> (a, [[[a]]]) -> [[[[a]]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [[[a]]]) -> [(a, [[a]])]
forall a b. (a, [b]) -> [(a, b)]
cpr

adds :: (a, [a]) -> [[a]]
adds :: forall a. (a, [a]) -> [[a]]
adds (a
a, [a]
x) = [[a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
z | ([a]
y, [a]
z) <- [a] -> [([a], [a])]
forall a. [a] -> [([a], [a])]
splits [a]
x]

perms :: [a] -> [[a]]
perms :: forall a. [a] -> [[a]]
perms = ([[a]], (a, [[a]]) -> [[a]]) -> [a] -> [[a]]
forall b a. (b, (a, b) -> b) -> [a] -> b
catalist ([[a]]
forall {a}. [[a]]
e, (a, [[a]]) -> [[a]]
forall {a}. (a, [[a]]) -> [[a]]
f)
  where
    e :: [[a]]
e = [a] -> [[a]]
forall a. a -> [a]
wrap []
    f :: (a, [[a]]) -> [[a]]
f = [[[a]]] -> [[a]]
forall a. [[a]] -> [a]
concat ([[[a]]] -> [[a]])
-> ((a, [[a]]) -> [[[a]]]) -> (a, [[a]]) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [a]) -> [[a]]) -> [(a, [a])] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
list (a, [a]) -> [[a]]
forall a. (a, [a]) -> [[a]]
adds ([(a, [a])] -> [[[a]]])
-> ((a, [[a]]) -> [(a, [a])]) -> (a, [[a]]) -> [[[a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [[a]]) -> [(a, [a])]
forall a b. (a, [b]) -> [(a, b)]
cpr

consl :: (a, ([a], b)) -> ([a], b)
consl :: forall a b. (a, ([a], b)) -> ([a], b)
consl (a
a, ([a]
x, b
y)) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
x, b
y)

consr :: (a, (b, [a])) -> (b, [a])
consr :: forall a b. (a, (b, [a])) -> (b, [a])
consr (a
a, (b
x, [a]
y)) = (b
x, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y)

cup :: ([a], [a]) -> [a]
cup :: forall a. ([a], [a]) -> [a]
cup = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

interleave :: [a] -> [([a], [a])]
interleave :: forall a. [a] -> [([a], [a])]
interleave = ([([a], [a])], (a, [([a], [a])]) -> [([a], [a])])
-> [a] -> [([a], [a])]
forall b a. (b, (a, b) -> b) -> [a] -> b
catalist ([([a], [a])]
forall {a} {a}. [([a], [a])]
e, (a, [([a], [a])]) -> [([a], [a])]
forall {a}. (a, [([a], [a])]) -> [([a], [a])]
f)
  where
    e :: [([a], [a])]
e = ([a], [a]) -> [([a], [a])]
forall a. a -> [a]
wrap ([a], [a])
forall {a} {a}. ([a], [a])
nilp
    f :: (a, [([a], [a])]) -> [([a], [a])]
f = ([([a], [a])], [([a], [a])]) -> [([a], [a])]
forall a. ([a], [a]) -> [a]
cup (([([a], [a])], [([a], [a])]) -> [([a], [a])])
-> ((a, [([a], [a])]) -> ([([a], [a])], [([a], [a])]))
-> (a, [([a], [a])])
-> [([a], [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, ([a], [a]))] -> [([a], [a])],
 [(a, ([a], [a]))] -> [([a], [a])])
-> [(a, ([a], [a]))] -> ([([a], [a])], [([a], [a])])
forall a b c. (a -> b, a -> c) -> a -> (b, c)
pair (((a, ([a], [a])) -> ([a], [a]))
-> [(a, ([a], [a]))] -> [([a], [a])]
forall a b. (a -> b) -> [a] -> [b]
list (a, ([a], [a])) -> ([a], [a])
forall a b. (a, ([a], b)) -> ([a], b)
consl, ((a, ([a], [a])) -> ([a], [a]))
-> [(a, ([a], [a]))] -> [([a], [a])]
forall a b. (a -> b) -> [a] -> [b]
list (a, ([a], [a])) -> ([a], [a])
forall a b. (a, (b, [a])) -> (b, [a])
consr) ([(a, ([a], [a]))] -> ([([a], [a])], [([a], [a])]))
-> ((a, [([a], [a])]) -> [(a, ([a], [a]))])
-> (a, [([a], [a])])
-> ([([a], [a])], [([a], [a])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [([a], [a])]) -> [(a, ([a], [a]))]
forall a b. (a, [b]) -> [(a, b)]
cpr
    nilp :: ([a], [a])
nilp = ([], [])

isEqual :: Eq a => [a] -> [a] -> Bool
[a]
xs isEqual :: forall a. Eq a => [a] -> [a] -> Bool
`isEqual` [a]
ys = [a] -> Bool
forall a. [a] -> Bool
null ([a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
ys) Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
null ([a]
ys [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
xs)

elem :: Eq a => [a] -> [[a]] -> Bool
elem :: forall a. Eq a => [a] -> [[a]] -> Bool
elem [a]
x = (Bool, ([a], Bool) -> Bool) -> [[a]] -> Bool
forall b a. (b, (a, b) -> b) -> [a] -> b
catalist (Bool
e, ([a], Bool) -> Bool
f)
  where
    e :: Bool
e = Bool
False
    f :: ([a], Bool) -> Bool
f ([a]
y, Bool
b) = Bool
b Bool -> Bool -> Bool
|| [a]
y [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isEqual` [a]
x