benchmark, test suite, and run length encoding

test/Test.hs

@@ -0,0 +1,92 @@
+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))