module Data.List.Combinatrics where

import qualified Data.List as L

{- |
>>> combinations 2 [1..3]
[[1,2],[1,3],[2,3]]
-}
combinations :: Int -> [a] -> [[a]]
combinations :: forall a. Int -> [a] -> [[a]]
combinations Int
0 [a]
_ = [[]]
combinations Int
1 [a]
xs = (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []) [a]
xs
combinations Int
k (a
x : [a]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinations (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinations Int
k [a]
xs
combinations Int
_ [] = []

{- |
>>> allPairs [1..4]
[(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
>>> allPairs []
[]
-}
allPairs :: [a] -> [(a, a)]
allPairs :: forall a. [a] -> [(a, a)]
allPairs [a]
xs = do
  y : ys <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
xs
  map ((,) y) ys

{- |
>>> choice [1..3]
[(1,[2,3]),(2,[1,3]),(3,[1,2])]
-}
choice :: [a] -> [(a, [a])]
choice :: forall a. [a] -> [(a, [a])]
choice [a]
xs0 = do
  (xs, y : ys) <- [[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [[a]]
forall a. [a] -> [[a]]
L.inits [a]
xs0) ([a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
xs0)
  return (y, xs ++ ys)

{- |
>>> pairPartitions [1..4]
[[(1,2),(3,4)],[(1,3),(2,4)],[(1,4),(2,3)]]
>>> pairPartitions [1..3]
[[(1,2)],[(1,3)],[(2,3)]]
>>> length (pairPartitions[1..16])
2027025
>>> product[1,3..15]
2027025
-}
pairPartitions :: (Eq a) => [a] -> [[(a, a)]]
pairPartitions :: forall a. Eq a => [a] -> [[(a, a)]]
pairPartitions [] = []
pairPartitions [a
_] = []
pairPartitions xxs0 :: [a]
xxs0@(a
_ : [a]
xs0)
  | Int -> Bool
forall a. Integral a => a -> Bool
even Int
n = [a] -> [[(a, a)]]
forall a. Eq a => [a] -> [[(a, a)]]
go [a]
xxs0
  | Bool
otherwise = [a] -> [[(a, a)]]
forall a. Eq a => [a] -> [[(a, a)]]
go [a]
xxs0 [[(a, a)]] -> [[(a, a)]] -> [[(a, a)]]
forall a. Semigroup a => a -> a -> a
<> [a] -> [[(a, a)]]
forall a. Eq a => [a] -> [[(a, a)]]
go [a]
xs0
  where
    n :: Int
n = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xxs0
    go :: [a] -> [[(a, a)]]
go [a
_] = [[]]
    go (a
x : [a]
xs) = do
      y <- [a]
xs
      map ((x, y) :) (go (L.delete y xs))
    go [] = [[]]

{- |
>>> allPartitions [1..3]
[[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,3],[2]],[[1,2,3]]]
>>> length (allPartitions [1..12])
4213597
-}
allPartitions :: (Eq a) => [a] -> [[[a]]]
allPartitions :: forall a. Eq a => [a] -> [[[a]]]
allPartitions [a]
xs0 = [a] -> [[[a]]]
forall a. Eq a => [a] -> [[[a]]]
go [a]
xs0
  where
    go :: [a] -> [[[a]]]
go (a
x : [a]
xs) = do
      ys <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.subsequences [a]
xs
      zs <- go (xs L.\\ ys)
      pure $ (x : ys) : zs
    go [] = [[]]