module Combinatorics.Permutation.WithoutSomeFixpoints where

import Combinatorics (permute)

{- $setup
>>> import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP
>>> import qualified Combinatorics as Comb
>>> import qualified Test.QuickCheck as QC
>>> import Control.Applicative ((<$>))
>>> import Data.List (nub)
>>>
>>> genPermutationWOFP :: QC.Gen (Int, String)
>>> genPermutationWOFP = do
>>>    xs <- take 6 . nub <$> QC.arbitrary
>>>    k <- QC.choose (0, length xs)
>>>    return (k,xs)
-}


{- |
@enumerate n xs@ list all permutations of @xs@
where the first @n@ elements do not keep their position
(i.e. are no fixpoints).

This is a generalization of derangement.

Naive but comprehensible implementation.
-}
enumerate :: (Eq a) => Int -> [a] -> [[a]]
enumerate :: forall a. Eq a => Int -> [a] -> [[a]]
enumerate Int
k [a]
xs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(/=) [a]
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
k) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
permute [a]
xs

{- | <http://oeis.org/A047920>

prop> QC.forAll genPermutationWOFP $ \(k,xs) -> PermWOFP.numbers !! length xs !! k == length (PermWOFP.enumerate k xs)
prop> QC.forAll (QC.choose (0,100)) $ \k -> Comb.factorial (toInteger k) == PermWOFP.numbers !! k !! 0
prop> QC.forAll (QC.choose (0,100)) $ \k -> Comb.derangementNumber (toInteger k) == PermWOFP.numbers !! k !! k
-}
numbers :: (Num a) => [[a]]
numbers :: forall a. Num a => [[a]]
numbers =
   forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\[a]
row a
fac -> forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) a
fac [a]
row) [] forall a b. (a -> b) -> a -> b
$
   forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) a
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (a
1forall a. Num a => a -> a -> a
+) a
1