module Math.Spe
(
Spe
, (.+.), assemble, (.*.), (<*.), prod, ordinalProd, (.^), (<^)
, compose, o , kDiff, diff, ofSize, nonEmpty
, set, one, x, kBal, bal, par, kList, list, cyc, perm, kSubset, subset
) where
import Data.List
infixl 6 .+.
infixl 7 .*.
infixl 7 <*.
infixr 8 .^
infixr 8 <^
type Spe a c = [a] -> [c]
type Splitter a = [a] -> [([a], [a])]
decompose :: Splitter a -> Int -> [a] -> [[[a]]]
decompose _ 0 [] = [[]]
decompose _ 0 _ = []
decompose h k xs = [ b:bs | (b,ys) <- h xs, bs <- decompose h (k1) ys ]
splitL :: Splitter a
splitL [] = [([], [])]
splitL xs@(x:xt) = ([], xs) : [ (x:as, bs) | (as, bs) <- splitL xt ]
splitB :: Splitter a
splitB [] = [([], [])]
splitB (x:xs) = splitB xs >>= \(ys, zs) -> [(x:ys, zs), (ys, x:zs)]
(.+.) :: Spe a b -> Spe a c -> Spe a (Either b c)
(.+.) f g xs = map Left (f xs) ++ map Right (g xs)
assemble :: [Spe a c] -> Spe a c
assemble fs xs = fs >>= \f -> f xs
genericMul :: Splitter a -> Spe a b -> Spe a c -> Spe a (b,c)
genericMul h f g xs = [ (y, z) | (ys, zs) <- h xs, y <- f ys, z <- g zs ]
(.*.) = genericMul splitB
(<*.) = genericMul splitL
genericProd :: Splitter a -> [Spe a b] -> Spe a [b]
genericProd h fs xs =
let n = length fs
in [ zipWith ($) fs bs | bs <- decompose h n xs ] >>= sequence
prod = genericProd splitB
ordinalProd = genericProd splitL
genericPower :: Splitter a -> Spe a b -> Int -> Spe a [b]
genericPower h f k = genericProd h $ replicate k f
(.^) = genericPower splitB
(<^) = genericPower splitL
compose :: Spe [a] b -> Spe a c -> Spe a (b, [c])
compose f g xs = [ (y, ys) | bs <- par xs, y <- f bs, ys <- mapM g bs ]
o = compose
kDiff :: Int -> Spe (Maybe a) b -> Spe a b
kDiff k f xs = f $ replicate k Nothing ++ map Just xs
diff = kDiff 1
isOfLength :: [a] -> Int -> Bool
[] `isOfLength` n = n == 0
(x:xs) `isOfLength` n = n > 0 && xs `isOfLength` (n1)
ofSize :: Spe a c -> Int -> Spe a c
(f `ofSize` n) xs | xs `isOfLength` n = f xs
| otherwise = []
nonEmpty :: Spe a c -> Spe a c
nonEmpty _ [] = []
nonEmpty f xs = f xs
set :: Spe a [a]
set = return
one :: Spe a ()
one xs = [ () | null xs ]
x :: Spe a a
x = id `ofSize` 1
kBal :: Int -> Spe a [[a]]
kBal 0 = \xs -> [ [] | null xs ]
kBal k = nonEmpty set .^ k
bal :: Spe a [[a]]
bal [] = [[]]
bal xs = [ b:bs | (b, ys) <- init (splitB xs), bs <- bal ys ]
par :: Spe a [[a]]
par [] = [[]]
par (x:xs) = [ (x:b) : bs | (b, ys) <- splitB xs, bs <- par ys ]
kList :: Int -> Spe a [a]
kList k = x .^ k
list :: Spe a [a]
list xs = kList (length xs) xs
cyc :: Spe a [a]
cyc [] = []
cyc (x:xs) = map (x:) $ list xs
perm :: Spe a [[a]]
perm = map fst . (set `o` cyc)
kSubset :: Int -> Spe a ([a], [a])
kSubset k = (set `ofSize` k) .*. set
subset :: Spe a [a]
subset = map fst . (set .*. set)