packages feed

haal 0.4.1.0 → 0.5.0.0

raw patch · 11 files changed

+367/−20 lines, 11 filesdep +deepseqdep +tastydep +tasty-benchdep ~basedep ~containersdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, tasty, tasty-bench

Dependency ranges changed: base, containers, mtl, random

API changes (from Hackage documentation)

- Haal.Experiment: experiment :: forall sul (m :: Type -> Type) aut s learner oracle i o. (SUL sul m, Automaton aut s, Learner learner aut s, EquivalenceOracle oracle, FiniteOrd i, FiniteOrd s, FiniteEq o) => learner i o -> oracle -> ExperimentT (sul i o) m (aut s i o, Statistics aut s i o)
+ Haal.Experiment: experiment :: forall sul (m :: Type -> Type) aut s learner oracle i o. (SUL sul m, Automaton aut s, Learner learner aut s, EquivalenceOracle oracle, FiniteOrd i, FiniteOrd s, FiniteOrd o) => learner i o -> oracle -> ExperimentT (sul i o) m (aut s i o, Statistics aut s i o)
- Haal.Experiment: learn :: forall sul (m :: Type -> Type) i o. (Learner l aut s, SUL sul m, Automaton aut s, FiniteOrd i, FiniteOrd s, FiniteEq o) => l i o -> ExperimentT (sul i o) m (l i o, aut s i o)
+ Haal.Experiment: learn :: forall sul (m :: Type -> Type) i o. (Learner l aut s, SUL sul m, Automaton aut s, FiniteOrd i, FiniteOrd s, FiniteOrd o) => l i o -> ExperimentT (sul i o) m (l i o, aut s i o)
- Haal.Learning.LMstar: lmstar :: forall sul i o (m :: Type -> Type). (SUL sul m, FiniteOrd i, Eq o, Monad m) => LMstar i o -> ExperimentT (sul i o) m (LMstar i o, MealyAutomaton StateID i o)
+ Haal.Learning.LMstar: lmstar :: forall sul i o (m :: Type -> Type). (SUL sul m, FiniteOrd i, Ord o, Monad m) => LMstar i o -> ExperimentT (sul i o) m (LMstar i o, MealyAutomaton StateID i o)

Files

CHANGELOG.md view
@@ -8,6 +8,32 @@  ## Unreleased +## 0.5.0.0 - 2026-04-22++### Fixed+- `Haal.Learning.LMstar.equivalenceClasses` now iterates over `Sm` only,+  matching Definition 2 of Shahbaz & Groz, "Inferring Mealy Machines".+  Previously it iterated over `Sm ∪ Sm·I`, which could pick a representative+  from `Sm·I` whose `rep++[i]` was not in the observation table, causing+  `makeHypothesis` to fail on many real protocol models (DTLS, medium MQTT)+  with `"invariant violation — makeHypothesis failed on closed consistent table"`.++### Changed (breaking)+- `Haal.Learning.LMstar.otIsConsistent` tightens its output constraint+  from `Eq o` to `Ord o` to support Map-based row grouping.++### Changed+- `Haal.Learning.LMstar.otIsConsistent` groups prefixes by row signature+  before pairwise comparison, reducing the worst-case pair enumeration.+- `Haal.Dot.parseDot` uses `Set.fromList` instead of `nub` for deduplication+  (O(n²) → O(n log n)).++### Added+- `tasty-bench`-based benchmark suite in `bench/` covering BlackBox+  operations, W-method / Wp-method test-suite generation, DOT+  serialize/parse/roundtrip, and end-to-end learning experiments.+  Run with `stack bench haal`.+ ## 0.4.1.0 - 2026-03-21  ### Added 
README.md view
@@ -74,16 +74,24 @@  ## Installing -The project is still in its early stages and has not yet been published. For now, you can clone the repository, build, and install it locally using:+The project is available on Hackage. You can check the available version with the command:  ```bash-stack install+stack list haal # cabal list haal ``` -Moreover, I try to add haddock comments as much as possible. Therefore, documentation can be built using:+Given that the project is still in its early stages, you probably always want to see the latest version listed. +You can clone the repo and build the library yourself with:++```bash +stack build haal:lib+```++Moreover, given that the library makes use of LiquidHaskell annotations from v0.4.0.1 onwards, you can build with verification turned on:+ ```bash-stack haddock+stack build haal:lib --flag haal:liquid  ```  ## Example
+ bench/Bench/BlackBox.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveGeneric #-}++module Bench.BlackBox (blackBoxBenchmarks) where++import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)++import Haal.Automaton.MealyAutomaton (MealyAutomaton, mkMealyAutomaton)+import Haal.BlackBox (accessSequences, distinguish, globalCharacterizingSet, localCharacterizingSet, reachable)++-- | Input alphabet for benchmark automata.+data In = IA | IB | IC | ID deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData In++-- | Output alphabet for benchmark automata.+data Out = OX | OY | OZ | OW deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData Out++-- | States for benchmark automata.+data St = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7 deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData St++-- | A deterministic 8-state Mealy automaton with fixed transitions.+benchAutomaton :: MealyAutomaton St In Out+benchAutomaton = mkMealyAutomaton delta lambda (Set.fromList [S0 .. S7]) S0+  where+    transMap :: Map.Map (St, In) (St, Out)+    transMap = Map.fromList+        [ ((S0, IA), (S1, OX)), ((S0, IB), (S2, OY)), ((S0, IC), (S3, OZ)), ((S0, ID), (S4, OW))+        , ((S1, IA), (S5, OY)), ((S1, IB), (S0, OX)), ((S1, IC), (S6, OW)), ((S1, ID), (S7, OZ))+        , ((S2, IA), (S3, OZ)), ((S2, IB), (S4, OX)), ((S2, IC), (S7, OY)), ((S2, ID), (S1, OW))+        , ((S3, IA), (S6, OW)), ((S3, IB), (S5, OZ)), ((S3, IC), (S0, OX)), ((S3, ID), (S2, OY))+        , ((S4, IA), (S7, OX)), ((S4, IB), (S6, OW)), ((S4, IC), (S1, OY)), ((S4, ID), (S0, OZ))+        , ((S5, IA), (S2, OZ)), ((S5, IB), (S7, OY)), ((S5, IC), (S4, OX)), ((S5, ID), (S3, OW))+        , ((S6, IA), (S4, OY)), ((S6, IB), (S1, OX)), ((S6, IC), (S5, OZ)), ((S6, ID), (S0, OW))+        , ((S7, IA), (S0, OW)), ((S7, IB), (S3, OZ)), ((S7, IC), (S2, OY)), ((S7, ID), (S6, OX))+        ]++    delta s i = fst (transMap Map.! (s, i))+    lambda s i = snd (transMap Map.! (s, i))++blackBoxBenchmarks :: Benchmark+blackBoxBenchmarks = bgroup "BlackBox"+    [ bgroup "8-state"+        [ bench "reachable" $ nf reachable benchAutomaton+        , bench "accessSequences" $ nf accessSequences benchAutomaton+        , bench "globalCharacterizingSet" $ nf globalCharacterizingSet benchAutomaton+        , bench "localCharacterizingSet/S0" $ nf (localCharacterizingSet benchAutomaton) S0+        , bench "distinguish/S0-S1" $ nf (distinguish benchAutomaton S0) S1+        , bench "distinguish/S0-S7" $ nf (distinguish benchAutomaton S0) S7+        ]+    ]
+ bench/Bench/Dot.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveGeneric #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Bench.Dot (dotBenchmarks) where++import Control.DeepSeq (NFData (rnf))+import GHC.Generics (Generic)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)++import Haal.Automaton.MealyAutomaton (MealyAutomaton, mkMealyAutomaton)+import Haal.Dot (ParsedMealy (..), mealyToDot, parseDot)++-- | Input alphabet for benchmark automata.+data In = IA | IB | IC | ID deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData In++-- | Output alphabet for benchmark automata.+data Out = OX | OY | OZ | OW deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData Out++-- | States for benchmark automata.+data St = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7 deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData St++instance NFData ParsedMealy where+    rnf (ParsedMealy a b c d e f) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f++-- | A deterministic 8-state Mealy automaton with fixed transitions.+benchAutomaton :: MealyAutomaton St In Out+benchAutomaton = mkMealyAutomaton delta lambda (Set.fromList [S0 .. S7]) S0+  where+    transMap :: Map.Map (St, In) (St, Out)+    transMap = Map.fromList+        [ ((S0, IA), (S1, OX)), ((S0, IB), (S2, OY)), ((S0, IC), (S3, OZ)), ((S0, ID), (S4, OW))+        , ((S1, IA), (S5, OY)), ((S1, IB), (S0, OX)), ((S1, IC), (S6, OW)), ((S1, ID), (S7, OZ))+        , ((S2, IA), (S3, OZ)), ((S2, IB), (S4, OX)), ((S2, IC), (S7, OY)), ((S2, ID), (S1, OW))+        , ((S3, IA), (S6, OW)), ((S3, IB), (S5, OZ)), ((S3, IC), (S0, OX)), ((S3, ID), (S2, OY))+        , ((S4, IA), (S7, OX)), ((S4, IB), (S6, OW)), ((S4, IC), (S1, OY)), ((S4, ID), (S0, OZ))+        , ((S5, IA), (S2, OZ)), ((S5, IB), (S7, OY)), ((S5, IC), (S4, OX)), ((S5, ID), (S3, OW))+        , ((S6, IA), (S4, OY)), ((S6, IB), (S1, OX)), ((S6, IC), (S5, OZ)), ((S6, ID), (S0, OW))+        , ((S7, IA), (S0, OW)), ((S7, IB), (S3, OZ)), ((S7, IC), (S2, OY)), ((S7, ID), (S6, OX))+        ]++    delta s i = fst (transMap Map.! (s, i))+    lambda s i = snd (transMap Map.! (s, i))++-- | Pre-generated DOT string for parsing benchmarks.+benchDotString :: String+benchDotString = case mealyToDot benchAutomaton of+    Right s -> s+    Left err -> error ("benchDotString: " ++ err)++dotBenchmarks :: Benchmark+dotBenchmarks = bgroup "Dot"+    [ bench "mealyToDot/8-state" $ nf mealyToDot benchAutomaton+    , bench "parseDot/8-state" $ nf parseDot benchDotString+    , bench "roundtrip/8-state" $ nf (parseDot . either error id . mealyToDot) benchAutomaton+    ]
+ bench/Bench/EndToEnd.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DeriveGeneric #-}++module Bench.EndToEnd (endToEndBenchmarks) where++import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Test.Tasty.Bench (Benchmark, bench, bgroup, whnf)++import Haal.Automaton.MealyAutomaton (MealyAutomaton, mkMealyAutomaton)+import Haal.EquivalenceOracle.WMethod (WMethod, WMethodConfig (..), mkWMethod)+import Haal.EquivalenceOracle.WpMethod (WpMethod, WpMethodConfig (..), mkWpMethod)+import Haal.Experiment (experiment, runExperiment)+import Haal.Learning.LMstar (LMstarConfig (..), mkLMstar)++-- | Input alphabet for benchmark automata.+data In = IA | IB | IC | ID deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData In++-- | Output alphabet for benchmark automata.+data Out = OX | OY | OZ | OW deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData Out++-- | States for the SUL (target automaton).+data St = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7 deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData St++-- | A deterministic 8-state Mealy automaton used as the SUL.+benchAutomaton :: MealyAutomaton St In Out+benchAutomaton = mkMealyAutomaton delta lambda (Set.fromList [S0 .. S7]) S0+  where+    transMap :: Map.Map (St, In) (St, Out)+    transMap = Map.fromList+        [ ((S0, IA), (S1, OX)), ((S0, IB), (S2, OY)), ((S0, IC), (S3, OZ)), ((S0, ID), (S4, OW))+        , ((S1, IA), (S5, OY)), ((S1, IB), (S0, OX)), ((S1, IC), (S6, OW)), ((S1, ID), (S7, OZ))+        , ((S2, IA), (S3, OZ)), ((S2, IB), (S4, OX)), ((S2, IC), (S7, OY)), ((S2, ID), (S1, OW))+        , ((S3, IA), (S6, OW)), ((S3, IB), (S5, OZ)), ((S3, IC), (S0, OX)), ((S3, ID), (S2, OY))+        , ((S4, IA), (S7, OX)), ((S4, IB), (S6, OW)), ((S4, IC), (S1, OY)), ((S4, ID), (S0, OZ))+        , ((S5, IA), (S2, OZ)), ((S5, IB), (S7, OY)), ((S5, IC), (S4, OX)), ((S5, ID), (S3, OW))+        , ((S6, IA), (S4, OY)), ((S6, IB), (S1, OX)), ((S6, IC), (S5, OZ)), ((S6, ID), (S0, OW))+        , ((S7, IA), (S0, OW)), ((S7, IB), (S3, OZ)), ((S7, IC), (S2, OY)), ((S7, ID), (S6, OX))+        ]++    delta s i = fst (transMap Map.! (s, i))+    lambda s i = snd (transMap Map.! (s, i))++wmethod :: Int -> WMethod+wmethod d = either error id (mkWMethod (WMethodConfig d))++wpmethod :: Int -> WpMethod+wpmethod d = either error id (mkWpMethod (WpMethodConfig d))++-- | Run a full learning experiment (init -> learn -> test -> refine -> converge).+-- Uses whnf since MealyAutomaton contains functions that cannot be NFData.+endToEndBenchmarks :: Benchmark+endToEndBenchmarks = bgroup "EndToEnd"+    [ bgroup "LMstar"+        [ bench "WMethod/depth=1" $+            whnf (runExperiment (experiment (mkLMstar Star) (wmethod 1))) benchAutomaton+        , bench "WpMethod/depth=1" $+            whnf (runExperiment (experiment (mkLMstar Star) (wpmethod 1))) benchAutomaton+        ]+    , bgroup "LMplus"+        [ bench "WMethod/depth=1" $+            whnf (runExperiment (experiment (mkLMstar Plus) (wmethod 1))) benchAutomaton+        , bench "WpMethod/depth=1" $+            whnf (runExperiment (experiment (mkLMstar Plus) (wpmethod 1))) benchAutomaton+        ]+    ]
+ bench/Bench/EquivalenceOracle.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE DeriveGeneric #-}++module Bench.EquivalenceOracle (equivalenceOracleBenchmarks) where++import Control.DeepSeq (NFData)+import GHC.Generics (Generic)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)++import Haal.Automaton.MealyAutomaton (MealyAutomaton, mkMealyAutomaton)+import Haal.EquivalenceOracle.WMethod (WMethod, WMethodConfig (..), mkWMethod, wmethodSuiteSize)+import Haal.EquivalenceOracle.WpMethod (WpMethod, WpMethodConfig (..), mkWpMethod, wpmethodSuiteSize)+import Haal.Experiment (EquivalenceOracle (testSuite))++-- | Input alphabet for benchmark automata.+data In = IA | IB | IC | ID deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData In++-- | Output alphabet for benchmark automata.+data Out = OX | OY | OZ | OW deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData Out++-- | States for benchmark automata.+data St = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7 deriving (Show, Eq, Ord, Enum, Bounded, Generic)+instance NFData St++-- | A deterministic 8-state Mealy automaton with fixed transitions.+benchAutomaton :: MealyAutomaton St In Out+benchAutomaton = mkMealyAutomaton delta lambda (Set.fromList [S0 .. S7]) S0+  where+    transMap :: Map.Map (St, In) (St, Out)+    transMap = Map.fromList+        [ ((S0, IA), (S1, OX)), ((S0, IB), (S2, OY)), ((S0, IC), (S3, OZ)), ((S0, ID), (S4, OW))+        , ((S1, IA), (S5, OY)), ((S1, IB), (S0, OX)), ((S1, IC), (S6, OW)), ((S1, ID), (S7, OZ))+        , ((S2, IA), (S3, OZ)), ((S2, IB), (S4, OX)), ((S2, IC), (S7, OY)), ((S2, ID), (S1, OW))+        , ((S3, IA), (S6, OW)), ((S3, IB), (S5, OZ)), ((S3, IC), (S0, OX)), ((S3, ID), (S2, OY))+        , ((S4, IA), (S7, OX)), ((S4, IB), (S6, OW)), ((S4, IC), (S1, OY)), ((S4, ID), (S0, OZ))+        , ((S5, IA), (S2, OZ)), ((S5, IB), (S7, OY)), ((S5, IC), (S4, OX)), ((S5, ID), (S3, OW))+        , ((S6, IA), (S4, OY)), ((S6, IB), (S1, OX)), ((S6, IC), (S5, OZ)), ((S6, ID), (S0, OW))+        , ((S7, IA), (S0, OW)), ((S7, IB), (S3, OZ)), ((S7, IC), (S2, OY)), ((S7, ID), (S6, OX))+        ]++    delta s i = fst (transMap Map.! (s, i))+    lambda s i = snd (transMap Map.! (s, i))++wmethod :: Int -> WMethod+wmethod d = either error id (mkWMethod (WMethodConfig d))++wpmethod :: Int -> WpMethod+wpmethod d = either error id (mkWpMethod (WpMethodConfig d))++equivalenceOracleBenchmarks :: Benchmark+equivalenceOracleBenchmarks = bgroup "EquivalenceOracle"+    [ bgroup "WMethod"+        [ bgroup "testSuite"+            [ bench "depth=1" $ nf (\w -> snd (testSuite w benchAutomaton)) (wmethod 1)+            , bench "depth=2" $ nf (\w -> snd (testSuite w benchAutomaton)) (wmethod 2)+            , bench "depth=3" $ nf (\w -> snd (testSuite w benchAutomaton)) (wmethod 3)+            ]+        , bgroup "suiteSize"+            [ bench "depth=1" $ nf (\w -> wmethodSuiteSize w benchAutomaton) (wmethod 1)+            , bench "depth=2" $ nf (\w -> wmethodSuiteSize w benchAutomaton) (wmethod 2)+            , bench "depth=3" $ nf (\w -> wmethodSuiteSize w benchAutomaton) (wmethod 3)+            ]+        ]+    , bgroup "WpMethod"+        [ bgroup "testSuite"+            [ bench "depth=1" $ nf (\w -> snd (testSuite w benchAutomaton)) (wpmethod 1)+            , bench "depth=2" $ nf (\w -> snd (testSuite w benchAutomaton)) (wpmethod 2)+            , bench "depth=3" $ nf (\w -> snd (testSuite w benchAutomaton)) (wpmethod 3)+            ]+        , bgroup "suiteSize"+            [ bench "depth=1" $ nf (\w -> wpmethodSuiteSize w benchAutomaton) (wpmethod 1)+            , bench "depth=2" $ nf (\w -> wpmethodSuiteSize w benchAutomaton) (wpmethod 2)+            , bench "depth=3" $ nf (\w -> wpmethodSuiteSize w benchAutomaton) (wpmethod 3)+            ]+        ]+    ]
+ bench/Main.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import Test.Tasty.Bench (defaultMain)++import Bench.BlackBox (blackBoxBenchmarks)+import Bench.Dot (dotBenchmarks)+import Bench.EndToEnd (endToEndBenchmarks)+import Bench.EquivalenceOracle (equivalenceOracleBenchmarks)++main :: IO ()+main = defaultMain+    [ blackBoxBenchmarks+    , equivalenceOracleBenchmarks+    , dotBenchmarks+    , endToEndBenchmarks+    ]
haal.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           haal-version:        0.4.1.0+version:        0.5.0.0 synopsis:       A Haskell library for Active Automata Learning. description:    Please see the README on GitHub at <https://github.com/steve-anunknown/haal#readme> category:       Model Learning@@ -160,4 +160,29 @@     , hspec     , mtl     , random+  default-language: Haskell2010++benchmark haal-bench+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Bench.BlackBox+      Bench.Dot+      Bench.EndToEnd+      Bench.EquivalenceOracle+      Paths_haal+  autogen-modules:+      Paths_haal+  hs-source-dirs:+      bench+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:+      base >=4.18.3 && <5+    , containers+    , deepseq+    , haal+    , mtl+    , random+    , tasty+    , tasty-bench   default-language: Haskell2010
src/Haal/Dot.hs view
@@ -9,7 +9,7 @@ ) where  import Data.Char (isAlphaNum, isDigit, isLower, isSpace, toUpper)-import Data.List (intercalate, isInfixOf, isPrefixOf, nub)+import Data.List (intercalate, isInfixOf, isPrefixOf) import qualified Data.Map.Strict as Map import Data.Maybe (mapMaybe) import qualified Data.Set as Set@@ -111,14 +111,13 @@     let ls = lines src     initSt <- findInit ls     trans <- collectTrans ls-    let allStates = nub $ concatMap (\(s, _, d, _) -> [s, d]) trans-    if initSt `notElem` allStates+    let allStateSet = Set.fromList $ concatMap (\(s, _, d, _) -> [s, d]) trans+    if initSt `Set.notMember` allStateSet         then Left ("Initial state '" ++ initSt ++ "' does not appear in any transition")         else do-            let otherStates = filter (/= initSt) allStates-                stateOrder = initSt : otherStates-                inputSyms = nub $ map (\(_, i, _, _) -> i) trans-                outputSyms = nub $ map (\(_, _, _, o) -> o) trans+            let stateOrder = initSt : Set.toList (Set.delete initSt allStateSet)+                inputSyms = Set.toList . Set.fromList $ map (\(_, i, _, _) -> i) trans+                outputSyms = Set.toList . Set.fromList $ map (\(_, _, _, o) -> o) trans                 warnings = slashWarnings inputSyms outputSyms             return                 ParsedMealy
src/Haal/Experiment.hs view
@@ -70,7 +70,7 @@         , Automaton aut s         , FiniteOrd i         , FiniteOrd s-        , FiniteEq o+        , FiniteOrd o         ) =>         l i o ->         ExperimentT (sul i o) m (l i o, aut s i o)@@ -126,7 +126,7 @@     , EquivalenceOracle oracle     , FiniteOrd i     , FiniteOrd s-    , FiniteEq o+    , FiniteOrd o     ) =>     learner i o ->     oracle ->
src/Haal/Learning/LMstar.hs view
@@ -150,7 +150,7 @@     (FiniteOrd i, Eq o) =>     ObservationTable i o ->     Map.Map [i] [[i]]-equivalenceClasses ot = go Map.empty (sm `Set.union` sm_I)+equivalenceClasses ot = go Map.empty sm   where     sm = prefixSetS ot     sm_I = prefixSetSI ot@@ -165,7 +165,7 @@ -- | The 'lmstar' function implements one iteration of the LM* algorithm. lmstar ::     forall sul i o m.-    (SUL sul m, FiniteOrd i, Eq o, Monad m) =>+    (SUL sul m, FiniteOrd i, Ord o, Monad m) =>     LMstar i o ->     ExperimentT (sul i o) m (LMstar i o, MealyAutomaton StateID i o) lmstar (LMstar (Init ot)) = case otIsClosed ot of@@ -209,14 +209,23 @@ distinguishing letter and @e@ is an existing suffix witnessing the inconsistency, so that @[a] ++ e@ can be added to E. -}-otIsConsistent :: forall i o. (FiniteOrd i, Eq o) => ObservationTable i o -> ([i], [i])+otIsConsistent :: forall i o. (FiniteOrd i, Ord o) => ObservationTable i o -> ([i], [i]) otIsConsistent ot = Maybe.fromMaybe ([], []) condition   where     alph = [minBound .. maxBound] :: [i]     sm = Set.toList $ prefixSetS ot     em = Set.toList $ suffixSetE ot+    tm = mappingT ot -    equivalentPairs = [(r1, r2) | r1 <- sm, r2 <- sm, r1 <= r2, equivalentRows ot r1 r2]+    -- Group prefixes by their row signature (the sequence of outputs+    -- for each suffix in E). Prefixes with identical signatures are+    -- equivalent, so only pairs within the same group need checking+    -- for consistency violations.+    rowSig s = map (\e -> Map.lookup (s, e) tm) em+    groups = Map.elems $ Map.fromListWith (++) [(rowSig s, [s]) | s <- sm]+    equivalentPairs = [pair | group <- groups, pair <- uniquePairs group]+    uniquePairs [] = []+    uniquePairs (x : xs) = [(x, y) | y <- xs] ++ uniquePairs xs      condition = do         (s1, s2) <-@@ -231,7 +240,7 @@                 alph         e <-             find-                (\e -> Map.lookup (s1 ++ [x], e) (mappingT ot) /= Map.lookup (s2 ++ [x], e) (mappingT ot))+                (\e -> Map.lookup (s1 ++ [x], e) tm /= Map.lookup (s2 ++ [x], e) tm)                 em         return ([x], e)