module Tests.Partitions.Compact where -------------------------------------------------------------------------------- import Data.List hiding ( uncons , singleton ) import Data.Ord import Test.Tasty import Test.Tasty.HUnit as U import Test.Tasty.QuickCheck as Q import qualified Data.Vector.Compact.WordVec as Vec import Math.Combinat.Partitions.Integer.Compact -- import qualified Math.Combinat.Partitions.Integer as P import qualified Math.Combinat.Partitions.Integer.IntList as P -------------------------------------------------------------------------------- main = defaultMain tests tests :: TestTree tests = testGroup "Tests" [properties, unitTests] -------------------------------------------------------------------------------- cmp :: Partition -> Partition -> Ordering cmp (Partition x) (Partition y) = Vec.cmpExtZero x y -------------------------------------------------------------------------------- unitTests :: TestTree unitTests = testGroup "Unit tests" [ testCase "toList . fromList == id /1" $ allTrue [ xs == toList (fromDescList xs) | xs <- _testPartitions ] , testCase "toList . fromList == id /2" $ allTrue [ xs == toList (fromDescList xs) | xs <- _allparts 18 ] , testCase "toAscList . fromList == reverse /1" $ allTrue [ reverse xs == toAscList (fromDescList xs) | xs <- _testPartitions ] , testCase "toAscList . fromList == reverse /2" $ allTrue [ reverse xs == toAscList (fromDescList xs) | xs <- _allparts 18 ] , testCase "fromList . toList == id" $ allTrue [ p == fromDescList (toList p ) | p <- testPartitions ] , testCase "singleton" $ allTrue [ toList (singleton n) == [n] | n <- [1..300] ] , testCase "singleton 0 is empty" $ allTrue [ toList (singleton 0) == [] ] , testCase "uncons empty" $ allTrue [ uncons empty == Nothing ] , testCase "uncons singleton" $ allTrue [ uncons (singleton x) == Just (x,empty) | x <- [1..300] ] , testCase "cons/snoc 0 empty" $ allTrue [ (cons 0 empty) == empty , (snoc empty 0) == empty ] , testCase "cons empty" $ allTrue [ toList (cons n empty) == [n] | n <- [1..300] ] , testCase "snoc empty" $ allTrue [ toList (snoc empty n) == [n] | n <- [1..300] ] , testCase "width/height of empty" $ allTrue [ width empty == 0 , height empty == 0 ] , testCase "width of all " $ allTrue [ length xs == width p | xs <- _testPartitions , let p = fromDescList xs ] , testCase "height of all" $ allTrue [ safeHead xs == height p | xs <- _testPartitions , let p = fromDescList xs ] , testCase "(width,height)" $ allTrue [ widthHeight p == (width p, height p) | p <- testPartitions ] , testCase "tail of all" $ allTrue [ safeTail xs == toList (partitionTail p) | xs <- _testPartitions , let p = fromDescList xs ] , testCase "toList using uncons" $ allTrue [ xs == toListViaUncons p | xs <- _testPartitionsSmall , let p = fromDescList xs ] , testCase "fromList using cons" $ allTrue [ xs == toList (fromListViaCons (DescList xs)) | xs <- _testPartitionsSmall ] , testCase "fromList using snoc" $ allTrue [ xs == toList (fromListViaSnoc (DescList xs)) | xs <- _testPartitionsSmall ] , testCase "reflexivity" $ allTrue [ (fromDescList xs == p) | xs <- _testPartitions , let p = fromDescList xs] , testCase "snoc1" $ allTrue [ toList (snoc p 1) == xs ++ [1] | xs <- _testPartitions , let p = fromDescList xs] , testCase "snocN/2..5" $ allTrue [ toList (snocN n (p,1)) == xs ++ replicate n 1 | xs <- _testPartitions , let p = fromDescList xs , n <- [2..5] ] , testCase "compare/staircase" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | n1<-[0..100] , n2<-[0..100], let xs1 = _staircase n1 , let xs2 = _staircase n2 , let p1 = staircase n1 , let p2 = staircase n2 ] , testCase "compare/slope" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | n1<-[0..100] , n2<-[0..100], let xs1 = _slope n1 , let xs2 = _slope n2 , let p1 = slope n1 , let p2 = slope n2 ] , testCase "compare/steep" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | n1<-[0..100] , n2<-[0..100], let xs1 = _steep n1 , let xs2 = _steep n2 , let p1 = steep n1 , let p2 = steep n2 ] , testCase "compare/small" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | xs1 <- _allparts 12 , xs2 <- _allparts 12 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "compare/15" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | xs1 <- _parts 15 , xs2 <- _parts 15 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "compare/16" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | xs1 <- _parts 16 , xs2 <- _parts 16 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "compare/17" $ allTrue [ compare xs1 xs2 == cmp p1 p2 | xs1 <- _parts 17 , xs2 <- _parts 17 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "ineq/small" $ allTrue [ ineqTestPartition p1 p2 | xs1 <- _allparts 13 , xs2 <- _allparts 13 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "consN 15 / staircase" $ allTrue [ (replicate k 15 ++ xs) == toList (consN k (15,p)) | n<-[0..15] , let xs = _staircase n , let p = fromDescList xs , k <- [1..80] ] , testCase "consN 15 / slope" $ allTrue [ (replicate k 15 ++ xs) == toList (consN k (15,p)) | n<-[0..15] , let xs = _slope n , let p = fromDescList xs , k <- [1..80] ] , testCase "consN 15 / steep" $ allTrue [ (replicate k 15 ++ xs) == toList (consN k (15,p)) | n<-[0..15] , let xs = _steep n , let p = fromDescList xs , k <- [1..40] ] , testCase "consN 16 / staircase" $ allTrue [ (replicate k 16 ++ xs) == toList (consN k (16,p)) | n<-[0..16] , let xs = _staircase n , let p = fromDescList xs , k <- [1..80] ] , testCase "consN 16 / slope" $ allTrue [ (replicate k 16 ++ xs) == toList (consN k (16,p)) | n<-[0..16] , let xs = _slope n , let p = fromDescList xs , k <- [1..80] ] , testCase "consN 16 / steep" $ allTrue [ (replicate k 16 ++ xs) == toList (consN k (16,p)) | n<-[0..16] , let xs = _steep n , let p = fromDescList xs , k <- [1..40] ] , testCase "consN 256 / staircase" $ allTrue [ (replicate k 256 ++ xs) == toList (consN k (256,p)) | n<-[0..40] , let xs = _staircase n , let p = fromDescList xs , k <- [1..40] ] , testCase "consN 256 / slope" $ allTrue [ (replicate k 256 ++ xs) == toList (consN k (256,p)) | n<-[0..40] , let xs = _slope n , let p = fromDescList xs , k <- [1..35] ] , testCase "consN 256 / steep" $ allTrue [ (replicate k 256 ++ xs) == toList (consN k (256,p)) | n<-[0..40] , let xs = _steep n , let p = fromDescList xs , k <- [1..35] ] , testCase "diffSequence" $ allTrue [ diffSequence p == refDiffSeq xs | xs <- _testPartitions , let p = fromDescList xs ] , testCase "reverseDiffSequence" $ allTrue [ reverseDiffSequence p == reverse (refDiffSeq xs) | xs <- _testPartitions , let p = fromDescList xs ] , testCase "dual . dual == id" $ allTrue [ dualPartition (dualPartition p) == p | p <- testPartitions ] , testCase "dual == reference impl." $ allTrue [ toList (dualPartition p) == P._dualPartition xs | xs <- _testPartitions , let p = fromDescList xs ] , testCase "toExponentialForm" $ allTrue [ toExponentialForm p == P._toExponentialForm xs | xs <- _testPartitions , let p = fromDescList xs ] , testCase "fromExponentialForm" $ allTrue [ toList (fromExponentialForm ef) == xs | xs <- _testPartitions , let p = fromDescList xs , let ef = P._toExponentialForm xs ] , testCase "to / from expo. form" $ allTrue [ toList (fromExponentialForm $ toExponentialForm p) == xs | xs <- _testPartitions , let p = fromDescList xs ] , testCase "isSubPartitionOf/small" $ allTrue [ P._isSubPartitionOf xs1 xs2 == isSubPartitionOf p1 p2 | xs1 <- _allparts 12 , xs2 <- _allparts 12 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "isSubPartitionOf/15" $ allTrue [ P._isSubPartitionOf xs1 xs2 == isSubPartitionOf p1 p2 | xs1 <- _parts 15 , xs2 <- _parts 15 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "isSubPartitionOf/16" $ allTrue [ P._isSubPartitionOf xs1 xs2 == isSubPartitionOf p1 p2 | xs1 <- _parts 16 , xs2 <- _parts 16 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "isSubPartitionOf/17" $ allTrue [ P._isSubPartitionOf xs1 xs2 == isSubPartitionOf p1 p2 | xs1 <- _parts 17 , xs2 <- _parts 17 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "dominates/small" $ allTrue [ P._dominates xs1 xs2 == dominates p1 p2 | xs1 <- _allparts 12 , xs2 <- _allparts 12 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "dominates/15" $ allTrue [ P._dominates xs1 xs2 == dominates p1 p2 | xs1 <- _parts 15 , xs2 <- _parts 15 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "dominates/16" $ allTrue [ P._dominates xs1 xs2 == dominates p1 p2 | xs1 <- _parts 16 , xs2 <- _parts 16 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] , testCase "dominates/17" $ allTrue [ P._dominates xs1 xs2 == dominates p1 p2 | xs1 <- _parts 17 , xs2 <- _parts 17 , let p1 = fromDescList xs1 , let p2 = fromDescList xs2 ] -- , testCase "pieriRuleSingleBox" $ allTrue [ pieriRuleSingleBox p =%%= map fromDescList (P._pieriRule xs 1) | xs <- _testPartitions , let p = fromDescList xs ] , testCase "pieriRule" $ allTrue [ pieriRule p k =%%= map fromDescList (P._pieriRule xs k) | xs <- every10th _testPartitionsSmall , let p = fromDescList xs , k <- [1..2] ] ] -------------------------------------------------------------------------------- properties :: TestTree properties = localOption (QuickCheckTests 1000) -- 200 $ testGroup "Properties" [ prop "toList . fromList == id" $ \(DescList xs) -> (toList (fromDescList xs) == xs) , prop "toAscList . fromList == reverse" $ \(DescList xs) -> (toAscList (fromDescList xs) == reverse xs) , prop "snoc1/list" $ \(DescList xs) -> toList (snoc (fromDescList xs) 1) == xs ++ [1] , prop "snocN/list" $ \(DescList xs) (SmallN n) -> toList (snocN n (fromDescList xs,1)) == xs ++ replicate n 1 , prop "fromList . toList == id" $ \p -> (fromDescList (toList p ) == p ) , prop "compare" $ \p q -> cmp p q == compare (toList p) (toList q) , prop "uncons" $ \p -> (unconsTest p) == unconsList (toList p) , prop "width" $ \p -> width p == length (toList p) , prop "height" $ \p -> height p == safeHead (toList p) , prop "(width,height)" $ \p -> let xs = toList p in widthHeight p == (length xs, safeHead xs) , prop "snoc1" $ \p -> toList (snoc p 1) == toList p ++ [1] , prop "snocN" $ \p (SmallN n) -> toList (snocN n (p,1)) == toList p ++ replicate n 1 , prop "cons/head" $ \p -> let a = max 1 (height p) in toList (cons a p) == a : toList p , prop "cons/head+1" $ \p -> let a = height p + 1 in toList (cons a p) == a : toList p , prop "cons/head+k" $ \p (SmallN k) -> let a = height p + k in toList (cons a p) == a : toList p , prop "consN/head" $ \p (SmallN n) -> let a = max 1 (height p) in toList (consN n (a,p)) == replicate n a ++ toList p , prop "consN/head+1" $ \p (SmallN n) -> let a = height p + 1 in toList (consN n (a,p)) == replicate n a ++ toList p , prop "consN/head+k" $ \p (SmallN n) (SmallN k) -> let a = height p + k in toList (consN n (a,p)) == replicate n a ++ toList p , prop "tailN" $ \p (SmallN n) -> toList (tailN n p) == drop n (toList p) , prop "isEmpty of tail length " $ \p -> isEmpty (tailN (width p ) p) , prop "isEmpty of tail length-1" $ \p -> width p == 0 || not (isEmpty (tailN (width p - 1) p)) , prop "toList using uncons" $ \p -> toList p == toListViaUncons p , prop "fromList using cons" $ \dlist@(DescList xs) -> fromDescList xs == fromListViaCons dlist , prop "fromList using snoc" $ \dlist@(DescList xs) -> fromDescList xs == fromListViaSnoc dlist , prop "cmp a b vs. cmp b a" $ \p q -> cmp p q == reverseOrdering (cmp q p) , prop "ineq" $ \p q -> ineqTestPartition p q , prop "diffSequence" $ \p -> diffSequence p == refDiffSeq (toList p) , prop "reverseDiffSequence" $ \p -> reverseDiffSequence p == reverse (refDiffSeq (toList p)) , prop "dual . dual == id" $ \p -> dualPartition (dualPartition p) == p , prop "dual = reference impl." $ \p -> toList (dualPartition p) == P._dualPartition (toList p) , prop "fromExpo . toExpo == id" $ \p -> fromExponentialForm (toExponentialForm p) == p , prop "isSubPartitionOf" $ \p q -> isSubPartitionOf p q == P._isSubPartitionOf (toList p) (toList q) , prop "dominates" $ \p q -> dominates p q == P._dominates (toList p) (toList q) -- , prop "pieriRuleSingleBox" $ \p -> map toList (pieriRuleSingleBox p) =%%= P._pieriRule (toList p) 1 , localOption (QuickCheckTests 100) $ prop "pieriRule /1" $ \p (PieriK k) -> map toList (pieriRule p k) =%%= P._pieriRule (toList p) k , localOption (QuickCheckTests 100) $ prop "pieriRule /2" $ \p (PieriK k) -> (pieriRule p k) =%%= map fromDescList (P._pieriRule (toList p) k) ] ineqTestPartition :: Partition -> Partition -> Bool ineqTestPartition = ineqTest -------------------------------------------------------------------------------- ineqTest :: Ord a => a -> a -> Bool ineqTest a b = case (ab) of (True ,False,False) -> True (False,True ,False) -> True (False,False,True ) -> True _ -> False every10th :: [a] -> [a] every10th = everyNth 10 everyNth :: Int -> [a] -> [a] everyNth k = go where go [] = [] go (x:xs) = x : drop (k-1) xs infix 4 =%%= (=%%=) :: Ord a => [a] -> [a] -> Bool (=%%=) xs ys = (sort xs == sort ys) allTrue :: [Bool] -> Assertion allTrue bools = (and bools @=? True) prop :: Testable a => TestName -> a -> TestTree prop = Q.testProperty (<#>) :: (a -> c) -> (b -> d) -> (a,b) -> (c,d) (<#>) f g (x,y) = (f x, g y) reverseOrdering :: Ordering -> Ordering reverseOrdering ord = case ord of LT -> GT GT -> LT EQ -> EQ -------------------------------------------------------------------------------- newtype SmallN = SmallN Int deriving (Eq,Ord,Show) instance Arbitrary SmallN where arbitrary = SmallN <$> choose (1,80) newtype PieriK = PieriK Int deriving (Eq,Ord,Show) instance Arbitrary PieriK where arbitrary = PieriK <$> choose (1,3) newtype DescList = DescList [Int] deriving (Eq,Ord,Show) instance Arbitrary DescList where arbitrary = (DescList . reverse . sort . map getPositive) <$> arbitrary instance Arbitrary Partition where arbitrary = do DescList xs <- arbitrary return $ fromDescList xs -------------------------------------------------------------------------------- _allparts n = P._allPartitions n _parts n = P._partitions n _staircase n = [n,n-1..1] _rectangle h n = replicate n h _slope n = concatMap (\x->[x,x]) [n,n-1..1] _slope1 n = concatMap (\x->[x,x]) [n,n-1..1] ++ [1] _slope2 n = (n+1) : concatMap (\x->[x,x]) [n,n-1..1] _slope3 n = (n+1) : concatMap (\x->[x,x]) [n,n-1..1] ++ [1] _steep n = [n,n-2..1] -------------------------------------------------------------------------------- allparts = map fromDescList . _allparts parts = map fromDescList . _parts staircase n = fromDescList $ _staircase n rectangle h n = fromDescList $ _rectangle h n slope n = fromDescList $ _slope n steep n = fromDescList $ _steep n -------------------------------------------------------------------------------- testPartitionsSmall = map fromDescList _testPartitionsSmall testPartitions = map fromDescList _testPartitions _testPartitionsSmall = concat [ _allparts 25 , [ _rectangle 1 n | n <- [1..75] ] , [ _rectangle 15 n | n <- [1..75] ] , [ _rectangle 16 n | n <- [1..75] ] , [ _rectangle 255 n | n <- [1..75] ] , [ _rectangle 256 n | n <- [1..75] ] , [ _staircase n | n <- [1..75] ] , [ _slope n | n <- [1..75] ] , [ _slope1 n | n <- [1..75] ] , [ _slope2 n | n <- [1..75] ] , [ _slope3 n | n <- [1..75] ] , [ _steep n | n <- [1..75] ] , [ _staircase n | n <- [200,255,256,257,258] ] ] _testPartitions = _testPartitionsSmall ++ _testPartRandom _testPartRandom = concat [ [ drop n seq | seq <- randomSequences , n<-[0..79] ] , [ take n seq | seq <- randomSequences , n<-[0..79] ] ] -------------------------------------------------------------------------------- -- * reference snocN :: Int -> (Partition,Int) -> Partition snocN n (p,x) | n <= 0 = p | otherwise = snocN (n-1) (snoc p x, x) consN :: Int -> (Int,Partition) -> Partition consN n (x,p) | n <= 0 = p | otherwise = consN (n-1) (x, cons x p) tailN :: Int -> Partition -> Partition tailN n p | n <= 0 = p | otherwise = tailN (n-1) (partitionTail p) unconsTest :: Partition -> Maybe (Int,[Int]) unconsTest xs = case uncons xs of Nothing -> Nothing Just (x,p) -> Just (x, toList p) unconsList :: [Int] -> Maybe (Int,[Int]) unconsList xs = case xs of [] -> Nothing (x:xs) -> Just (x,xs) safeHead :: [Int] -> Int safeHead xs = case xs of [] -> 0 (x:xs) -> x refDiffSeq :: [Int] -> [Int] refDiffSeq = go where go (x:ys@(y:_)) = (x-y) : go ys go [x] = [x] go [] = [] -------------------------------------------------------------------------------- toListViaUncons :: Partition -> [Int] toListViaUncons = go where go p = case uncons p of Nothing -> [] Just (x,p) -> x : go p fromListViaCons :: DescList -> Partition fromListViaCons (DescList list) = go list where go xs = case xs of [] -> empty (x:xs) -> cons x (go xs) fromListViaSnoc :: DescList -> Partition fromListViaSnoc (DescList list) = go (reverse list) where go xs = case xs of [] -> empty (x:xs) -> snoc (go xs) x -------------------------------------------------------------------------------- {- -- generated by: import Data.List ; import Control.Monad ; import System.Random genseq = (reverse . sort) <$> (replicateM 80 $ randomRIO (1::Int,255)) main = do seqs <- replicateM 64 genseq writeFile "rnd.txt" $ unlines $ map show seqs -} randomSequences = [ [255,255,251,249,245,239,238,235,233,232,224,222,214,214,213,209,202,197,197,194,193,189,181,168,165,164,164,162,156,152,152,152,151,148,147,142,136,132,130,127,124,123,120,119,117,115,112,112,107,105,90,84,81,75,74,69,64,57,56,55,53,49,48,47,44,43,39,38,31,20,19,18,18,17,17,15,14,10,9,7] , [252,246,241,240,238,233,232,230,229,228,227,221,219,214,212,212,204,203,201,195,192,192,188,186,186,182,180,179,176,174,170,166,162,162,153,149,147,141,140,140,139,139,135,133,128,127,126,126,125,125,124,124,114,114,113,112,108,102,94,91,82,82,80,73,71,67,57,56,51,41,36,34,24,22,18,9,8,7,1,1] , [255,254,250,250,248,247,245,243,239,236,223,217,215,209,208,205,203,200,199,198,196,194,191,187,184,174,174,172,164,161,159,158,157,153,152,150,149,149,144,135,133,128,127,122,119,119,118,115,115,113,111,103,98,91,88,86,86,74,72,72,67,65,65,56,55,52,51,49,48,38,38,37,34,32,20,17,14,13,8,1] , [249,224,224,218,210,206,204,196,193,189,188,188,182,177,174,174,173,173,170,163,151,151,150,147,147,145,142,139,138,134,132,129,126,124,123,121,120,113,112,112,112,109,109,108,106,103,98,89,89,85,85,85,82,82,82,79,75,72,70,66,64,63,56,56,47,45,45,42,27,24,22,20,20,19,16,13,4,4,1,1] , [255,254,252,247,246,240,238,233,232,227,226,225,223,213,213,212,209,203,200,195,194,193,193,188,188,185,182,180,175,172,171,170,166,161,158,154,150,146,146,144,142,140,133,131,128,125,119,118,117,115,114,110,109,103,96,91,89,88,81,76,74,59,57,46,37,32,31,24,24,23,16,12,12,9,8,6,6,6,5,2] , [253,248,241,234,230,228,226,225,224,222,220,219,217,213,212,207,200,196,183,179,179,173,173,165,162,157,154,147,147,142,137,136,135,134,134,132,128,127,118,113,106,105,104,104,102,94,90,89,81,77,73,68,65,63,63,59,56,54,46,45,44,40,32,32,31,28,26,26,25,22,21,21,16,13,12,11,11,10,5,3] , [253,253,253,252,252,246,245,243,241,236,235,234,232,227,224,222,219,210,209,205,200,198,198,195,194,194,188,184,177,175,171,170,169,167,163,162,162,155,138,138,131,125,119,114,106,99,97,95,87,85,85,83,79,71,71,69,65,57,56,49,46,40,37,33,31,29,28,24,23,16,16,16,15,13,12,11,8,8,4,2] , [254,252,252,248,233,231,230,228,225,224,218,194,190,190,186,184,177,177,176,171,170,166,165,164,151,149,147,143,136,134,134,133,128,124,122,121,115,114,107,106,105,101,100,98,94,92,92,91,86,84,81,80,76,76,74,71,70,67,67,67,65,58,54,54,53,53,52,52,48,46,46,43,41,37,36,24,19,14,12,7] , [255,254,253,251,249,248,248,245,242,236,231,224,221,214,212,205,203,198,195,194,194,190,184,183,183,178,175,163,154,154,149,148,147,145,144,136,134,127,120,117,115,113,112,109,107,107,104,102,91,86,86,84,83,81,81,80,78,77,76,74,73,69,58,57,55,46,39,39,39,38,37,33,32,31,29,27,21,21,15,8] , [253,252,252,252,247,242,236,227,227,224,218,214,213,211,209,207,203,202,198,196,191,189,183,183,176,170,169,168,166,164,163,159,157,157,151,145,138,133,130,128,123,119,112,111,109,106,105,101,100,99,96,94,91,76,74,69,69,69,66,66,65,64,61,60,59,45,44,43,41,39,30,28,26,24,21,16,11,6,1,1] , [254,253,250,248,238,236,235,232,231,228,228,216,213,213,211,210,207,205,201,200,198,187,182,180,180,178,175,171,168,159,157,157,152,150,143,139,138,138,133,124,123,122,120,120,118,117,115,114,112,111,111,105,105,98,92,92,86,83,80,78,76,70,69,66,65,57,55,54,45,41,36,36,34,21,20,19,12,6,5,3] , [252,252,250,249,245,239,229,228,223,218,211,210,207,204,202,201,200,197,189,187,185,181,180,177,175,173,170,168,159,158,158,156,152,145,140,140,137,135,134,133,132,111,108,105,100,97,91,90,89,83,79,78,76,68,67,66,61,58,57,56,50,48,48,47,41,37,33,33,27,27,26,14,13,10,9,9,8,8,8,5] , [255,255,246,238,236,235,231,227,226,224,217,214,214,207,204,203,200,200,198,196,191,189,189,187,185,181,179,177,173,172,167,164,164,163,159,154,149,149,143,142,140,136,135,135,126,125,120,112,112,101,100,98,96,96,93,92,89,89,80,79,77,76,76,56,50,48,41,41,40,37,32,29,21,19,19,19,17,11,7,4] , [248,246,242,237,235,233,233,232,231,229,229,227,222,222,214,213,208,204,203,199,197,194,192,192,192,190,189,184,183,179,175,175,174,173,171,166,162,160,155,155,153,149,146,145,144,137,127,119,103,100,99,99,96,95,93,87,86,86,84,82,80,80,79,74,66,65,63,59,57,49,47,45,39,32,31,29,25,13,9,3] , [252,251,246,243,236,232,228,226,225,217,214,212,206,204,202,201,198,195,194,193,189,187,184,181,177,170,170,165,164,161,157,156,156,145,142,138,136,136,129,128,118,117,116,115,106,97,96,96,96,94,88,84,84,83,83,78,76,75,74,71,70,67,67,64,54,51,47,37,34,31,26,19,14,10,9,9,6,5,3,1] , [254,253,247,245,244,244,241,240,237,234,234,233,231,222,217,205,202,199,196,195,192,192,190,184,181,180,179,166,166,162,161,160,157,156,155,149,140,137,134,130,130,129,122,122,111,109,101,100,98,96,96,90,84,83,83,81,74,69,68,64,54,51,51,50,41,41,37,36,34,30,23,21,20,20,16,12,9,5,4,2] , [247,241,241,240,240,237,236,231,230,222,216,206,202,201,200,187,185,179,174,170,169,168,165,160,158,155,154,153,147,145,140,137,136,133,132,132,116,111,108,100,98,94,92,90,89,87,87,87,87,84,77,74,74,71,71,70,67,65,63,58,57,56,49,48,47,46,43,43,42,38,37,33,26,19,17,17,17,11,6,3] , [253,250,250,248,246,244,235,229,228,225,223,222,219,219,218,218,217,217,214,213,212,210,210,208,206,197,194,190,184,181,179,173,171,169,164,162,159,143,133,132,130,114,112,107,107,106,105,100,88,87,86,85,83,79,78,78,78,78,66,64,62,61,61,52,49,35,31,28,25,24,22,21,20,18,18,16,15,8,2,1] , [252,243,243,234,232,231,219,219,218,210,208,194,193,191,186,184,181,178,172,171,169,168,162,154,148,148,144,143,131,129,126,125,121,119,115,114,111,106,103,101,99,97,92,88,84,82,79,74,71,66,66,63,58,47,47,47,44,43,42,41,39,38,33,33,32,31,29,29,27,24,24,20,20,19,17,16,15,13,11,9] , [255,255,245,240,240,236,236,236,236,234,232,227,225,221,218,214,213,207,206,199,192,190,190,186,181,176,168,167,165,164,162,162,156,155,155,151,150,149,143,143,143,142,139,136,136,132,131,130,125,121,121,120,117,100,95,88,88,88,87,82,81,73,70,67,66,64,57,54,46,44,41,35,30,30,19,15,13,12,9,6] , [254,252,249,249,248,247,247,241,239,232,231,228,224,220,214,214,213,206,202,200,198,195,194,192,185,184,183,180,179,176,157,149,144,142,138,138,136,132,130,125,123,123,123,117,117,117,113,112,105,103,97,84,82,79,78,72,71,67,61,57,53,53,52,51,44,41,36,34,30,28,27,27,26,23,22,21,13,5,5,3] , [253,250,243,239,235,228,228,225,218,217,217,211,209,209,206,202,199,196,188,185,181,179,178,174,173,172,170,170,168,166,153,153,149,146,146,145,143,139,138,122,118,117,110,109,107,106,98,95,93,88,86,85,83,77,68,66,63,62,62,62,59,55,50,49,48,47,47,47,41,35,34,33,32,26,24,16,15,12,11,9] , [254,252,248,245,244,243,238,238,238,232,231,227,225,220,219,218,217,216,214,211,211,209,207,205,204,203,201,200,195,193,186,180,178,174,173,173,170,170,165,157,151,150,148,140,134,123,116,109,105,105,105,96,95,94,91,89,86,81,76,73,71,57,53,50,47,47,47,47,46,45,42,38,34,27,25,19,17,14,7,7] , [253,250,246,245,241,241,239,238,235,231,230,230,223,213,205,199,199,198,197,195,193,190,187,184,184,175,174,173,172,170,169,168,167,165,163,154,152,140,140,139,134,131,130,128,126,119,118,112,112,101,95,94,94,91,88,86,86,83,76,75,75,75,70,58,58,57,49,46,42,41,41,34,33,32,31,29,28,17,16,7] , [253,253,251,246,246,240,232,228,225,223,218,218,212,211,210,202,197,192,192,192,192,189,186,186,182,180,177,168,163,163,158,155,150,149,141,134,130,130,130,126,118,115,115,110,103,103,103,92,90,85,81,79,75,70,69,69,54,54,51,49,47,44,42,38,35,35,30,27,18,13,11,11,10,8,7,6,4,3,3,3] , [254,251,242,239,238,233,230,227,225,225,215,215,212,209,207,205,205,203,195,195,189,187,187,187,186,182,175,172,171,169,165,160,158,157,157,149,148,143,143,142,142,136,132,129,120,119,117,112,111,110,108,107,100,99,93,91,88,88,86,80,80,77,76,73,70,70,69,67,62,60,51,49,29,25,19,18,16,9,8,1] , [251,250,250,249,239,238,233,233,227,227,224,222,221,220,220,218,212,203,199,199,195,193,193,189,186,182,176,175,168,163,162,147,145,145,139,138,136,130,128,128,126,124,122,114,109,106,99,98,90,87,87,83,82,76,72,71,68,65,64,63,62,62,59,56,55,46,41,40,35,31,29,29,28,14,13,10,10,8,7,6] , [250,245,239,237,235,235,232,231,224,224,222,219,218,215,211,206,191,190,190,188,179,177,173,170,169,167,166,162,162,160,159,158,155,145,142,140,140,135,131,129,121,116,116,108,106,102,101,96,95,91,89,88,84,80,77,75,70,70,68,60,58,55,54,52,49,44,43,42,39,36,33,32,32,29,23,21,18,17,14,11] , [254,254,250,247,241,241,239,232,230,223,221,217,214,200,197,196,194,194,188,185,184,183,183,174,172,171,168,164,164,158,148,146,144,141,133,131,126,125,124,124,123,122,120,114,113,111,110,106,104,104,99,99,92,88,84,74,71,70,67,66,66,59,57,56,55,52,51,50,44,41,39,37,32,29,28,27,25,9,6,3] , [248,243,241,232,227,226,225,225,220,218,218,218,214,211,206,203,201,198,196,195,190,189,186,175,174,163,155,150,146,142,141,139,137,136,135,135,133,126,123,118,118,113,110,108,107,106,105,102,102,102,101,100,100,99,96,95,95,91,87,84,80,79,74,73,73,72,60,55,54,54,52,49,44,38,20,19,19,18,14,5] , [255,253,253,250,249,245,243,242,239,237,233,233,224,224,222,219,218,210,208,204,192,180,176,168,164,160,160,158,156,155,154,151,150,149,149,142,141,139,138,131,129,126,123,123,114,114,110,110,110,103,99,98,92,92,88,88,87,85,81,79,76,72,67,65,63,63,62,59,57,52,51,50,46,44,41,36,23,15,7,1] , [251,248,246,243,236,235,230,227,226,224,221,219,218,216,215,214,214,207,204,202,202,196,192,186,181,179,179,178,176,175,174,169,164,152,149,147,144,139,136,135,134,134,129,125,123,114,105,102,99,89,84,84,81,80,78,75,62,62,59,59,58,58,57,56,55,54,45,38,35,30,29,22,22,16,15,13,11,7,6,4] , [255,254,253,243,241,230,230,228,228,227,225,223,223,213,213,205,204,203,198,192,192,190,186,180,180,177,177,174,173,161,156,155,134,127,125,123,120,111,108,102,100,100,97,89,86,80,78,76,75,74,74,74,71,71,70,70,66,66,62,60,59,56,49,47,44,42,38,35,30,30,17,17,17,15,13,13,9,9,6,3] , [255,251,249,245,239,239,237,235,230,229,225,224,221,219,213,211,209,207,204,201,194,194,190,186,185,185,183,171,168,166,164,160,159,153,148,140,137,136,133,128,125,121,121,121,118,112,112,109,108,108,106,100,95,94,90,88,88,87,85,84,81,70,68,67,67,66,56,48,43,38,36,35,33,32,32,24,22,19,17,5] , [252,252,252,249,245,243,240,236,228,227,224,222,222,216,212,209,206,204,201,192,191,190,185,179,173,172,169,169,165,162,158,158,149,148,147,140,133,128,124,122,122,121,116,115,114,108,103,102,101,98,97,93,93,92,88,87,86,86,78,69,64,63,57,52,45,43,37,35,34,31,26,22,21,18,16,13,9,5,3,2] , [254,254,251,248,248,247,245,235,223,222,207,207,206,204,197,194,192,188,184,182,180,178,175,175,173,167,167,165,164,163,163,160,157,155,150,144,141,138,135,131,125,124,121,114,109,101,99,96,91,90,88,85,79,76,67,66,65,59,57,57,57,53,47,34,32,27,26,26,24,22,20,18,18,10,6,5,4,3,2,1] , [254,253,250,249,241,240,239,238,234,233,230,229,226,226,226,225,222,219,218,212,207,207,202,199,196,194,189,189,188,184,175,170,166,165,161,160,158,157,154,136,132,128,125,124,122,119,118,116,112,108,108,104,94,91,90,86,80,78,76,72,72,69,58,57,56,52,52,45,44,41,34,27,26,24,18,12,11,5,3,3] , [251,245,242,240,237,236,234,227,226,225,225,225,224,223,221,219,209,206,206,206,200,200,198,197,195,195,195,194,192,190,189,186,180,172,169,163,161,155,150,150,148,146,145,135,135,128,120,118,116,113,112,108,108,105,103,102,102,94,92,86,82,80,76,72,61,61,54,52,52,49,46,42,38,34,31,30,26,24,16,14] , [255,254,246,245,242,241,239,236,234,233,231,229,227,226,219,217,217,216,214,213,212,205,203,197,195,194,192,191,186,182,179,166,160,158,157,156,156,148,146,138,133,131,129,119,113,112,111,108,107,106,105,103,101,97,86,86,78,77,77,74,63,61,59,55,47,45,45,40,39,36,35,33,31,26,24,18,17,15,11,8] , [255,245,245,244,240,239,233,232,228,227,225,224,217,211,211,209,206,205,203,201,200,198,197,192,187,174,172,161,161,157,153,152,151,146,146,145,144,142,139,135,131,128,127,123,121,114,113,112,110,97,90,87,85,82,78,78,78,76,75,70,69,69,68,68,66,56,49,45,45,43,43,34,34,33,32,27,26,19,15,7] , [252,246,244,234,223,218,218,217,215,209,206,202,201,198,197,196,196,192,190,183,179,178,176,176,172,163,162,162,159,153,150,149,142,141,134,134,133,128,127,117,114,112,110,109,108,105,102,97,92,87,84,79,77,75,74,71,70,66,65,56,56,53,53,50,44,36,36,33,27,22,20,14,10,9,9,8,7,5,4,1] , [254,252,251,251,250,248,247,238,235,235,231,227,225,216,212,212,208,193,189,188,186,179,162,160,158,157,156,150,148,148,141,141,140,134,133,133,131,123,118,116,112,109,106,106,106,106,94,91,88,86,84,80,79,72,71,71,61,56,55,53,49,43,40,36,33,33,29,29,29,22,21,18,16,11,11,8,7,4,4,4] , [254,250,248,246,238,238,237,237,229,225,225,224,221,220,216,216,214,212,210,209,208,197,193,192,181,181,179,170,168,166,161,159,156,156,148,146,139,127,125,125,124,120,115,113,109,101,96,85,82,81,77,71,71,67,65,59,59,57,51,51,48,47,46,45,45,44,43,43,41,38,36,31,24,24,11,9,8,7,4,3] , [252,237,235,230,228,223,221,220,209,206,206,203,200,195,191,189,185,176,174,168,166,166,159,159,159,156,155,151,149,146,146,143,143,138,137,131,129,120,118,117,116,115,111,108,105,104,103,102,98,98,97,96,95,91,85,70,62,60,55,54,54,47,45,38,37,35,26,25,25,21,18,17,14,12,12,11,10,6,4,3] , [247,247,247,245,238,234,234,230,229,227,225,224,223,221,219,215,209,207,206,204,202,200,199,199,193,185,184,182,181,174,171,171,166,162,162,158,156,155,153,151,148,145,136,134,132,122,116,115,111,106,104,97,95,94,93,89,82,73,70,63,63,60,56,51,47,47,45,42,40,39,38,33,31,29,24,18,18,18,12,3] , [254,252,249,247,241,239,236,230,228,228,228,228,223,222,222,219,212,205,203,202,201,199,196,195,194,194,191,183,177,169,168,167,166,164,159,157,155,153,151,147,145,144,136,132,129,121,118,110,110,108,106,104,102,98,96,96,95,93,84,80,73,65,64,62,55,53,48,46,44,43,43,40,33,30,27,26,20,18,14,9] , [253,245,245,245,244,238,236,235,230,230,230,223,221,220,220,217,213,210,203,201,193,182,165,163,162,161,161,155,154,153,152,148,147,140,133,132,128,120,118,116,114,114,113,96,91,89,81,80,79,76,76,68,68,67,65,63,55,51,50,49,46,44,41,40,39,37,32,32,30,29,21,21,20,18,15,13,13,10,7,5] , [253,242,239,238,238,237,234,233,229,228,227,225,222,222,221,217,212,208,203,197,197,191,190,190,187,185,184,182,178,175,173,169,164,164,163,158,146,145,144,140,134,131,127,125,113,111,107,106,98,97,97,97,96,95,89,89,83,82,77,71,60,60,59,55,54,51,39,37,35,31,28,22,22,21,19,14,14,8,4,3] , [253,245,243,237,237,227,226,224,222,221,218,217,216,214,213,206,201,192,192,191,190,189,188,188,182,179,169,167,159,148,140,139,138,135,132,126,125,124,122,117,116,114,100,96,90,85,82,81,80,79,77,75,72,69,69,64,61,58,53,53,51,50,49,49,47,44,43,39,38,38,37,37,33,26,17,16,11,8,5,2] , [254,252,248,245,244,242,238,235,235,233,233,228,227,219,208,205,202,200,199,194,190,190,188,183,181,178,177,173,166,163,162,153,143,138,136,128,126,120,119,118,117,114,110,109,108,107,104,103,96,95,94,92,84,80,78,72,70,69,68,67,64,64,63,59,54,50,48,43,40,35,28,27,26,25,22,18,17,16,6,3] , [254,250,249,242,239,239,234,233,219,219,218,215,215,205,201,201,199,199,198,198,195,194,191,187,184,184,184,183,182,179,175,175,162,161,161,158,158,154,153,153,149,147,138,127,126,123,119,114,113,108,106,106,105,104,101,101,100,99,98,92,90,88,88,86,86,82,77,71,68,68,60,53,44,42,37,30,23,9,4,1] , [255,255,250,249,247,243,242,234,233,229,228,228,227,225,223,218,213,212,211,210,210,198,190,186,184,184,175,173,171,166,160,156,155,152,151,151,147,143,138,134,131,131,118,117,115,115,105,97,95,95,91,90,83,77,73,70,70,68,66,54,50,49,45,38,33,32,30,25,24,20,17,13,13,13,10,8,7,6,5,2] , [253,251,249,247,245,243,237,231,230,224,223,222,218,217,214,212,212,209,202,201,186,179,174,171,169,166,164,164,162,157,155,152,148,142,139,134,128,123,120,110,106,104,104,101,100,98,97,97,93,85,80,80,78,77,76,74,70,65,65,54,54,54,43,42,37,32,28,27,26,26,25,22,16,15,14,14,11,5,3,1] , [252,250,243,241,238,232,232,223,211,211,211,208,207,206,205,204,201,201,201,199,190,189,188,179,166,158,156,155,152,150,148,148,147,146,144,139,135,132,131,128,118,116,115,114,114,107,99,94,93,89,85,83,82,80,77,73,71,70,68,66,60,58,57,55,53,49,43,40,39,33,28,28,27,27,13,7,6,6,3,1] , [255,252,250,250,249,249,244,237,233,232,231,231,228,227,227,218,217,211,201,199,198,198,196,189,189,189,189,181,181,178,173,168,168,167,162,160,160,158,156,155,149,145,145,143,141,137,137,130,130,126,120,116,112,109,105,103,102,100,92,90,89,88,86,82,73,71,71,70,67,66,65,63,50,49,46,26,22,18,17,8] , [255,252,246,245,239,237,237,233,233,232,231,231,220,220,218,214,210,206,206,203,199,197,196,194,194,188,185,184,179,156,156,154,149,146,146,143,138,136,136,135,133,130,130,110,109,108,108,102,98,94,93,91,88,88,87,83,79,79,78,78,75,75,74,74,69,58,53,51,50,47,33,31,31,22,15,10,8,5,1,1] , [253,247,246,244,244,242,241,235,234,228,225,212,210,209,207,204,203,201,199,194,192,187,185,184,180,180,177,174,172,171,170,167,165,155,155,154,150,148,144,141,139,137,130,118,117,116,114,112,102,102,96,90,83,81,79,74,70,68,61,57,49,48,47,46,45,45,42,40,34,32,28,27,19,17,14,9,8,3,2,1] , [242,239,237,234,232,229,225,221,214,212,210,202,202,199,196,196,194,193,184,183,182,181,177,176,175,170,167,167,166,164,161,157,155,155,152,146,144,138,137,132,130,130,124,115,115,114,114,111,101,97,92,87,78,78,78,73,70,68,62,58,57,55,51,51,50,43,43,40,39,36,34,33,32,31,24,23,22,16,11,9] , [255,253,251,251,251,249,249,246,245,244,242,236,224,216,210,210,206,205,199,199,197,195,193,192,191,190,189,182,181,180,173,171,170,169,160,159,149,144,142,140,139,136,130,125,123,117,95,92,91,85,79,77,76,75,63,61,59,57,57,53,48,47,41,41,38,29,28,27,27,24,17,17,17,15,13,9,6,5,4,4] , [252,252,246,245,237,232,232,228,221,218,215,214,211,208,206,202,201,200,198,198,194,191,191,180,178,174,169,166,166,164,163,162,159,159,158,149,146,144,138,132,127,125,123,122,121,118,115,113,107,107,106,105,102,101,100,92,86,83,80,75,74,73,72,72,65,61,59,55,54,47,47,43,31,24,17,14,14,9,8,4] , [253,250,249,246,242,241,236,230,226,223,219,213,201,199,198,191,182,182,179,174,171,168,168,166,161,156,155,153,149,144,140,137,136,132,129,129,126,123,121,118,106,102,101,100,99,95,93,89,89,87,86,81,80,78,74,73,73,72,66,62,59,57,55,49,49,43,41,38,35,32,28,27,24,20,17,15,11,6,5,2] , [254,253,249,246,240,229,223,216,212,210,207,206,206,203,203,201,197,195,189,184,183,182,178,175,172,170,166,164,154,151,145,142,141,140,138,125,124,118,117,116,114,107,103,103,94,92,89,86,84,83,81,78,68,66,64,56,56,54,50,47,46,44,40,35,29,27,27,26,26,25,24,24,18,17,12,8,8,7,3,2] , [255,248,244,243,238,237,237,231,229,228,228,219,214,211,208,202,202,199,195,192,191,184,183,179,174,170,168,166,163,159,158,158,154,133,130,130,127,126,125,123,121,119,114,98,98,89,89,88,87,83,79,73,69,65,62,58,57,56,51,49,49,48,43,43,40,36,34,33,31,26,23,22,20,19,18,17,17,14,11,7] , [254,247,246,246,242,240,237,236,236,229,224,224,219,217,217,215,214,202,201,197,193,189,177,172,172,170,168,164,161,156,155,153,152,152,146,145,144,144,140,138,127,124,123,121,115,110,106,99,99,98,94,91,90,90,89,77,77,73,72,70,69,68,66,65,63,60,58,56,54,47,47,41,40,35,34,22,19,18,12,2] ---- , [510,509,496,489,477,476,462,455,452,443,442,426,424,422,407,406,394,380,377,376,375,335,333,328,323,314,309,299,292,288,287,285,271,265,232,231,212,204,192,191,190,184,182,181,181,164,163,156,154,145,141,141,139,136,128,123,122,112,112,97,97,94,91,86,84,72,67,65,58,56,56,55,50,49,48,47,38,24,14,13] , [505,488,475,470,467,466,462,461,437,423,419,399,395,390,390,386,384,381,379,378,372,371,369,365,355,344,344,336,332,322,306,298,296,292,285,278,268,264,252,241,236,229,227,225,219,213,211,205,205,192,189,189,185,172,167,161,156,151,150,150,146,144,139,132,128,123,117,96,80,72,63,43,42,37,37,37,24,22,20,4] , [508,498,496,482,476,473,468,460,435,433,427,423,423,402,393,392,387,381,367,360,357,353,353,348,343,335,324,313,311,299,298,297,291,281,263,263,258,258,246,245,239,223,220,213,211,205,198,195,190,181,180,151,150,147,133,125,122,111,109,108,98,89,87,84,82,77,72,67,64,63,62,57,42,34,33,32,15,9,5,4] , [506,505,495,488,487,485,485,483,450,448,443,440,435,427,426,422,400,398,396,389,375,369,367,366,358,358,353,350,338,334,326,316,316,306,296,291,288,287,271,237,234,228,221,214,210,207,202,192,192,190,190,183,182,181,175,170,165,159,155,150,145,139,136,134,132,114,113,105,103,83,82,71,70,59,34,24,12,7,5,4] ] --------------------------------------------------------------------------------