module Combinatorics (
permute,
permuteFast,
permuteShare,
permuteRep,
choose,
variateRep,
variate,
tuples,
partitions,
rectifications,
setPartitions,
pairPartitions,
chooseUnrank,
chooseUnrankMaybe,
chooseRank,
factorial,
binomial,
binomialSeq,
binomialGen,
binomialSeqGen,
multinomial,
factorials,
binomials,
catalanNumber,
catalanNumbers,
derangementNumber,
derangementNumbers,
setPartitionNumbers,
surjectiveMappingNumber,
surjectiveMappingNumbers,
fibonacciNumber,
fibonacciNumbers,
) where
import qualified PowerSeries
import qualified Combinatorics.Private as Comb
import Data.Function.HT (nest, )
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (mapFst, )
import qualified Data.List.Match as Match
import Data.List.HT (mapAdjacent, removeEach, )
import Data.List (genericIndex, )
import Control.Monad (liftM2, )
permute :: [a] -> [[a]]
permute :: forall a. [a] -> [[a]]
permute = forall a. [a] -> [[a]]
Comb.permuteRec
permuteFast :: [a] -> [[a]]
permuteFast :: forall a. [a] -> [[a]]
permuteFast [a]
x = forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep [] [a]
x []
permuteFastStep :: [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep :: forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep [a]
suffix [] [[a]]
tl = [a]
suffixforall a. a -> [a] -> [a]
:[[a]]
tl
permuteFastStep [a]
suffix [a]
x [[a]]
tl =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[a]
c -> forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep (forall a. [a] -> a
head [a]
c forall a. a -> [a] -> [a]
: [a]
suffix) (forall a. [a] -> [a]
tail [a]
c)) [[a]]
tl (forall a. [a] -> [[a]]
allCycles [a]
x)
permuteShare :: [a] -> [[a]]
permuteShare :: forall a. [a] -> [[a]]
permuteShare [a]
x =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall a. Int -> (a -> a) -> a -> a
nest (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. ([a], [a]) -> [([a], [a])]
permuteShareStep) [([], [a]
x)]
permuteShareStep :: ([a], [a]) -> [([a], [a])]
permuteShareStep :: forall a. ([a], [a]) -> [([a], [a])]
permuteShareStep ([a]
perm,[a]
todo) =
forall a b. (a -> b) -> [a] -> [b]
map
(forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a. a -> [a] -> [a]
:[a]
perm))
(forall a. [a] -> [(a, [a])]
removeEach [a]
todo)
permuteRep :: [(a,Int)] -> [[a]]
permuteRep :: forall a. [(a, Int)] -> [[a]]
permuteRep = forall a. [(a, Int)] -> [[a]]
Comb.permuteRep
choose :: Int -> Int -> [[Bool]]
choose :: Int -> Int -> [[Bool]]
choose = Int -> Int -> [[Bool]]
Comb.chooseRec
variateRep :: Int -> [a] -> [[a]]
variateRep :: forall a. Int -> [a] -> [[a]]
variateRep = forall a. Int -> [a] -> [[a]]
Comb.variateRep
variate :: Int -> [a] -> [[a]]
variate :: forall a. Int -> [a] -> [[a]]
variate = forall a. Int -> [a] -> [[a]]
Comb.variateRec
tuples :: Int -> [a] -> [[a]]
tuples :: forall a. Int -> [a] -> [[a]]
tuples = forall a. Int -> [a] -> [[a]]
Comb.tuplesRec
partitions :: [a] -> [([a],[a])]
partitions :: forall a. [a] -> [([a], [a])]
partitions =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\a
x -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([a]
lxs,[a]
rxs) -> [(a
xforall a. a -> [a] -> [a]
:[a]
lxs,[a]
rxs), ([a]
lxs,a
xforall a. a -> [a] -> [a]
:[a]
rxs)]))
[([],[])]
rectifications :: Int -> [a] -> [[a]]
rectifications :: forall a. Int -> [a] -> [[a]]
rectifications =
let recourse :: [a] -> t -> [a] -> [[a]]
recourse [a]
_ t
0 [a]
xt =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xt
then [[]]
else []
recourse [a]
ys t
n [a]
xt =
let n1 :: t
n1 = forall a. Enum a => a -> a
pred t
n
in forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) [a]
ys ([a] -> t -> [a] -> [[a]]
recourse [a]
ys t
n1 [a]
xt) forall a. [a] -> [a] -> [a]
++
case [a]
xt of
[] -> []
(a
x:[a]
xs) -> forall a b. (a -> b) -> [a] -> [b]
map (a
xforall a. a -> [a] -> [a]
:) ([a] -> t -> [a] -> [[a]]
recourse ([a]
ysforall a. [a] -> [a] -> [a]
++[a
x]) t
n1 [a]
xs)
in forall {t} {a}. (Eq t, Num t, Enum t) => [a] -> t -> [a] -> [[a]]
recourse []
setPartitions :: Int -> [a] -> [[[a]]]
setPartitions :: forall a. Int -> [a] -> [[[a]]]
setPartitions Int
0 [a]
xs =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
then [[]]
else [ ]
setPartitions Int
_ [] = []
setPartitions Int
1 [a]
xs = [[[a]
xs]]
setPartitions Int
k (a
x:[a]
xs) =
do ([a]
rest, [a]
choosen) <- forall a. [a] -> [([a], [a])]
partitions [a]
xs
[[a]]
part <- forall a. Int -> [a] -> [[[a]]]
setPartitions (forall a. Enum a => a -> a
pred Int
k) [a]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
xforall a. a -> [a] -> [a]
:[a]
choosen) forall a. a -> [a] -> [a]
: [[a]]
part)
pairPartitions :: [a] -> [[(a,a)]]
pairPartitions :: forall a. [a] -> [[(a, a)]]
pairPartitions [a]
xs =
if forall a. Integral a => a -> Bool
odd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
then []
else
let go :: [b] -> [[(b, b)]]
go (b
y:[b]
ys) = do
(b
z,[b]
zs) <- forall a. [a] -> [(a, [a])]
removeEach [b]
ys
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b
y,b
z)forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [b] -> [[(b, b)]]
go [b]
zs
go [] = [[]]
in forall a. [a] -> [[(a, a)]]
go [a]
xs
chooseUnrank :: Integral a => a -> a -> a -> [Bool]
chooseUnrank :: forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrank = forall a. Integral a => a -> a -> a -> [Bool]
Comb.chooseUnrankRec
chooseUnrankMaybe :: Int -> Int -> Int -> Maybe [Bool]
chooseUnrankMaybe :: Int -> Int -> Int -> Maybe [Bool]
chooseUnrankMaybe Int
n Int
k Int
i =
forall a. Bool -> a -> Maybe a
toMaybe
(Int
0 forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a -> a -> a
binomial Int
n Int
k)
(forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrank Int
n Int
k Int
i)
chooseRank :: Integral a => [Bool] -> (a, a, a)
chooseRank :: forall a. Integral a => [Bool] -> (a, a, a)
chooseRank =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\(a
n,a
k0,a
i0) ([a]
bins,Bool
b) ->
let (a
k1,a
i1) = if Bool
b then (forall a. Enum a => a -> a
succ a
k0, a
i0 forall a. Num a => a -> a -> a
+ forall i a. Integral i => [a] -> i -> a
genericIndex ([a]
binsforall a. [a] -> [a] -> [a]
++[a
0]) a
k1) else (a
k0,a
i0)
in (forall a. Enum a => a -> a
succ a
n, a
k1, a
i1))
(a
0,a
0,a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. [a] -> [b] -> [(a, b)]
zip forall a. Num a => [[a]]
binomials forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [a] -> [a]
reverse
factorial :: Integral a => a -> a
factorial :: forall a. Integral a => a -> a
factorial a
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
1..a
n]
binomial :: Integral a => a -> a -> a
binomial :: forall a. Integral a => a -> a -> a
binomial = forall a. Integral a => a -> a -> a
Comb.binomial
binomialSeq :: Integral a => a -> [a]
binomialSeq :: forall a. Integral a => a -> [a]
binomialSeq = forall a. Integral a => a -> [a]
Comb.binomialSeq
binomialGen :: (Integral a, Fractional b) => b -> a -> b
binomialGen :: forall a b. (Integral a, Fractional b) => b -> a -> b
binomialGen b
n a
k = forall i a. Integral i => [a] -> i -> a
genericIndex (forall b. Fractional b => b -> [b]
binomialSeqGen b
n) a
k
binomialSeqGen :: (Fractional b) => b -> [b]
binomialSeqGen :: forall b. Fractional b => b -> [b]
binomialSeqGen b
n =
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\b
acc (b
num,b
den) -> b
accforall a. Num a => a -> a -> a
*b
num forall a. Fractional a => a -> a -> a
/ b
den) b
1
(forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract b
1) b
n) (forall a. (a -> a) -> a -> [a]
iterate (b
1forall a. Num a => a -> a -> a
+) b
1))
multinomial :: Integral a => [a] -> a
multinomial :: forall a. Integral a => [a] -> a
multinomial =
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent forall a. Integral a => a -> a -> a
binomial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> [a] -> [a]
scanr1 forall a. Num a => a -> a -> a
(+)
factorials :: Num a => [a]
factorials :: forall a. Num a => [a]
factorials = forall a. Num a => [a]
Comb.factorials
binomials :: Num a => [[a]]
binomials :: forall a. Num a => [[a]]
binomials = forall a. Num a => [[a]]
Comb.binomials
catalanNumber :: Integer -> Integer
catalanNumber :: Integer -> Integer
catalanNumber Integer
n =
case forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Integral a => a -> a -> a
binomial (Integer
2forall a. Num a => a -> a -> a
*Integer
n) Integer
n) (Integer
nforall a. Num a => a -> a -> a
+Integer
1) of
(Integer
c,Integer
0) -> Integer
c
(Integer, Integer)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"catalanNumber: Integer implementation broken"
catalanNumbers :: Num a => [a]
catalanNumbers :: forall a. Num a => [a]
catalanNumbers =
let xs :: [a]
xs = a
1 forall a. a -> [a] -> [a]
: forall a. Num a => [a] -> [a] -> [a]
PowerSeries.mul [a]
xs [a]
xs
in [a]
xs
derangementNumber :: Integer -> Integer
derangementNumber :: Integer -> Integer
derangementNumber Integer
n =
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) ((-Integer
1) forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Integral a => a -> a -> a
mod Integer
n Integer
2) [-Integer
n,Integer
1forall a. Num a => a -> a -> a
-Integer
n..(-Integer
1)])
derangementNumbers :: Num a => [a]
derangementNumbers :: forall a. Num a => [a]
derangementNumbers = forall a. Num a => [a]
Comb.derangementNumbersPS0
setPartitionNumbers :: Num a => [[a]]
setPartitionNumbers :: forall a. Num a => [[a]]
setPartitionNumbers = forall a. Num a => [[a]]
Comb.setPartitionNumbers
surjectiveMappingNumber :: Integer -> Integer -> Integer
surjectiveMappingNumber :: Integer -> Integer -> Integer
surjectiveMappingNumber Integer
n Integer
k =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Num a => a -> a -> a
subtract Integer
0 forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*)
(forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Num a, Integral b) => a -> b -> a
^Integer
n) [Integer
0..])
(forall a. Integral a => a -> [a]
binomialSeq Integer
k)
surjectiveMappingNumbers :: Num a => [[a]]
surjectiveMappingNumbers :: forall a. Num a => [[a]]
surjectiveMappingNumbers = forall a. Num a => [[a]]
Comb.surjectiveMappingNumbersPS
fiboMul ::
(Integer,Integer,Integer) ->
(Integer,Integer,Integer) ->
(Integer,Integer,Integer)
fiboMul :: (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer
f0,Integer
f1,Integer
f2) (Integer
g0,Integer
g1,Integer
g2) =
let h0 :: Integer
h0 = Integer
f0forall a. Num a => a -> a -> a
*Integer
g0 forall a. Num a => a -> a -> a
+ Integer
f1forall a. Num a => a -> a -> a
*Integer
g1
h1 :: Integer
h1 = Integer
f0forall a. Num a => a -> a -> a
*Integer
g1 forall a. Num a => a -> a -> a
+ Integer
f1forall a. Num a => a -> a -> a
*Integer
g2
h2 :: Integer
h2 = Integer
f1forall a. Num a => a -> a -> a
*Integer
g1 forall a. Num a => a -> a -> a
+ Integer
f2forall a. Num a => a -> a -> a
*Integer
g2
in (Integer
h0,Integer
h1,Integer
h2)
fibonacciNumber :: Integer -> Integer
fibonacciNumber :: Integer -> Integer
fibonacciNumber Integer
x =
let aux :: a -> (Integer, Integer, Integer)
aux a
0 = (Integer
1,Integer
0,Integer
1)
aux (-1) = (-Integer
1,Integer
1,Integer
0)
aux a
n =
let (a
m,a
r) = forall a. Integral a => a -> a -> (a, a)
divMod a
n a
2
f :: (Integer, Integer, Integer)
f = a -> (Integer, Integer, Integer)
aux a
m
f2 :: (Integer, Integer, Integer)
f2 = (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer, Integer, Integer)
f (Integer, Integer, Integer)
f
in if a
rforall a. Eq a => a -> a -> Bool
==a
0
then (Integer, Integer, Integer)
f2
else (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer
0,Integer
1,Integer
1) (Integer, Integer, Integer)
f2
(Integer
_,Integer
y,Integer
_) = forall {a}. Integral a => a -> (Integer, Integer, Integer)
aux Integer
x
in Integer
y
fibonacciNumbers :: [Integer]
fibonacciNumbers :: [Integer]
fibonacciNumbers =
let xs :: [Integer]
xs = Integer
0 forall a. a -> [a] -> [a]
: [Integer]
ys
ys :: [Integer]
ys = Integer
1 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Integer]
xs [Integer]
ys
in [Integer]
xs
allCycles :: [a] -> [[a]]
allCycles :: forall a. [a] -> [[a]]
allCycles [a]
x =
forall b a. [b] -> [a] -> [a]
Match.take [a]
x (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. [b] -> [a] -> [a]
Match.take [a]
x) (forall a. (a -> a) -> a -> [a]
iterate forall a. [a] -> [a]
tail (forall a. [a] -> [a]
cycle [a]
x)))