-- | Tuples.

module Math.Combinat.Tuples where

import Math.Combinat.Helper

-------------------------------------------------------
-- Tuples

-- | \"Tuples\" fitting into a give shape. The order is lexicographic, that is,
--
-- > sort ts == ts where ts = tuples' shape
--
--   Example: 
--
-- > tuples' [2,3] = 
-- >   [[0,0],[0,1],[0,2],[0,3],[1,0],[1,1],[1,2],[1,3],[2,0],[2,1],[2,2],[2,3]]
--
tuples' :: [Int] -> [[Int]]
tuples' :: [Int] -> [[Int]]
tuples' [] = [[]]
tuples' (Int
s:[Int]
ss) = [ Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs | Int
x <- [Int
0..Int
s] , [Int]
xs <- [Int] -> [[Int]]
tuples' [Int]
ss ] 

-- | positive \"tuples\" fitting into a give shape.
tuples1' :: [Int] -> [[Int]]
tuples1' :: [Int] -> [[Int]]
tuples1' [] = [[]]
tuples1' (Int
s:[Int]
ss) = [ Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs | Int
x <- [Int
1..Int
s] , [Int]
xs <- [Int] -> [[Int]]
tuples1' [Int]
ss ] 

-- | # = \\prod_i (m_i + 1)
countTuples' :: [Int] -> Integer
countTuples' :: [Int] -> Integer
countTuples' [Int]
shape = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a a. (Integral a, Num a) => a -> a
f [Int]
shape where
  f :: a -> a
f a
k = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a a. (Integral a, Num a) => a -> a
fromIntegral a
k

-- | # = \\prod_i m_i
countTuples1' :: [Int] -> Integer
countTuples1' :: [Int] -> Integer
countTuples1' [Int]
shape = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a a. (Integral a, Num a) => a -> a
fromIntegral [Int]
shape

tuples 
  :: Int    -- ^ length (width)
  -> Int    -- ^ maximum (height)
  -> [[Int]]
tuples :: Int -> Int -> [[Int]]
tuples Int
len Int
k = [Int] -> [[Int]]
tuples' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
len Int
k)

tuples1 
  :: Int    -- ^ length (width)
  -> Int    -- ^ maximum (height)
  -> [[Int]]
tuples1 :: Int -> Int -> [[Int]]
tuples1 Int
len Int
k = [Int] -> [[Int]]
tuples1' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
len Int
k)

-- | # = (m+1) ^ len
countTuples :: Int -> Int -> Integer
countTuples :: Int -> Int -> Integer
countTuples Int
len Int
k = (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a a. (Integral a, Num a) => a -> a
fromIntegral Int
k) Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
len

-- | # = m ^ len
countTuples1 :: Int -> Int -> Integer
countTuples1 :: Int -> Int -> Integer
countTuples1 Int
len Int
k = Int -> Integer
forall a a. (Integral a, Num a) => a -> a
fromIntegral Int
k Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
len

binaryTuples :: Int -> [[Bool]]
binaryTuples :: Int -> [[Bool]]
binaryTuples Int
len = ([Int] -> [Bool]) -> [[Int]] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Bool
intToBool) (Int -> Int -> [[Int]]
tuples Int
len Int
1)

-------------------------------------------------------