tests/Phylomemy/TemporalMatchingSpec.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE ParallelListComp #-}
   4 {-# OPTIONS_GHC -Wno-orphans #-}
   5
   6 module Phylomemy.TemporalMatchingSpec where
   7
   8 import Control.Monad (forM_)
   9 import Data.Function (($), (&), (.))
  10 import Data.Functor ((<&>))
  11 import Data.GenValidity
  12 import Data.GenValidity.Map ()
  13 import Data.GenValidity.Sequence ()
  14 import Data.GenValidity.Set ()
  15 import Data.GenValidity.Text ()
  16 import Data.GenValidity.Time ()
  17 import Data.Int (Int)
  18 import Data.List qualified as List
  19 import Data.Map.Strict qualified as Map
  20 import Data.Maybe (fromJust)
  21 import Data.Ord (Ord)
  22 import Data.Sequence qualified as Seq
  23 import Data.Text.Short (ShortText)
  24 import Data.Text.Short qualified as ShortText
  25 import Data.Time (UTCTime)
  26 import Data.Validity.Map ()
  27 import Data.Validity.Set ()
  28 import Data.Validity.Text ()
  29 import GHC.IsList (toList)
  30 import Logic
  31 import Numeric.Natural (Natural)
  32 import System.FilePath ((<.>))
  33 import Test.Syd
  34 import Test.Syd.Validity
  35 import Text.Show (Show (..))
  36 import Prelude (Integral (..), Num (..))
  37
  38 import Phylomemy
  39 import Phylomemy.IndexationSpec (Pos (..), Rang)
  40
  41 import Utils
  42
  43 rangeToDocs0 :: Pos :-> Seq.Seq (Document Pos)
  44 rangeToDocs0 =
  45   Map.fromList
  46     [ ( Pos rangeIndex
  47       , Seq.fromList
  48           [ Document
  49             { documentPosition = Pos (2 * rangeIndex + 3 * docIndex)
  50             , documentRoots = Map.fromList [(r, ()) | r <- roots]
  51             }
  52           | roots <- docs
  53           | docIndex <- [1 ..]
  54           ]
  55       )
  56     | docs <-
  57         [ [["a", "b", "c"], ["a", "d", "e"], ["e", "f", "g"]]
  58         , [["a", "b"], ["d", "f"]]
  59         , [["f"], ["d", "f"], ["f", "g", "a"]]
  60         , [["b", "c", "e"], ["a", "d", "e"], ["a", "b", "c"]]
  61         , [["d", "f", "g"], ["b", "f"], ["a", "c", "d"], ["a", "f"]]
  62         , [["c", "d", "g"], ["b", "c", "g"], ["a", "b", "c"], ["e", "g"]]
  63         ]
  64     | rangeIndex <- [1 ..]
  65     ]
  66
  67 {-
  68 rangeToDocs0 :: Pos :-> Seq.Seq (Document Pos)
  69 rangeToDocs0 =
  70   Map.fromListWith
  71     (<>)
  72     [ (Pos (pos - (pos `rem` 2)), Seq.singleton doc)
  73     | doc <- docs0 & toList
  74     , let Pos pos = documentPosition doc
  75     ]
  76 -}
  77
  78 spec :: Spec
  79 spec = do
  80   letName rangeToDocs0 $ \rangeToDocs ->
  81     letName ["a", "b", "c", "d", "e", "f", "g"] $ \roots ->
  82       forM_ ([1 .. 1] :: [Int]) \minSupp ->
  83         forM_ ([2 .. 2] :: [Int]) \minSize -> do
  84           let clusters =
  85                 clusterize
  86                   roots
  87                   (assertStrictlyPositive minSupp)
  88                   (assertStrictlyPositive minSize)
  89                   rangeToDocs
  90           let phy = phylomemy jaccardSimilarity (clusters <&> unName)
  91           let weights = phylomemyWeights phy
  92           describe "phylomemyWeights" do
  93             goldenShow ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize) weights
  94           describe "phylomemyDOT" do
  95             forM_ weights \minWeight ->
  96               goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "minWeight=" <> show minWeight) $
  97                 phylomemyDOT $
  98                   phylomemyRaise minWeight phy