Added feature to start with a bigger table

src/AbstractLStar.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# language RecordWildCards #-}
 module AbstractLStar where
 
 import ObservationTable
@@ -59,19 +59,21 @@ learn makeComplete handleCounterExample constructHypothesis teacher s =
         eqloop s2 h = case equivalent teacher h of
                           Nothing -> trace "Yes" $ h
                           Just ces -> trace "No" $
-                              case isTrue . isEmpty $ realces h ces of
-                                  True -> eqloop s2 h
-                                  False ->
+                              if isTrue . isEmpty $ realces h ces
+                                  then eqloop s2 h
+                                  else
                                       let s3 = handleCounterExample teacher s2 ces in
                                       learn makeComplete handleCounterExample constructHypothesis teacher s3
         realces h ces = NLambda.filter (\(ce, a) -> a `neq` accepts h ce) $ membership teacher ces
 
--- Initial state is always the same in our case
-constructEmptyState :: LearnableAlphabet i => Teacher i -> State i
-constructEmptyState teacher =
+-- Initialise with the trivial table
+-- We allow to initialise with all words of length <= k,n for rows and columns
+-- Normally one should take k = n = 0
+constructEmptyState :: LearnableAlphabet i => Int -> Int -> Teacher i -> State i
+constructEmptyState k n teacher =
     let aa = Teacher.alphabet teacher in
-    let ss = singleton [] in
+    let ss = replicateSetUntil k aa in
     let ssa = pairsWith (\s a -> s ++ [a]) ss aa in
-    let ee = singleton [] in
+    let ee = replicateSetUntil n aa in
     let t = fillTable teacher (ss `union` ssa) ee in
     State{..}

src/Angluin.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# language RecordWildCards #-}
 module Angluin where
 
 import AbstractLStar
@@ -8,8 +8,8 @@ import Teacher
 import Data.List (inits, tails)
 import Debug.Trace
 import NLambda
+import Prelude (Bool (..), Maybe (..), fst, id, show, ($), (++), (.))
 import qualified Prelude hiding ()
-import Prelude (Bool(..), Maybe(..), id, ($), (.), (++), fst, show)
 
 justOne :: (Contextual a, NominalType a) => Set a -> Set a
 justOne s = mapFilter id . orbit [] . element $ s
@@ -70,12 +70,12 @@ makeCompleteAngluin = makeCompleteWith [closednessTest, consistencyTestDirect]
 -- Default: use counter examples in columns, which is slightly faster
 learnAngluin :: LearnableAlphabet i => Teacher i -> Automaton (BRow i) i
 learnAngluin teacher = learn makeCompleteAngluin useCounterExampleMP constructHypothesis teacher initial
-    where initial = constructEmptyState teacher
+    where initial = constructEmptyState 0 0 teacher
 
 -- The "classical" version, where counter examples are added as rows
 learnAngluinRows :: LearnableAlphabet i => Teacher i -> Automaton (BRow i) i
 learnAngluinRows teacher = learn makeCompleteAngluin useCounterExampleAngluin constructHypothesis teacher initial
-    where initial = constructEmptyState teacher
+    where initial = constructEmptyState 0 0 teacher
 
 
 -- Below are some variations of the above functions with different

src/Bollig.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# language RecordWildCards #-}
 module Bollig where
 
 import AbstractLStar
@@ -9,11 +9,11 @@ import Teacher
 import Data.List (tails)
 import Debug.Trace
 import NLambda
+import Prelude (Bool (..), Int, Maybe (..), fst, show, ($), (++), (.))
 import qualified Prelude hiding ()
-import Prelude (Bool(..), Maybe(..), ($), (.), (++), fst, show)
 
 rowUnion :: NominalType i => Set (BRow i) -> BRow i
-rowUnion set = Prelude.uncurry union . setTrueFalse . partition (\(_, f) -> f) $ map (\is -> (is, exists fromBool (mapFilter (\(is2, b) -> maybeIf (is `eq` is2) b) flatSet))) allIs
+rowUnion set = Prelude.uncurry union . setTrueFalse . partition snd $ map (\is -> (is, exists fromBool (mapFilter (\(is2, b) -> maybeIf (is `eq` is2) b) flatSet))) allIs
     where
         flatSet = sum set
         allIs = map fst flatSet
@@ -28,7 +28,7 @@ sublang :: NominalType i => BRow i -> BRow i -> Formula
 sublang r1 r2 = forAll fromBool $ pairsWithFilter (\(i1, f1) (i2, f2) -> maybeIf (i1 `eq` i2) (f1 `boolImplies` f2)) r1 r2
 
 sublangs :: NominalType i => BRow i -> Set (BRow i) -> Set (BRow i)
-sublangs r set = filter (\r2 -> r2 `sublang` r) set
+sublangs r = filter (`sublang` r)
 
 rfsaClosednessTest2 :: LearnableAlphabet i => State i -> TestResult i
 rfsaClosednessTest2 State{..} = case solve (isEmpty defect) of
@@ -69,6 +69,6 @@ constructHypothesisBollig State{..} = automaton q a d i f
 makeCompleteBollig :: LearnableAlphabet i => TableCompletionHandler i
 makeCompleteBollig = makeCompleteWith [rfsaClosednessTest2, rfsaConsistencyTest]
 
-learnBollig :: LearnableAlphabet i => Teacher i -> Automaton (BRow i) i
-learnBollig teacher = learn makeCompleteBollig useCounterExampleMP constructHypothesisBollig teacher initial
-    where initial = constructEmptyState teacher
+learnBollig :: LearnableAlphabet i => Int -> Int -> Teacher i -> Automaton (BRow i) i
+learnBollig k n teacher = learn makeCompleteBollig useCounterExampleMP constructHypothesisBollig teacher initial
+    where initial = constructEmptyState k n teacher

src/Main.hs

@@ -38,7 +38,7 @@ mainExample learnerName teacherName autName = do
     let h = case read learnerName of
             NomLStar    -> learnAngluinRows teacher
             NomLStarCol -> learnAngluin teacher
-            NomNLStar   -> learnBollig teacher
+            NomNLStar   -> learnBollig 1 1 teacher
     print h
 
 mainWithIO :: String -> IO ()
@@ -47,7 +47,7 @@ mainWithIO learnerName = do
     let h = case read learnerName of
             NomLStar    -> learnAngluinRows t
             NomLStarCol -> learnAngluin t
-            NomNLStar   -> learnBollig t
+            NomNLStar   -> learnBollig 0 0 t
     print h
 
 main :: IO ()

src/Main2.hs

@@ -18,7 +18,7 @@ learn alphSet = do
     let h = case read learnerName of
             NomLStar    -> learnAngluinRows t
             NomLStarCol -> learnAngluin t
-            NomNLStar   -> learnBollig t
+            NomNLStar   -> learnBollig 0 0 t
     hPrint stderr h
 
 main :: IO ()

src/NLStar.hs

@@ -57,4 +57,4 @@ makeCompleteNonDet = makeCompleteWith [nonDetClosednessTest]
 -- Default: use counter examples in columns, which is slightly faster
 learnNonDet :: LearnableAlphabet i => Teacher i -> Automaton (BRow i) i
 learnNonDet teacher = learn makeCompleteNonDet useCounterExampleMP constructHypothesisNonDet teacher initial
-    where initial = constructEmptyState teacher
+    where initial = constructEmptyState 0 0 teacher