{-# LANGUAGE TupleSections         #-}

module Gradual.Misc where 

import Control.Monad (filterM)

-------------------------------------------------------------------------------
-- | Mapping ------------------------------------------------------------------
-------------------------------------------------------------------------------

mapThd3 :: (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 :: (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 c -> d
f (a
x, b
y, c
z) = (a
x, b
y, c -> d
f c
z)

mapSndM :: Functor m => (b -> m c) -> (a,b) -> m (a, c)
mapSndM :: (b -> m c) -> (a, b) -> m (a, c)
mapSndM b -> m c
f (a
x,b
y) = (a
x,) (c -> (a, c)) -> m c -> m (a, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m c
f b
y


mapMWithLog :: String -> (a -> IO b) -> [a] -> IO [b]
mapMWithLog :: String -> (a -> IO b) -> [a] -> IO [b]
mapMWithLog String
msg a -> IO b
f [a]
xs = Integer -> [a] -> IO [b]
forall t. (Show t, Num t) => t -> [a] -> IO [b]
go Integer
1 [a]
xs 
  where
    n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs 

    go :: t -> [a] -> IO [b]
go t
_ [] = [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go t
i (a
x:[a]
xs) = do 
      String -> IO ()
putStrLn (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]...") 
      b
r  <- a -> IO b
f a
x 
      [b]
rs <- t -> [a] -> IO [b]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1) [a]
xs 
      [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b
rb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
rs)

-------------------------------------------------------------------------------
-- | Powersets ----------------------------------------------------------------
-------------------------------------------------------------------------------

powersetUpTo :: Int -> [a] -> [[a]]
powersetUpTo :: Int -> [a] -> [[a]]
powersetUpTo Int
0 [a]
_  = [] 
powersetUpTo Int
1 [a]
xs = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
powersetUpTo Int
i [a]
xs = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (a -> [Bool]) -> [a] -> [[a]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Bool] -> a -> [Bool]
forall a b. a -> b -> a
const [Bool
False, Bool
True]) [a]
xs

-------------------------------------------------------------------------------
-- | Combining ----------------------------------------------------------------
-------------------------------------------------------------------------------


flatten :: [(k,(i,[v]))] -> [[(k,(i, v))]]
flatten :: [(k, (i, [v]))] -> [[(k, (i, v))]]
flatten [(k, (i, [v]))]
kvs = [[(k, (i, v))]] -> [[(k, (i, v))]]
forall a. [[a]] -> [[a]]
allCombinations ((\(k
k,(i
i,[v]
vs)) -> ((k
k,) ((i, v) -> (k, (i, v))) -> (v -> (i, v)) -> v -> (k, (i, v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i
i,)) (v -> (k, (i, v))) -> [v] -> [(k, (i, v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs)((k, (i, [v])) -> [(k, (i, v))])
-> [(k, (i, [v]))] -> [[(k, (i, v))]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, (i, [v]))]
kvs)

expand :: (a -> [a]) -> [a] -> [[a]]
expand :: (a -> [a]) -> [a] -> [[a]]
expand a -> [a]
f [a]
xs = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
allCombinations (a -> [a]
f (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)

expand2 :: (b -> [b]) -> [(a, b)] -> [[(a,b)]]
expand2 :: (b -> [b]) -> [(a, b)] -> [[(a, b)]]
expand2 b -> [b]
f [(a, b)]
xs = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
x1s ([b] -> [(a, b)]) -> [[b]] -> [[(a, b)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[b]] -> [[b]]
forall a. [[a]] -> [[a]]
allCombinations [[b]]
x2s
  where
    ([a]
x1s,[[b]]
x2s) = [(a, [b])] -> ([a], [[b]])
forall a b. [(a, b)] -> ([a], [b])
unzip ((\(a
x,b
y) -> (a
x,b -> [b]
f b
y)) ((a, b) -> (a, [b])) -> [(a, b)] -> [(a, [b])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
xs)

expand3 :: (c -> [c]) -> [(a,b,c)] -> [[(a,b,c)]]
expand3 :: (c -> [c]) -> [(a, b, c)] -> [[(a, b, c)]]
expand3 c -> [c]
f [(a, b, c)]
xs = [a] -> [b] -> [c] -> [(a, b, c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [a]
x1s [b]
x2s ([c] -> [(a, b, c)]) -> [[c]] -> [[(a, b, c)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[c]] -> [[c]]
forall a. [[a]] -> [[a]]
allCombinations [[c]]
x3s
  where
    ([a]
x1s,[b]
x2s,[[c]]
x3s) = [(a, b, [c])] -> ([a], [b], [[c]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ((\(a
x,b
y,c
z) -> (a
x,b
y,c -> [c]
f c
z)) ((a, b, c) -> (a, b, [c])) -> [(a, b, c)] -> [(a, b, [c])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b, c)]
xs)

{-@ allCombinations :: xss:[[a]] -> [{v:[a]| len v == len xss}] @-}
allCombinations :: [[a]] -> [[a]]
allCombinations :: [[a]] -> [[a]]
allCombinations [[a]]
xs = ([[a]] -> Bool) -> [[a]] -> [[a]]
forall p. (p -> Bool) -> p -> p
assert ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([[a]] -> [Bool]) -> [[a]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((([[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
go [[a]]
xs
  where
   go :: [[a]] -> [[a]]
go []          = [[]]
   go [[]]        = []
   go ([]:[[a]]
_)      = []
   go ((a
x:[a]
xs):[[a]]
ys) = ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [[a]] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a]] -> [[a]]
go [[a]]
ys) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [[a]]
go ([a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys)

   assert :: (p -> Bool) -> p -> p
assert p -> Bool
b p
x = if p -> Bool
b p
x then p
x else String -> p
forall a. HasCallStack => String -> a
error String
"allCombinations: assertion violation"