92 lines
3.7 KiB
Haskell
92 lines
3.7 KiB
Haskell
import Compress.Arithmetic (twoByteMarkov)
|
|
import Compress.Arithmetic qualified as A
|
|
import Compress.LengthDistancePairs as LDP
|
|
import Compress.WordMarkovStats as WM
|
|
import Data.Bifunctor qualified as Bi
|
|
import Data.ByteString qualified as BS
|
|
import Data.Dirs as D
|
|
import Data.Map.Strict qualified as M
|
|
import Data.Ratio
|
|
import Test.Falsify.Generator qualified as Gen
|
|
import Test.Falsify.Predicate as P
|
|
import Test.Falsify.Property qualified as P
|
|
import Test.Falsify.Range qualified as Range
|
|
import Test.Tasty
|
|
import Test.Tasty.Falsify as F
|
|
import Test.Tasty.HUnit
|
|
|
|
-- import qualified GHC.Enum as B
|
|
|
|
main :: IO ()
|
|
main = do
|
|
toCompress <- -- BS.take 12000 <$>
|
|
BS.readFile "pg64317.txt"
|
|
defaultMain (tests toCompress)
|
|
|
|
tests toCompress =
|
|
testGroup
|
|
"falsify"
|
|
[ testGroup
|
|
"Arithmetic"
|
|
[ testCase "works" $
|
|
A.twoByteMarkov ([0, 1, 0, 1, 0, 1, 0, 1, 0, 9] :: [Word8])
|
|
@?= M.fromList [(0, [(1, 0.8), (9, 0.2)]), (1, [(0, 1)])],
|
|
testCase "relativeCounts works as expected with one param" $
|
|
A.relativeCounts [(0, 30)]
|
|
@?= [(0, 1)],
|
|
testCase "relativeCounts works as expected with lots of params" $
|
|
A.relativeCounts [(0, 30), (1, 20)]
|
|
@?= [(0, 30 % 50), (1, 20 % 50)],
|
|
testCase "toRing locs all less than 1" $
|
|
assertBool "larger than one" $
|
|
all (all ((<= 1) . (.location))) toCompressRing,
|
|
testCase "toRing sizes all add up to 1" $
|
|
assertBool "larger than 1" $
|
|
all ((== 1) . sum . map (.size)) toCompressRing,
|
|
testCase "toRing gives no zero sizes" $
|
|
assertBool "== 0" $
|
|
all (all ((/= 0) . (.size))) toCompressRing,
|
|
F.testProperty "binary search" propBinarySearchWithinBounds,
|
|
F.testProperty "compress and decompress isomorphism" (propCompressDecompressIsomorphism (A.decompress . A.compress))
|
|
]
|
|
-- testGroup
|
|
-- "LengthDistancePair"
|
|
-- [ F.testProperty "compress and decompress isomorphism" $ (propCompressDecompressIsomorphism (LDP.decode . (LDP.encode :: [Word8] -> [LDP.LengthDistancePair Word32])))
|
|
-- ]
|
|
]
|
|
where
|
|
toCompressRing =
|
|
map (M.elems . A.toRing . map (Bi.second (A.discretizeFraction :: Rational -> Word8)))
|
|
. M.elems
|
|
. A.twoByteMarkov
|
|
. BS.unpack
|
|
$ toCompress
|
|
|
|
wordMaxBound :: Integer
|
|
wordMaxBound = fromIntegral (maxBound :: Word)
|
|
|
|
genProperFraction = F.gen . fmap ((% wordMaxBound) . fromIntegral) . Gen.inRange $ (Range.between (0, maxBound :: Word))
|
|
|
|
-- propBinarySearchWithinBounds :: Property' String ()
|
|
propBinarySearchWithinBounds = do
|
|
bound1 <- genProperFraction
|
|
epsilon' <- genProperFraction
|
|
let epsilon = max (1 % (fromIntegral (maxBound :: Word))) . (* 0.1) $ bound1 * epsilon'
|
|
let bound2 = if bound1 + epsilon < 1 then bound1 + epsilon else bound1 - epsilon
|
|
-- let bound2 = min 1 $ bound1 + epsilon
|
|
let iso = D.deserialize . D.serialize $ A.binarySearch bound1 bound2
|
|
P.assert $ P.le .$ ("minimum", min bound1 bound2) .$ ("iso", iso)
|
|
P.assert $ P.ge .$ ("maximum", max bound1 bound2) .$ ("iso", iso)
|
|
|
|
-- P.assert $ Range.between (min bound1 bound2) (max bound1 bound2) .$ (A.fromDirs $ A.binarySearch bound1 bound2)
|
|
|
|
-- propCompressDecompressIsomorphism :: F.Property ()
|
|
-- propCompressDecompressIsomorphism :: Property' String ()
|
|
propCompressDecompressIsomorphism :: ([Word8] -> [Word8]) -> Property' String ()
|
|
propCompressDecompressIsomorphism iso = do
|
|
(xs :: [Word8]) <-
|
|
F.gen $ Gen.list (Range.between (4, 5000)) intGen
|
|
P.assert $ eq .$ ("xs", xs) .$ ("changed", iso $ xs)
|
|
where
|
|
intGen :: F.Gen Word8
|
|
intGen = Gen.inRange $ Range.between (0, fromIntegral (maxBound :: Word8))
|