module Main (main) where import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP import qualified Combinatorics.Mastermind as Mastermind import qualified Combinatorics.Partitions as Parts import qualified Combinatorics.BellNumbers as Bell import qualified Combinatorics as Comb import qualified Test.QuickCheck as QC import Test.QuickCheck (Testable, quickCheck, ) import Control.Monad (liftM2, replicateM, ) import Control.Applicative ((<$>), ) import qualified Data.List.Match as Match import qualified Data.List.Key as Key import qualified Data.List as List import Data.Tuple.HT (uncurry3, ) import Data.List.HT (allEqual, isAscending, ) import Data.List (sort, nub, ) import Data.Eq.HT (equating, ) permuteSum :: [Int] -> Bool permuteSum xs = sum (map sum (Comb.permute xs)) == sum xs * Comb.factorial (length xs) permute :: Ord a => [a] -> Bool permute xs = allEqual $ map (\p -> sort (p xs)) $ Comb.permute : Comb.permuteFast : Comb.permuteShare : [] genPermuteRep :: QC.Gen [(Char, Int)] genPermuteRep = do xns <- QC.listOf $ liftM2 (,) QC.arbitrary $ QC.choose (0,10) return $ Match.take (takeWhile (<=10) $ scanl1 (+) $ map snd xns) xns permuteRepM :: Eq a => [(a, Int)] -> Bool permuteRepM xs = Comb.permuteRep xs == Comb.permuteRepM xs permuteRepNub :: Eq a => [(a, Int)] -> Bool permuteRepNub xs' = let xs = Key.nub fst xs' perms = Comb.permuteRep xs in perms == nub perms permuteRepMonotony :: Ord a => [(a, Int)] -> Bool permuteRepMonotony = isAscending . Comb.permuteRep . Key.nub fst . sort permuteRepChoose :: Int -> Int -> Bool permuteRepChoose n k = Comb.choose n k == Comb.permuteRep [(False, n-k), (True, k)] chooseLength :: Int -> Int -> Bool chooseLength n k = all (\x -> n == length x && k == length (filter id x)) (Comb.choose n k) genChooseIndex :: QC.Gen (Integer, Integer, Integer) genChooseIndex = do n <- QC.choose (0,25) k <- QC.choose (0,n) i <- QC.choose (0, Comb.binomial n k - 1) return (n,k,i) chooseFromIndex :: Integer -> Integer -> Integer -> Bool chooseFromIndex n k i = Comb.chooseFromIndex n k i == Comb.chooseFromIndexList n k i chooseFromIndexSequence :: Int -> Int -> Bool chooseFromIndexSequence n k = map (Comb.chooseFromIndex n k) [0 .. Comb.binomial n k - 1] == Comb.choose n k chooseToFromIndex :: Integer -> Integer -> Integer -> Bool chooseToFromIndex n k i = Comb.chooseToIndex (Comb.chooseFromIndex n k i) == (n, k, i) chooseFromToIndex :: [Bool] -> Bool chooseFromToIndex bs = uncurry3 Comb.chooseFromIndex (Comb.chooseToIndex bs :: (Integer, Integer, Integer)) == bs genVariate :: QC.Gen [Char] genVariate = take 7 <$> QC.arbitrary variateRepMonad :: Eq a => Int -> [a] -> Bool variateRepMonad n xs = Comb.variateRep n xs == replicateM n xs variatePermute :: Eq a => [a] -> Bool variatePermute xs = Comb.variate (length xs) xs == Comb.permute xs variatePermuteClip :: Eq a => Int -> [a] -> Bool variatePermuteClip n xs = equating (take n) (Comb.variate (length xs) xs) (Comb.permute xs) _setPartitionsMonotony :: Ord a => Int -> [a] -> Bool _setPartitionsMonotony k = isAscending . Comb.setPartitions k . nub . sort rectificationsMonotony :: Ord a => Int -> [a] -> Bool rectificationsMonotony k = isAscending . Comb.rectifications k . nub . sort factorial :: [Char] -> Bool factorial xs = length (Comb.permute xs) == Comb.factorial (length xs) binomial :: [Char] -> Int -> Bool binomial xs k = length (Comb.tuples k xs) == Comb.binomial (length xs) k genBinomial :: QC.Gen (Integer, Integer) genBinomial = do n <- QC.choose (0,100) k <- QC.choose (0,n) return (n,k) binomialFactorial :: Integer -> Integer -> Bool binomialFactorial n k = let (q, r) = divMod (Comb.factorial n) (Comb.factorial k * Comb.factorial (n-k)) in r == 0 && Comb.binomial n k == q binomialChoose :: Int -> Int -> Bool binomialChoose n k = length (Comb.choose n k) == Comb.binomial n k multinomialPermuteRep :: [(Char,Int)] -> Bool multinomialPermuteRep xs = length (Comb.permuteRep xs) == Comb.multinomial (map snd xs) multinomialCommutative :: [Integer] -> Bool multinomialCommutative xs = Comb.multinomial xs == Comb.multinomial (sort xs) setPartitionNumbers :: Int -> [Int] -> Bool setPartitionNumbers k xs = length (Comb.setPartitions k xs) == (Comb.setPartitionNumbers !! length xs ++ repeat 0) !! k rectificationNumbers :: Int -> [Int] -> Bool rectificationNumbers k xs = length (Comb.rectifications k xs) == (Comb.setPartitionNumbers !! k ++ repeat 0) !! length xs surjectiveMappingNumber :: Int -> Bool surjectiveMappingNumber = equalFuncList2 Comb.surjectiveMappingNumber Comb.surjectiveMappingNumbers surjectiveMappingNumbers :: Int -> Bool surjectiveMappingNumbers n = allEqual $ map (take n) $ ( Comb.surjectiveMappingNumbers : Comb.surjectiveMappingNumbersStirling : [] :: [[[Integer]]]) equalFuncList :: (Integer -> Integer) -> [Integer] -> Int -> Bool equalFuncList f xs n = equating (take n) xs (map f $ iterate (1+) 0) factorials :: Int -> Bool factorials = equalFuncList Comb.factorial Comb.factorials equalFuncList2 :: (Integer -> Integer -> Integer) -> [[Integer]] -> Int -> Bool equalFuncList2 f xs n = equating (take n) xs (zipWith (map . f) [0..] $ tail $ List.inits [0..]) binomials :: Int -> Bool binomials = equalFuncList2 Comb.binomial Comb.binomials catalanNumbers :: Int -> Bool catalanNumbers = equalFuncList Comb.catalanNumber Comb.catalanNumbers fibonacciNumbers :: Int -> Bool fibonacciNumbers = equalFuncList Comb.fibonacciNumber Comb.fibonacciNumbers derangementNumber :: Int -> Bool derangementNumber = equalFuncList Comb.derangementNumber Comb.derangementNumbers derangementNumbers :: Int -> Bool derangementNumbers n = allEqual $ map (take n) $ ( Comb.derangementNumbers : Comb.derangementNumbersAlt : Comb.derangementNumbersInclExcl : [] :: [[Integer]]) bellSeries :: Int -> Bool bellSeries = equalFuncList (\k -> round (Bell.bellSeries (fromInteger k) :: Double)) (Bell.bellRec :: [Integer]) genPermutationWOFP :: QC.Gen (Int, String) genPermutationWOFP = do xs <- take 6 . nub <$> QC.arbitrary k <- QC.choose (0, length xs) return (k,xs) permutationWOFP :: Int -> String -> Bool permutationWOFP k xs = PermWOFP.numbers !! length xs !! k == length (PermWOFP.enumerate k xs) permutationWOFPFactorial :: Int -> Bool permutationWOFPFactorial k = Comb.factorial (toInteger k) == PermWOFP.numbers !! k !! 0 permutationWOFPDerangement :: Int -> Bool permutationWOFPDerangement k = Comb.derangementNumber (toInteger k) == PermWOFP.numbers !! k !! k genMastermindDistinct :: QC.Gen (Int, Int, Int, Int) genMastermindDistinct = do n <- QC.choose (0,12) k <- QC.choose (0, min 5 n) b <- QC.choose (0,k) w <- QC.choose (0,k-b) return (n,k,b,w) mastermindDistinct :: Int -> Int -> Int -> Int -> Bool mastermindDistinct n k b w = let alphabet = take n ['a'..] code = take k alphabet in Mastermind.numberDistinct n k b w == (toInteger $ length $ filter ((Mastermind.Eval b w ==) . Mastermind.evaluate code) $ Comb.variate k alphabet) testUnit :: Testable prop => String -> prop -> IO () testUnit label p = putStr (label++": ") >> quickCheck p main :: IO () main = sequence_ $ testUnit "permutation sums" (QC.forAll (take 6 <$> QC.arbitrary) permuteSum) : testUnit "permutations" (QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) permute) : testUnit "permuteRepM" (QC.forAll genPermuteRep permuteRepM) : testUnit "permuteRepNub" (QC.forAll genPermuteRep permuteRepNub) : testUnit "permuteRepMonotony" (QC.forAll genPermuteRep permuteRepMonotony) : testUnit "permuteRepChoose" (QC.forAll (QC.choose (0,10)) permuteRepChoose) : testUnit "chooseLength" (QC.forAll (QC.choose (0,10)) chooseLength) : testUnit "chooseFromIndex" (QC.forAll genChooseIndex $ uncurry3 chooseFromIndex) : testUnit "chooseFromIndexSequence" (QC.forAll (QC.choose (0,10)) chooseFromIndexSequence) : testUnit "chooseToFromIndex" (QC.forAll genChooseIndex $ uncurry3 chooseToFromIndex) : testUnit "chooseFromToIndex" chooseFromToIndex : testUnit "variation with repetitions with list monad" (QC.forAll (QC.choose (0,6)) $ \n -> QC.forAll genVariate $ variateRepMonad n) : testUnit "variatePermute" (QC.forAll genVariate variatePermute) : testUnit "permute expressed by variate" (variatePermuteClip 1000 :: String -> Bool) : testUnit "binomial vs. choose" (QC.forAll (QC.choose (0,12)) binomialChoose) : testUnit "multinomial vs. permutation with repetitions" (QC.forAll genPermuteRep multinomialPermuteRep) : testUnit "multinomial commutative" (QC.forAll (QC.listOf $ QC.choose (0,300)) multinomialCommutative) : testUnit "factorial vs. permute" (QC.forAll (take 8 <$> QC.arbitrary) factorial) : testUnit "binomial vs. tuples" (QC.forAll (take 16 <$> QC.arbitrary) binomial) : testUnit "binomial by factorial" (QC.forAll genBinomial $ uncurry binomialFactorial) : testUnit "factorial vs. factorials" (factorials 1000) : testUnit "binomial vs. binomials" (binomials 100) : testUnit "catalan numbers" (catalanNumbers 1000) : testUnit "fibonacci numbers" (fibonacciNumbers 10000) : testUnit "derangement number" (derangementNumber 1000) : testUnit "derangement numbers" (derangementNumbers 1000) : testUnit "set partition numbers" (QC.forAll (QC.choose (0,10000)) $ \n -> QC.forAll (take 7 <$> QC.arbitrary) $ setPartitionNumbers n) : testUnit "rectification numbers" (QC.forAll (QC.choose (0,7)) $ \n xs -> rectificationNumbers n xs) : testUnit "rectification montony" (QC.forAll (QC.choose (0,7)) $ \n xs -> rectificationsMonotony n (xs::[Int])) : testUnit "surjective mapping number" (surjectiveMappingNumber 20) : testUnit "surjective mapping numbers" (surjectiveMappingNumbers 20) : testUnit "bell series" (bellSeries 20) : testUnit "permutation without some fixpoints" (QC.forAll genPermutationWOFP $ uncurry permutationWOFP) : testUnit "permutation without some fixpoints vs. factorial" (QC.forAll (QC.choose (0,100)) permutationWOFPFactorial) : testUnit "permutation without some fixpoints vs. derangement" (QC.forAll (QC.choose (0,100)) permutationWOFPDerangement) : testUnit "partitions infinite linear factors" (QC.forAll (QC.choose (0,100)) Parts.propInfProdLinearFactors) : testUnit "partitions pentagonal power series" (Parts.propPentagonalPowerSeries 1000) : testUnit "partitions positive pentagonal numbers" (Parts.propPentagonalsDifP 10000) : testUnit "partitions negative pentagonal numbers" (Parts.propPentagonalsDifN 10000) : testUnit "partitions" (QC.forAll (QC.choose (1,10)) $ \k -> QC.forAll (QC.choose (0,50)) $ \n -> Parts.propPartitions k n) : testUnit "partitions count" (Parts.propNumPartitions 30) : testUnit "mastermind with distinct symbols" (QC.forAll genMastermindDistinct $ \(n,k,b,w) -> mastermindDistinct n k b w) : []