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:
parent
5f51951b0d
commit
3de97f93c6
2 changed files with 43 additions and 12 deletions
46
src/Main.hs
46
src/Main.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue