{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1Spec where import qualified Data.Vector.Storable as DVS import Data.Word import HaskellWorks.Data.Bits.AllExcess.AllExcess1 import HaskellWorks.Data.Bits.BitLength import HaskellWorks.Data.Bits.BitShow import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.Succinct.BalancedParens import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1 import Test.Hspec import Test.QuickCheck {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} newtype ShowVector a = ShowVector a deriving (Eq, BitShow) instance BitShow a => Show (ShowVector a) where show = bitShow vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64)) vectorSizedBetween a b = do n <- choose (a, b) xs <- sequence [ arbitrary | _ <- [1 .. n] ] return $ ShowVector (DVS.fromList xs) padVectorExcess :: DVS.Vector Word64 -> DVS.Vector Word64 padVectorExcess v = DVS.constructN paddedLen gen where wordBitLength = fromIntegral (elemBitLength v) :: Int paddedLen = DVS.length v + (((allExcess1 v + wordBitLength - 1) `div` wordBitLength) `max` 0) gen :: DVS.Vector Word64 -> Word64 gen u = let i = DVS.length u in if i < DVS.length v then v DVS.! i else 0 spec :: Spec spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1Spec" $ do it "XXX" $ do let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 let !rmm = mkRangeMinMaxL1 v findClose rmm 61 `shouldBe` findClose v 61 it "YYY" $ do let v = fromBitTextByteString "00100001 01011101 10000100 11100001 11100100 00110010 01011011 00010001 01101011 01111100 10111011 01110000 01111101 01110000 00000101 01111110 11110101 01011001 00000100 00010001 00101001 10001001 10110000 01011100 10001000 01011011 11011101 10011101 11111111 10000111 00100100 00100010 00111010 10111001 10010100 01110111 10011000 11011111 10000100 10100111 10000111 11110110 10001000 01110001 00100000 11110010 11110000 10111010 11111010 01100101 11101101 01111011 00100010 11011011 11000000 11111110 11101111 00111101 11000001 01001001 10001000 01011100 11010000 11101110 01001101 11011110 00100110 00000000 01000111 00001100 11101111 10100111 10000111 00100010 11101011 01111100 10000111 01101001 01100101 11001101 01111110 11100110 00101000 00110100 10111001 01100100 00000001 11110111 00010110 00100000 11110110 00011101 11001110 00011101 11101100 10110011 00110010 11100011 01110001 01000101 00011001 11100011 10110011 11010001 11011010 10100100 00001101 01011001 01101110 01011100 10001101 01011110 11001000 00001100 10011111 11000001 11101011 11000010 11010010 10100100 00111101 00000010 11100100 10010101 00110111 10111111 00100001 00111010 00010000 10100110 01010010 11111110 01110010 10101011 10111110 10111010 00011001 10101001 01000100 11100111 11010110 11001000 10111100 11001100 01100110 10101111 11011011 01001100 00001101 00110101 10010001 01101100 00101111 11101101 11110001 10111010 01110110 00100111 10010101 00101010 01001001 11000011 11011000 10000001 11100011 10110110 11111111 01111001 10100101 01110100 00000100 01111100 00101101 11101100 01111111 10100101 01100100 00011101 10011011 01011011 11110110 00011110 00110011 01101011 01011110 01110100 11000111 00110001 10110011 01010111 01000000 01001111 01011010 00111001 01000111 00001101 00000010 11001101 11000010 00011010 01001100 01010111 01110101 01100110 11010001 00000000 11011111 10010010 01000110 00111101 00000001 01010000 10001000 10100111 11111010 00010100 01000001 10011100 00000111 11000101 01100101 10011000 00011101 01110000 10101010 01101111 00100101 10011001 11010010 11111001 10010101 01000011 01111101 00110100 11001101 10101011 00010101 00111011 11010000 00100010 00101111 01111101 01100011 11100110 11111111 00000100 11010101 01111100 10010110 11101111 00101100 10001100 10000000 00101100 00100010 00100001 11010010 00010001 00000010 11001100 10000100 00011111 01000100 11011000 11110110 11101110 11110011 10101011 10110010 10000111 01010011 11000010 11111000 01100000 10010010 10011101 11110010 11111111 01001111 11110100 11010111 11010010 11011001 00110010 11001001 11111101 00111111 11100010 00001000 01011101 00011011 11111100 11001000 11101001 11011100 10000001 00101000 11110110 11011111 10011000 11000011 01010110 11111000 01001100 01011000 00100101 00110000 11111111 00100111 11000110 10011111 11000000 10101011 11010001 10100110 00110000 00100111 11111110 00001001 01011100 10110110 00010111 10011100 00010101 11101100 10111010 01100010 11001100 11100111 10100010 01011000 11000101 00101000 00010100 11101001 01110100 10001100 01111001 10010010 01000101 11010110 01111001 11010011 01100100 11000011 10101110 01101001 10010010 10000011 11110000 10111010 11100001 01001101 11110111 01111011 11000110 10111111 00101001 10100100 11110101 11110000 10000110 01010010 10110011 11010100 00110000 00101001 00101001 00000100 11111100 00010101 01010100 01000011 01100111 00000000 01111001 10100001 00110110 10000011 11010000 01100111 00110111 00000011 01111010 00100110 10010101 00000101 01011001 01001100 10011001 10100111 01010000 00101000 10111110 11001110 11001110 01111110 10110110 01001110 11110011 00110110 11011011 10110111 01010101 11001100 11011101 00011010 11011100 10000001 11001010 10100111 00010011 11110111 01101110 10011000 01011101 10000001 00001000 10111010 11011101 00111011 10001000 01001100 10100111 00100001 11000111 00001010 01001100 00111101 10110011 01101011 01001110 00000100 11010010 11110111 00110011 10010001 01000010 01001100 10000111 01001011 01001101 10001011 01001000 00011111 01000110 00011001 10000111 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: DVS.Vector Word64 let !rmm = mkRangeMinMaxL1 v let len = bitLength v [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]] it "findClose should return the same result" $ do forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do let v = padVectorExcess u let !rmm = mkRangeMinMaxL1 v let len = bitLength v [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]] it "findClose should return the same result over all counts" $ do forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do let v = padVectorExcess u forAll (choose (1, bitLength v)) $ \p -> do let !rmm = mkRangeMinMaxL1 v findClose rmm p `shouldBe` findClose v p it "nextSibling should return the same result" $ do forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do let v = padVectorExcess u let !rmm = mkRangeMinMaxL1 v nextSibling rmm 0 `shouldBe` nextSibling v 0 it "nextSibling should return the same result over all counts" $ do forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do let v = padVectorExcess u let !rmm = mkRangeMinMaxL1 v [nextSibling rmm p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]