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

(Re)moved some simplify to make it more efficient

Browse source
This commit is contained in:
Joshua Moerman 2020-11-11 16:32:41 +01:00
parent 0b046ca73f
commit 1e092a319b
1 changed files with 14 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/Bollig.hs
View file

@ -23,8 +23,8 @@ import Prelude (Bool (..), Int, Maybe (..), Show (..), snd, ($), (++), (.))
-- The teacher interface is slightly inconvenient -- The teacher interface is slightly inconvenient
-- But this is for a good reason. The type [i] -> o -- But this is for a good reason. The type [i] -> o
-- doesn't work well in nlambda -- doesn't work well in nlambda
mqToBool :: (NominalType i, Contextual i) => Teacher i -> MQ i Bool mqToBool :: NominalType i => Teacher i -> MQ i Bool
mqToBool teacher words = simplify answer mqToBool teacher words = answer
where where
realQ = membership teacher words realQ = membership teacher words
(inw, outw) = partition snd realQ (inw, outw) = partition snd realQ
@ -60,27 +60,27 @@ constructHypothesisBollig primesUpp t@Table{..} = automaton q alph d i f
i = filter (`isSubsetOf` brow t []) q i = filter (`isSubsetOf` brow t []) q
f = filter (`contains` []) q f = filter (`contains` []) q
-- TODO: compute indices of primesUpp only once -- TODO: compute indices of primesUpp only once
d0 = triplesWithFilter (\s a s2 -> maybeIf (brow t s2 `isSubsetOf` brow t (s ++ [a])) (brow t s, a, brow t s2)) rows alph rows d0 = triplesWithFilter (\s a bs2 -> maybeIf (bs2 `isSubsetOf` brow t (s ++ [a])) (brow t s, a, bs2)) rows alph q
d = filter (\(q1, _, q2) -> q1 `member` q /\ q2 `member` q) d0 d = filter (\(q1, _, _) -> q1 `member` q) d0
-- Adds all suffixes as columns -- Adds all suffixes as columns
-- TODO: do actual Rivest and Schapire -- TODO: do actual Rivest and Schapire
addCounterExample :: (NominalType i, _) => MQ i Bool -> Set [i] -> BTable i -> BTable i addCounterExample :: NominalType i => MQ i Bool -> Set [i] -> BTable i -> BTable i
addCounterExample mq ces t@Table{..} = addCounterExample mq ces t@Table{..} =
trace ("Using ce: " ++ show ces) $
let newColumns = sum . map (fromList . tails) $ ces let newColumns = sum . map (fromList . tails) $ ces
newColumnsRed = newColumns \\ columns newColumnsRed = newColumns \\ columns
in addColumns mq newColumnsRed t in addColumns mq newColumnsRed t
learnBollig :: (NominalType i, Contextual i, _) => Int -> Int -> Teacher i -> Automaton (BRow i) i learnBollig :: (NominalType i, _) => Int -> Int -> Teacher i -> Automaton (BRow i) i
learnBollig k n teacher = learnBolligLoop teacher (initialTableSize (mqToBool teacher) (alphabet teacher) k n) learnBollig k n teacher = learnBolligLoop teacher (initialTableSize (mqToBool teacher) (alphabet teacher) k n)
learnBolligLoop :: _ => Teacher i -> BTable i -> Automaton (BRow i) i learnBolligLoop :: (NominalType i, _) => Teacher i -> BTable i -> Automaton (BRow i) i
learnBolligLoop teacher t@Table{..} = learnBolligLoop teacher t@Table{..} =
let let
allRowsUpp = map (brow t) rows -- These simplify's do speed up
allRows = allRowsUpp `union` map (brow t) (rowsExt t) allRowsUpp = simplify $ map (brow t) rows
primesUpp = filter (\r -> isNotEmpty r /\ r `neq` sum (filter (`isSubsetOf` r) (allRows \\ orbit [] r))) allRowsUpp allRows = simplify $ allRowsUpp `union` map (brow t) (rowsExt t)
primesUpp = simplify $ filter (\r -> isNotEmpty r /\ r `neq` sum (filter (`isSubsetOf` r) (allRows \\ orbit [] r))) allRowsUpp
-- No worry, these are computed lazily -- No worry, these are computed lazily
closednessRes = rfsaClosednessTest primesUpp t closednessRes = rfsaClosednessTest primesUpp t
@ -90,14 +90,14 @@ learnBolligLoop teacher t@Table{..} =
trace "1. Making it rfsa closed" $ trace "1. Making it rfsa closed" $
case closednessRes of case closednessRes of
Failed newRows _ -> Failed newRows _ ->
let state2 = simplify $ addRows (mqToBool teacher) newRows t in let state2 = addRows (mqToBool teacher) newRows t in
trace ("newrows = " ++ show newRows) $ trace ("newrows = " ++ show newRows) $
learnBolligLoop teacher state2 learnBolligLoop teacher state2
Succes -> Succes ->
trace "2. Making it rfsa consistent" $ trace "2. Making it rfsa consistent" $
case consistencyRes of case consistencyRes of
Failed _ newColumns -> Failed _ newColumns ->
let state2 = simplify $ addColumns (mqToBool teacher) newColumns t in let state2 = addColumns (mqToBool teacher) newColumns t in
trace ("newcols = " ++ show newColumns) $ trace ("newcols = " ++ show newColumns) $
learnBolligLoop teacher state2 learnBolligLoop teacher state2
Succes -> Succes ->
@ -112,5 +112,6 @@ learnBolligLoop teacher t@Table{..} =
then eqloop s2 h then eqloop s2 h
else else
let s3 = addCounterExample (mqToBool teacher) ces s2 in let s3 = addCounterExample (mqToBool teacher) ces s2 in
trace ("Using ce: " ++ show ces) $
learnBolligLoop teacher s3 learnBolligLoop teacher s3
realces h ces = NLambda.filter (\(ce, a) -> a `neq` accepts h ce) $ membership teacher ces realces h ces = NLambda.filter (\(ce, a) -> a `neq` accepts h ce) $ membership teacher ces