From 6337defa0e7261a1570d9872f2497965e4a37997 Mon Sep 17 00:00:00 2001
From: Joshua Moerman <lakseru@gmail.com>
Date: Thu, 30 Jun 2016 10:58:32 +0200
Subject: [PATCH] Adds a counter to the teacher (bery hacky)

---
 src/Main.hs    | 11 ++++++++++-
 src/Teacher.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 61 insertions(+), 3 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 2f3438b..57d84fe 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,8 +4,17 @@ import           Examples
 import           Teacher
 import           NLStar
 
+import           Data.IORef (readIORef)
+
 main :: IO ()
 main = do
-    let h = learnAngluin (teacherWithTarget (Examples.fifoExample 3))
+    let h = learnAngluin (countingTeacher $ teacherWithTarget (Examples.fifoExample 3))
     putStrLn "Finished! Final hypothesis ="
     print h
+    eqs <- readIORef eqCounter
+    mqs <- readIORef mqCounter
+    putStrLn "Number of equivalence queries:"
+    print eqs
+    putStrLn "Number of membership queries (and sizes+supports):"
+    print (length mqs)
+    print mqs
diff --git a/src/Teacher.hs b/src/Teacher.hs
index 6130744..39a4f6e 100644
--- a/src/Teacher.hs
+++ b/src/Teacher.hs
@@ -3,7 +3,7 @@
 
 module Teacher where
 
-import           NLambda hiding (alphabet)
+import           NLambda hiding (alphabet, when)
 import qualified NLambda (alphabet)
 
 import Debug.Trace
@@ -13,9 +13,13 @@ import           Data.List               (zip, (!!), reverse)
 import           Data.Maybe              (Maybe (..))
 import           Prelude                 (Bool (..), Int, Read, Show, error,
                                           length, return, ($), (++), (-), (<),
-                                          (==), (.), (<=))
+                                          (==), (.), (<=), (+), show, seq)
 import qualified Prelude
 import Control.Monad.Identity (Identity(..))
+import Control.Monad (when)
+import Data.IORef (IORef, readIORef, newIORef, writeIORef)
+import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Set as Set
 
 -- Used in the IO teacher
 import           System.Console.Haskeline
@@ -80,6 +84,51 @@ teacherWithTargetAndIO aut = Teacher
     , alphabet   = atoms
     }
 
+-- 4. A teacher with state (hacked, since the types don't allow for it)
+-- Useful for debugging and so on, but *very very hacky*!
+countingTeacher :: (Show i, NominalType i) => Teacher i -> Teacher i
+countingTeacher delegate = Teacher
+    { membership = \q -> increaseMQ q `seq` membership delegate q
+    , equivalent = \a -> increaseEQ a `seq` equivalent delegate a
+    , alphabet   = alphabet delegate
+    }
+    where
+        {-# NOINLINE increaseEQ #-}
+        increaseEQ _ = unsafePerformIO $ do
+            i <- readIORef eqCounter
+            let j = i + 1
+            writeIORef eqCounter j
+            return j
+        {-# NOINLINE increaseMQ #-}
+        increaseMQ q = unsafePerformIO $ do
+            -- new <- notInCache q
+            -- when new $ do
+                l <- readIORef mqCounter
+                let len = length q
+                let sup = length $ leastSupport q
+                let l2 = (len, sup) : l
+                writeIORef mqCounter l2
+        -- {-# NOINLINE cache #-}
+        -- cache = unsafePerformIO $ newIORef Set.empty
+        -- {-# NOINLINE notInCache #-}
+        -- notInCache q = do
+        --     oldCache <- readIORef cache
+        --     case q `Set.member` oldCache of
+        --         True -> return False
+        --         False -> do
+        --             let newCache = Set.insert q oldCache
+        --             writeIORef cache newCache
+        --             return True
+
+-- HACK: Counts number of equivalence queries
+eqCounter :: IORef Int
+{-# NOINLINE eqCounter #-}
+eqCounter = unsafePerformIO $ newIORef 0
+
+-- HACK: Keeps track of membership queries with: length, size of support
+mqCounter :: IORef [(Int, Int)]
+{-# NOINLINE mqCounter #-}
+mqCounter = unsafePerformIO $ newIORef []
 
 -- Implementations of above functions
 automaticMembership aut input = accepts aut input