haal 0.3.0.0 → 0.4.0.0

raw patch · 12 files changed

+91/−47 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +4/−1
• examples/demo.hs +6/−1
• examples/div.hs +3/−1
• examples/io.hs +3/−1
• examples/website.hs +3/−1
• haal.cabal +1/−1
• src/Haal/EquivalenceOracle/RandomWalk.hs +5/−3
• src/Haal/EquivalenceOracle/RandomWords.hs +9/−3
• src/Haal/EquivalenceOracle/WMethod.hs +30/−25
• src/Haal/EquivalenceOracle/WpMethod.hs +12/−4
• test/Utils.hs +7/−6

@@ -8,6 +8,14 @@  ## Unreleased +## 0.4.0.0 - 2026-03-16 ++### Changed +- Changed the types of oracles' constructors from `<Oracle>` to `Either String <Oracle>`+  where `String` is an error message indicating invalid values to `<OracleConfig>`.+  Now, for example, instead of `oracle = mkWMethod (WMethodConfig 2)`, one should either +  pattern match with `case` or do `oracle = either error id (mkWMethod (WMethodConfig 2))`.+ ## 0.3.0.0 - 2026-03-11  ### Changed

@@ -105,8 +105,11 @@ ghci|     sulTransitions S2 A = (S0, X) ghci|     sulTransitions S2 B = (S0, Y) +ghci> learner = mkLMstar Star+ghci> teacher = either error id (mkWMethod (WMethodConfig 2))+ -- Set up the experiment.-ghci> myexperiment = experiment (mkLMstar Star) (mkWMethod 2)+ghci> myexperiment = experiment learner teacher  -- Define the Mealy system under learning. Remember that automata can act as suls. ghci> mysul = mkMealyAutomaton2 sulTransitions (Set.fromList [S0, S1, S2]) S0

@@ -17,8 +17,13 @@ sulTransitions S2 A = (S0, X) sulTransitions S2 B = (S0, Y) +learner = mkLMstar Star+oracle = case mkWMethod (WMethodConfig 2) of+    Left msg -> error msg+    Right oracle' -> oracle'+ -- Set up the experiment.-myexperiment = experiment (mkLMstar Star) (mkWMethod (WMethodConfig 2))+myexperiment = experiment learner oracle  -- Define the Mealy system under learning. Remember that automata can act as suls. mysul = mkMealyAutomaton2 sulTransitions (Set.fromList [S0, S1, S2]) S0

@@ -83,7 +83,9 @@ learner = mkLMstar Star  oracle :: WpMethod-oracle = mkWpMethod (WpMethodConfig 3)+oracle = case mkWpMethod (WpMethodConfig 3) of +    Left msg -> error msg +    Right oracle' -> oracle'  exper :: Experiment (Program Binary Bool) (MealyAutomaton StateID Binary Bool, Statistics MealyAutomaton StateID Binary Bool) exper = experiment learner oracle

@@ -77,7 +77,9 @@ learner = mkLMstar Star  oracle :: WpMethod-oracle = mkWpMethod (WpMethodConfig 3)+oracle = case mkWpMethod (WpMethodConfig 3) of +    Left msg -> error msg +    Right oracle' -> oracle'  exper ::     ExperimentT

@@ -85,7 +85,9 @@ --------------------------------------------------------------------------------  learner = mkLMstar Star-teacher = mkWMethod (WMethodConfig 2)+teacher = case mkWMethod (WMethodConfig 2) of +    Left msg -> error msg +    Right oracle -> oracle exper = experiment learner teacher  --------------------------------------------------------------------------------

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haal-version:        0.3.0.0+version:        0.4.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

@@ -28,8 +28,10 @@ newtype RandomWalk = RandomWalk RandomWalkConfig deriving (Show, Eq)  -- | Constructor for a 'RandomWalk' value.-mkRandomWalk :: RandomWalkConfig -> RandomWalk-mkRandomWalk = RandomWalk+mkRandomWalk :: RandomWalkConfig -> Either String RandomWalk+mkRandomWalk cfg+    | 0 <= rwlMaxSteps cfg && 0 <= rwlRestart cfg && rwlRestart cfg <= 1 = Right (RandomWalk cfg)+    | otherwise = Left ("Must be 0 <= rwlMaxSteps and 0 <= rwlRestart <= 1 but got " ++ show cfg)  -- | Generates a random walk for the automaton. randomWalkSuite :: (FiniteOrd a) => RandomWalk -> sul a o -> (RandomWalk, [[a]])@@ -39,7 +41,7 @@         randomInputs = take maxS $ randomRs (0, V.length alphabet - 1) g1         inputSequence = map (alphabet V.!) randomInputs         (inputSequence', g3) = splitWithProbability g2 restartP inputSequence-        oracle' = mkRandomWalk (RandomWalkConfig g3 maxS restartP)+        oracle' = RandomWalk (RandomWalkConfig g3 maxS restartP)      in (oracle', inputSequence')  splitWithProbability :: StdGen -> Double -> [a] -> ([[a]], StdGen)

@@ -28,8 +28,14 @@ newtype RandomWords = RandomWords RandomWordsConfig deriving (Show, Eq)  -- | Constructor for a 'RandomWords' data type.-mkRandomWords :: RandomWordsConfig -> RandomWords-mkRandomWords = RandomWords+mkRandomWords :: RandomWordsConfig -> Either String RandomWords+mkRandomWords cfg+    | 0 <= rwLimit cfg && 0 <= rwMinLength cfg && rwMinLength cfg <= rwMaxLength cfg = Right (RandomWords cfg)+    | otherwise =+        Left+            ( "Must be 0 <= rwLimit, and 0 <= rwMinLength <= rwMaxLength but got"+                ++ show cfg+            )  -- | Accessor for the 'RandomWordsConfig' of a 'RandomWords' value. randomWordsConfig :: RandomWords -> RandomWordsConfig@@ -48,7 +54,7 @@         )     aut =         let (ranWords, finalGen) = runState (replicateM count genWord) generator-            oracle = mkRandomWords (RandomWordsConfig finalGen count minL maxL)+            oracle = RandomWords (RandomWordsConfig finalGen count minL maxL)          in (oracle, ranWords)       where         alphaVec = V.fromList . Set.toList $ inputs aut

@@ -12,30 +12,29 @@ ) where  import Control.Monad (replicateM)-import qualified Data.List as List+import Control.Monad.State (runState, state) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Vector as Vec import Haal.BlackBox-import Haal.EquivalenceOracle.RandomWords (RandomWordsConfig (..), mkRandomWords, randomWordsConfig) import Haal.Experiment-import System.Random (Random (randomRs), RandomGen (split), StdGen)+import System.Random (Random (randomR), StdGen) -{- | The 'WMethodConfig' type is used to configure the W-method equivalence oracle.--}+-- | The 'WMethodConfig' type is used to configure the W-method equivalence oracle. data WMethodConfig = WMethodConfig     { wmDepth :: Int     -- ^ The number of extra states beyond the hypothesis to account for.     }     deriving (Show, Eq) -{- | The 'WMethod' type represents the W-method equivalence oracle.--}+-- | The 'WMethod' type represents the W-method equivalence oracle. newtype WMethod = WMethod WMethodConfig deriving (Show, Eq)  -- | Constructor for a 'WMethod' value.-mkWMethod :: WMethodConfig -> WMethod-mkWMethod = WMethod+mkWMethod :: WMethodConfig -> Either String WMethod+mkWMethod cfg+    | 0 <= wmDepth cfg = Right (WMethod cfg)+    | otherwise = Left ("Must be 0 <= wmDepth but got " ++ show cfg)  -- | The 'wmethodSuiteSize' function computes the size of the test suite for the W-method. wmethodSuiteSize ::@@ -97,8 +96,10 @@ newtype RandomWMethod = RandomWMethod RandomWMethodConfig deriving (Show, Eq)  -- | Constructor for a 'RandomWMethod' value.-mkRandomWMethod :: RandomWMethodConfig -> RandomWMethod-mkRandomWMethod = RandomWMethod+mkRandomWMethod :: RandomWMethodConfig -> Either String RandomWMethod+mkRandomWMethod cfg+    | 0 <= rwmLimit cfg && 0 <= rwmLength cfg = Right (RandomWMethod cfg)+    | otherwise = Left ("Must be 0 <= rwmLimit and 0 <= rwmLength but got " ++ show cfg)  -- | The 'randomWMethodSuite' function generates the test suite for the random W-method and a new oracle. randomWMethodSuite ::@@ -112,20 +113,24 @@     aut s i o ->     (RandomWMethod, [[i]]) randomWMethodSuite (RandomWMethod (RandomWMethodConfig g wpr wl)) aut =-    let rorc = mkRandomWords (RandomWordsConfig{rwMaxLength = wl, rwMinLength = 1, rwLimit = wpr, rwGen = g})-        prefixes = Map.elems $ accessSequences aut-        vecSuffixes = Vec.fromList $ Set.toList $ globalCharacterizingSet aut--        (rorc', wordBatches) = List.mapAccumL testSuite rorc (replicate (length prefixes) (undefined :: aut s i o))-        flatWords = concat wordBatches--        (gen'', gen''') = split (rwGen (randomWordsConfig rorc'))-        samples = length prefixes * wpr-        randomSuffixes = take samples $ randomRs (0, Vec.length vecSuffixes - 1) gen''-        suffixes = map (vecSuffixes Vec.!) randomSuffixes--        suite = [prefix ++ rand ++ suffix | prefix <- prefixes, rand <- flatWords, suffix <- suffixes]-     in (mkRandomWMethod (RandomWMethodConfig gen''' wpr wl), suite)+    let prefixes = Map.elems $ accessSequences aut+        suffixes = Set.toList $ globalCharacterizingSet aut+        alphaVec = Vec.fromList . Set.toList $ inputs aut+        genWord =+            if wl == 0+                then return []+                else do+                    len <- state $ randomR (1, wl)+                    replicateM+                        len+                        ( state $+                            \gen ->+                                let (ix, gen') = randomR (0, Vec.length alphaVec - 1) gen+                                 in (alphaVec Vec.! ix, gen')+                        )+        (ranWords, g') = runState (replicateM wpr genWord) g+        suite = [prefix ++ rand ++ suffix | prefix <- prefixes, rand <- ranWords, suffix <- suffixes]+     in (RandomWMethod (RandomWMethodConfig g' wpr wl), suite)  instance EquivalenceOracle RandomWMethod where     testSuite = randomWMethodSuite

@@ -31,8 +31,10 @@ newtype WpMethod = WpMethod WpMethodConfig deriving (Eq, Show)  -- | Constructor for a 'WpMethod' value.-mkWpMethod :: WpMethodConfig -> WpMethod-mkWpMethod = WpMethod+mkWpMethod :: WpMethodConfig -> Either String WpMethod+mkWpMethod cfg+    | 0 <= wpmDepth cfg = Right (WpMethod cfg)+    | otherwise = Left ("Must be 0 <= wpmDepth but got " ++ show cfg)  -- | The 'wpmethodSuiteSize' returns the number of test cases in the test suite of WpMethod. wpmethodSuiteSize ::@@ -150,8 +152,14 @@ newtype RandomWpMethod = RandomWpMethod RandomWpMethodConfig deriving (Show, Eq)  -- | Constructor for a 'RandomWpMethod' value.-mkRandomWpMethod :: RandomWpMethodConfig -> RandomWpMethod-mkRandomWpMethod = RandomWpMethod+mkRandomWpMethod :: RandomWpMethodConfig -> Either String RandomWpMethod+mkRandomWpMethod cfg+    | 0 <= rwpMin cfg && rwpMin cfg <= rwpExpected cfg && 0 <= rwpLimit cfg = Right (RandomWpMethod cfg)+    | otherwise =+        Left+            ( "Must be 0 <= rwpMin <= rwpExpected and 0 <= rwpLimit but got "+                ++ show cfg+            )  -- | Return the 'RandomWpMethod' test suite. randomWpMethodSuite ::

@@ -1,5 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-}+{- HLINT ignore "Use <$>" -}  module Utils (     statesAreEquivalent,@@ -84,7 +85,7 @@ instance Arbitrary ArbWMethod where     arbitrary = do         (ArbWMethodConfig config) <- arbitrary :: Gen ArbWMethodConfig-        return (ArbWMethod (mkWMethod config))+        return (ArbWMethod (either error id (mkWMethod config)))  instance Arbitrary ArbWpMethodConfig where     arbitrary = do@@ -93,7 +94,7 @@ instance Arbitrary ArbWpMethod where     arbitrary = do         (ArbWpMethodConfig config) <- arbitrary :: Gen ArbWpMethodConfig-        return (ArbWpMethod (mkWpMethod config))+        return (ArbWpMethod (either error id (mkWpMethod config)))  instance Arbitrary ArbRandomWordsConfig where     arbitrary = do@@ -106,7 +107,7 @@ instance Arbitrary ArbRandomWords where     arbitrary = do         (ArbRandomWordsConfig config) <- arbitrary :: Gen ArbRandomWordsConfig-        return (ArbRandomWords (mkRandomWords config))+        return (ArbRandomWords (either error id (mkRandomWords config)))  instance Arbitrary ArbRandomWalkConfig where     arbitrary = do@@ -118,7 +119,7 @@ instance Arbitrary ArbRandomWalk where     arbitrary = do         (ArbRandomWalkConfig config) <- arbitrary :: Gen ArbRandomWalkConfig-        return (ArbRandomWalk (mkRandomWalk config))+        return (ArbRandomWalk (either error id (mkRandomWalk config)))  instance Arbitrary ArbRandomWMethodConfig where     arbitrary = do@@ -130,7 +131,7 @@ instance Arbitrary ArbRandomWMethod where     arbitrary = do         (ArbRandomWMethodConfig config) <- arbitrary :: Gen ArbRandomWMethodConfig-        return (ArbRandomWMethod (mkRandomWMethod config))+        return (ArbRandomWMethod (either error id (mkRandomWMethod config)))  instance Arbitrary ArbRandomWpMethodConfig where     arbitrary = do@@ -144,7 +145,7 @@ instance Arbitrary ArbRandomWpMethod where     arbitrary = do         (ArbRandomWpMethodConfig config) <- arbitrary :: Gen ArbRandomWpMethodConfig-        return (ArbRandomWpMethod (mkRandomWpMethod config))+        return (ArbRandomWpMethod (either error id (mkRandomWpMethod config)))  class (EquivalenceOracle oracle) => OracleWrapper w oracle | w -> oracle where     unwrap :: w -> oracle