diff --git a/src/AbstractLStar.hs b/src/AbstractLStar.hs index 653b83f..12df888 100644 --- a/src/AbstractLStar.hs +++ b/src/AbstractLStar.hs @@ -32,8 +32,8 @@ makeCompleteWith tests teacher state0 = go tests state0 Succes -> go ts state -- Otherwise we add the changes Failed newRows newColumns -> - let state2 = addRows teacher newRows state in - let state3 = addColumns teacher newColumns state2 in + let state2 = simplify $ addRows teacher newRows state in + let state3 = simplify $ addColumns teacher newColumns state2 in -- restart the whole business makeCompleteWith tests teacher state3 diff --git a/src/Angluin.hs b/src/Angluin.hs index de15d08..0e107a3 100644 --- a/src/Angluin.hs +++ b/src/Angluin.hs @@ -36,8 +36,8 @@ consistencyTestDirect State{..} = case solve (isEmpty defect) of -- Given a C&C table, constructs an automaton. The states are given by 2^E (not -- necessarily equivariant functions) -constructHypothesis :: NominalType i => State i -> Automaton (BRow i) i -constructHypothesis State{..} = automaton q a d i f +constructHypothesis :: LearnableAlphabet i => State i -> Automaton (BRow i) i +constructHypothesis State{..} = simplify $ automaton q a d i f where q = map (row t) ss a = aa diff --git a/src/ObservationTable.hs b/src/ObservationTable.hs index 4e5844b..517da0f 100644 --- a/src/ObservationTable.hs +++ b/src/ObservationTable.hs @@ -88,6 +88,11 @@ instance NominalType i => Conditional (State i) where toTup State{..} = (t,ss,ssa,ee,aa) fromTup (t,ss,ssa,ee,aa) = State{..} +instance (Ord i, Contextual i) => Contextual (State i) where + when f s = fromTup (when f (toTup s)) where + toTup State{..} = (t,ss,ssa,ee,aa) + fromTup (t,ss,ssa,ee,aa) = State{..} + -- Precondition: the set together with the current rows is prefix closed addRows :: LearnableAlphabet i => Teacher i -> Set [i] -> State i -> State i addRows teacher ds0 state@State{..} =