From 513672837462fe921451d65a48bbd4962f47d556 Mon Sep 17 00:00:00 2001
From: Joshua Moerman <joshua.moerman@ou.nl>
Date: Wed, 1 May 2024 10:22:05 +0200
Subject: [PATCH] Simplified the code a little bit

---
 app/LStarMain.hs |  5 ++---
 src/LStar.hs     | 27 ++++++++++++---------------
 2 files changed, 14 insertions(+), 18 deletions(-)

diff --git a/app/LStarMain.hs b/app/LStarMain.hs
index d0bc383..518685e 100644
--- a/app/LStarMain.hs
+++ b/app/LStarMain.hs
@@ -13,7 +13,6 @@ import Data.Maybe (mapMaybe)
 import System.Environment
 import Text.Megaparsec
 
-
 debugOutput :: Bool
 debugOutput = False
 
@@ -64,5 +63,5 @@ main = do
 
   (a, b) <- runStateT learner 0
 
-  putStrLn $ "Size: " <> show a
-  putStrLn $ "MQs:  " <> show b
+  putStrLn $ "Size:  " <> show a
+  putStrLn $ "MQs:   " <> show b
diff --git a/src/LStar.hs b/src/LStar.hs
index e679164..b155fc7 100644
--- a/src/LStar.hs
+++ b/src/LStar.hs
@@ -104,35 +104,28 @@ initialiseWithA :: (Applicative f, Ord i) => [i] -> [Word i] -> [Word i] -> MQ f
 initialiseWithA alphabet rowIdcs colIdcs mq = (\content -> LStarState{..}) <$> contentA
   where
     rowIndices = Set.fromList rowIdcs
-    rowIdcsExt = rowIndices <> Set.fromList [r `snoc` a | r <- rowIdcs, a <- alphabet]
     colIndices = Set.fromList colIdcs
-    domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct rowIdcsExt colIndices
-    contentA = Map.traverseWithKey (\w _ -> mq w) domain
+    queries = [p <> m <> s | p <- rowIdcs, m <- []:fmap pure alphabet, s <- colIdcs]
+    contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
 
 -- preconditie: newRowIndices is disjunct van de huidige rowIndices en de
 -- vereniging is prefix-gesloten. (Wordt niet gechecked.)
 addRowsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
 addRowsA newRowIndices mq table@LStarState{..} = (\newContent -> table
   { content = content <> newContent
-  , rowIndices = rowIndices <> newRowIndicesSet }) <$> contentA
+  , rowIndices = rowIndices <> Set.fromList newRowIndices }) <$> contentA
   where
-    newRowIndicesExt = Set.fromList [r `snoc` a | r <- newRowIndices, a <- alphabet]
-    newRowIndicesSet = Set.fromList newRowIndices
-    newRowIndices2 = (newRowIndicesSet <> newRowIndicesExt) `Set.difference` rowIndices
-    domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct newRowIndices2 colIndices
-    contentA = Map.traverseWithKey (\w _ -> mq w) domain
+    queries = [w | p <- newRowIndices, m <- []:fmap pure alphabet, s <- Set.toList colIndices, let w = p <> m <> s, w `Map.notMember` content]
+    contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
 
 -- preconditie: zie addRows (?)
 addColumnsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
 addColumnsA newColIndices mq table@LStarState{..} = (\newContent -> table
   { content = content <> newContent
-  , colIndices = colIndices <> newColIndicesSet }) <$> contentA
+  , colIndices = colIndices <> Set.fromList newColIndices }) <$> contentA
   where
-    newColIndicesExt = Set.fromList [a `cons` c | c <- newColIndices, a <- alphabet]
-    newColIndicesSet = Set.fromList newColIndices
-    newColIndices2 = (newColIndicesSet <> newColIndicesExt) `Set.difference` colIndices
-    domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct rowIndices newColIndices2
-    contentA = Map.traverseWithKey (\w _ -> mq w) domain
+    queries = [w | p <- Set.toList rowIndices, m <- []:fmap pure alphabet, s <- newColIndices, let w = p <> m <> s, w `Map.notMember` content]
+    contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
 
 
 ------------------
@@ -167,7 +160,11 @@ makeClosedAndConsistentA mq = loop False where
 processCounterexampleA :: (Applicative f, Ord i) => Word i -> MQ f i o -> LStarState i o -> f (LStarState i o)
 processCounterexampleA ce mq table@LStarState{..} = addColumnsA newSuffixes mq table where
   shortestSuffix = minimumBy (comparing length) [suf | r <- Set.toList rowIndices, Just suf <- [stripPrefix r ce]]
+  -- Add all suffixes to the table. This ensures that the next hypothesis is bigger
   newSuffixes = filter (not . null) . tails . drop 1 $ shortestSuffix
+  -- Alternatively: Only add one suffix. This might result in the same hypothesis (and CE)
+  -- But in the end it will progress, possibly with fewer queries.
+  --newSuffixes = take 1 . filter (\s -> s `Set.notMember` colIndices) . filter (not . null) . tails . drop 1 $ shortestSuffix
 
 
 -------------