tests/Clustering/FrequentItemSet/BruteForceSpec.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2
   3 module Clustering.FrequentItemSet.BruteForceSpec where
   4
   5 import Data.Either (fromRight)
   6 import Data.Function (($))
   7 import Data.Functor ((<$>))
   8 import Data.Int (Int)
   9 import Data.Ord (Ord)
  10 import Data.Ratio ((%))
  11 import Logic
  12 import Logic.Theory.Arithmetic
  13 import Logic.Theory.Ord
  14 import Numeric.Probability (probability)
  15 import Test.Syd
  16 import Prelude (Num, undefined)
  17
  18 import Clustering.FrequentItemSet.BruteForce
  19
  20 exampleTakeakiUnoDB :: Ord item => Num item => Transactions item
  21 exampleTakeakiUnoDB =
  22   [ [1, 2, 5, 6, 7]
  23   , [2, 3, 4, 5]
  24   , [1, 2, 7, 8, 9]
  25   , [1, 7, 9]
  26   , [2, 7, 9]
  27   , [2, 7, 9] -- Copy-paste typo on the original example
  28   , [1, 9] -- Add this to increase the support of [1,9] because the original example is wrong…
  29   , [2]
  30   ]
  31
  32 spec :: Spec
  33 spec = do
  34   describe "frequentItemSets" do
  35     it "computes Takeaki Uno's example" $
  36       -- From https://research.nii.ac.jp/~uno/code/lcm.html#IntroductionstoFrequentItemsetMining
  37       letName 3 \(\x -> x / fromRight undefined (prove (x > zero)) -> minSupp) ->
  38         -- Alas, this is not a zero-cost `coerce`
  39         unName <$> allFrequentItemSets @Int (nameless exampleTakeakiUnoDB) minSupp
  40           `shouldBe` [ []
  41                      , [1]
  42                      , [1, 7]
  43                      , [1, 9]
  44                      , [2]
  45                      , [2, 7]
  46                      , [2, 7, 9]
  47                      , [2, 9]
  48                      , [7]
  49                      , [7, 9]
  50                      , [9]
  51                      ]
  52   describe "associationRules" do
  53     proba75 <- liftIO (probability (75 % 100))
  54     it "computes Takeaki Uno's example" do
  55       let db = nameless exampleTakeakiUnoDB
  56       let minSupp = let x = nameless 2 in x / fromRight undefined (prove (x > zero))
  57       goldenPrettyShowInstance
  58         "tests/Clustering/FrequentItemSet/BruteForce/associationRules/TakeakiUno.golden"
  59         [ associationRules fis db (nameless proba75)
  60         | fis <- allFrequentItemSets @Int db minSupp
  61         ]