1
Fork 0
mirror of https://github.com/Jaxan/nominal-lstar.git synced 2025-04-27 14:47:45 +02:00

Main.hs now read arguments

This commit is contained in:
Joshua Moerman 2016-07-04 15:30:00 +02:00
parent 5f51951b0d
commit 3de97f93c6
2 changed files with 43 additions and 12 deletions

View file

@ -1,20 +1,50 @@
{-# LANGUAGE ExistentialQuantification #-}
import Angluin import Angluin
import Bollig import Bollig
import Examples import Examples
import Teacher import Teacher
import ObservationTable
import NLStar import NLStar
import Data.IORef (readIORef) import Data.IORef (readIORef)
import System.Environment
import NLambda
data Learner = NomLStar | NomLStarCol | NomNLStar
deriving (Show, Read)
data Teacher = EqDFA | EqNFA Int
deriving (Show, Read)
data Aut = Fifo Int | Stack Int | Running Int | NFA1 | Bollig Int
deriving (Show, Read)
-- existential wrapper
data A = forall q i . (LearnableAlphabet i, NominalType q, Show q) => A (Automaton q i)
main :: IO () main :: IO ()
main = do main = do
let h = learnAngluin (countingTeacher $ teacherWithTarget (Examples.fifoExample 3)) [learnerName, teacherName, autName] <- getArgs
A automaton <- return $ case read autName of
Fifo n -> A $ Examples.fifoExample n
Stack n -> A $ Examples.stackExample n
Running n -> A $ Examples.runningExample atoms n
NFA1 -> A $ Examples.exampleNFA1
Bollig n -> A $ Examples.exampleNFA2 n
let teacher = case read teacherName of
EqDFA -> teacherWithTarget automaton
EqNFA k -> teacherWithTargetNonDet k automaton
let h = case read learnerName of
NomLStar -> learnAngluinRows teacher
NomLStarCol -> learnAngluin teacher
NomNLStar -> learnBollig teacher
putStrLn "Finished! Final hypothesis =" putStrLn "Finished! Final hypothesis ="
print h print h
eqs <- readIORef eqCounter --eqs <- readIORef eqCounter
mqs <- readIORef mqCounter --mqs <- readIORef mqCounter
putStrLn "Number of equivalence queries:" --putStrLn "Number of equivalence queries:"
print eqs --print eqs
putStrLn "Number of membership queries (and sizes+supports):" --putStrLn "Number of batched membership queries:"
print (length mqs) --print (length mqs)
print mqs --putStrLn "Number of membership orbits:"
--mapM_ print $ reverse mqs

View file

@ -100,24 +100,25 @@ countingTeacher delegate = Teacher
} }
where where
{-# NOINLINE increaseEQ #-} {-# NOINLINE increaseEQ #-}
increaseEQ _ = unsafePerformIO $ do increaseEQ a = unsafePerformIO $ do
i <- readIORef eqCounter i <- readIORef eqCounter
let j = i + 1 let j = i + 1
writeIORef eqCounter j writeIORef eqCounter j
return j return a
{-# NOINLINE increaseMQ #-} {-# NOINLINE increaseMQ #-}
increaseMQ q = unsafePerformIO $ do increaseMQ q = unsafePerformIO $ do
new <- newOrbitsInCache q new <- newOrbitsInCache q
l <- readIORef mqCounter l <- readIORef mqCounter
let l2 = new : l let l2 = new : l
writeIORef mqCounter l2 writeIORef mqCounter l2
return q
{-# NOINLINE cache #-} {-# NOINLINE cache #-}
cache = unsafePerformIO $ newIORef empty cache = unsafePerformIO $ newIORef empty
{-# NOINLINE newOrbitsInCache #-} {-# NOINLINE newOrbitsInCache #-}
newOrbitsInCache qs = do newOrbitsInCache qs = do
oldCache <- readIORef cache oldCache <- readIORef cache
let newQs = qs \\ oldCache let newQs = simplify $ qs \\ oldCache
writeIORef cache (oldCache `union` qs) writeIORef cache (simplify $ oldCache `union` qs)
return $ setOrbitsMaxNumber newQs return $ setOrbitsMaxNumber newQs
-- HACK: Counts number of equivalence queries -- HACK: Counts number of equivalence queries