mirror of
https://github.com/Jaxan/nominal-lstar.git
synced 2025-04-27 06:37:45 +02:00
Updates it to use the new nlambda (with better support for generics).
This commit is contained in:
parent
2d1d5d7bfd
commit
b05d958666
8 changed files with 32 additions and 45 deletions
|
@ -20,11 +20,13 @@ executable NominalAngluin
|
|||
Examples.Stack,
|
||||
NLStar,
|
||||
ObservationTable,
|
||||
Teacher
|
||||
Teacher,
|
||||
Teachers.Teacher,
|
||||
Teachers.Terminal,
|
||||
Teachers.Whitebox
|
||||
build-depends:
|
||||
base >= 4.8 && < 5,
|
||||
containers,
|
||||
deepseq,
|
||||
haskeline,
|
||||
mtl,
|
||||
NLambda >= 1.1
|
||||
|
|
|
@ -4,7 +4,6 @@ module AbstractLStar where
|
|||
import ObservationTable
|
||||
import Teacher
|
||||
|
||||
import Control.DeepSeq (deepseq)
|
||||
import Debug.Trace
|
||||
import NLambda
|
||||
|
||||
|
@ -48,7 +47,6 @@ learn :: LearnableAlphabet i
|
|||
-> State i
|
||||
-> Automaton (BRow i) i
|
||||
learn makeComplete handleCounterExample constructHypothesis teacher s =
|
||||
deepseq s $ -- This helps ordering the traces somewhat.
|
||||
trace "##################" $
|
||||
trace "1. Making it complete and consistent" $
|
||||
let s2 = makeComplete teacher s in
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||
module Examples.Contrived where
|
||||
|
||||
import NLambda
|
||||
|
@ -12,8 +12,8 @@ import GHC.Generics (Generic)
|
|||
-- Example automaton from the whiteboard. Three orbits with 0, 1 and 2
|
||||
-- registers. The third orbit has a local symmetry (S2).
|
||||
data Example1 = Initial | S1 Atom | S2 (Atom, Atom)
|
||||
deriving (Show, Eq, Ord, Generic)
|
||||
instance BareNominalType Example1
|
||||
deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
|
||||
|
||||
example1 :: Automaton Example1 Atom
|
||||
example1 = automaton
|
||||
-- states, 4 orbits (of which one unreachable)
|
||||
|
@ -36,8 +36,9 @@ example1 = automaton
|
|||
|
||||
-- Accepts all even words (ignores the alphabet). Two orbits, with a
|
||||
-- trivial action. No registers.
|
||||
data Aut2 = Even | Odd deriving (Eq, Ord, Show, Generic)
|
||||
instance BareNominalType Aut2
|
||||
data Aut2 = Even | Odd
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
example2 :: Automaton Aut2 Atom
|
||||
example2 = automaton
|
||||
-- states, two orbits
|
||||
|
@ -55,8 +56,9 @@ example2 = automaton
|
|||
|
||||
-- Accepts all non-empty words with the same symbol. Three orbits: the initial
|
||||
-- state, a state with a register and a sink state.
|
||||
data Aut3 = Empty | Stored Atom | Sink deriving (Eq, Ord, Show, Generic)
|
||||
instance BareNominalType Aut3
|
||||
data Aut3 = Empty | Stored Atom | Sink
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
example3 :: Automaton Aut3 Atom
|
||||
example3 = automaton
|
||||
-- states, three orbits
|
||||
|
@ -84,8 +86,8 @@ data Aut4 = Aut4Init -- Initial state
|
|||
| Second Atom Atom -- After reading two different symbols
|
||||
| Symm Atom Atom Atom -- Accepting state with C3 symmetry
|
||||
| Sorted Atom Atom Atom -- State without symmetry
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
instance BareNominalType Aut4
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
example4 :: Automaton Aut4 Atom
|
||||
example4 = automaton
|
||||
-- states
|
||||
|
@ -123,8 +125,8 @@ example4 = automaton
|
|||
|
||||
-- Accepts all two-symbols words with different atoms
|
||||
data Aut5 = Aut5Init | Aut5Store Atom | Aut5T | Aut5F
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
instance BareNominalType Aut5
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
example5 :: Automaton Aut5 Atom
|
||||
example5 = automaton
|
||||
-- states
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Examples.ContrivedNFAs where
|
||||
|
||||
|
@ -14,8 +14,8 @@ import GHC.Generics (Generic)
|
|||
-- The complement of 'all distinct atoms'
|
||||
-- Not determinizable
|
||||
data NFA1 = Initial1 | Guessed1 Atom | Final1
|
||||
deriving (Show, Eq, Ord, Generic)
|
||||
instance BareNominalType NFA1
|
||||
deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
|
||||
|
||||
exampleNFA1 :: Automaton NFA1 Atom
|
||||
exampleNFA1 = automaton
|
||||
-- states, 4 orbits (of which one unreachable)
|
||||
|
@ -43,8 +43,8 @@ exampleNFA1 = automaton
|
|||
-- So this one *is* determinizable.
|
||||
-- Also used in the Bollig et al paper.
|
||||
data NFA2 = Initial2 | Distinguished Atom | Count Int
|
||||
deriving (Show, Eq, Ord, Generic)
|
||||
instance BareNominalType NFA2
|
||||
deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
|
||||
|
||||
exampleNFA2 n = automaton
|
||||
(singleton Initial2
|
||||
`union` map Distinguished atoms
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||
module Examples.Fifo (DataInput(..), fifoExample) where
|
||||
|
||||
import Control.DeepSeq (NFData)
|
||||
import GHC.Generics (Generic)
|
||||
import NLambda
|
||||
import Prelude (Eq, Int, Maybe (..), Ord, Show, Read, length, reverse,
|
||||
|
@ -12,7 +11,8 @@ import qualified Prelude ()
|
|||
-- Functional queue data type. First list is for push stuff onto, the
|
||||
-- second list is to pop. If the second list is empty, it will reverse
|
||||
-- the first.
|
||||
data Fifo a = Fifo [a] [a] deriving (Eq, Ord, Show, Generic)
|
||||
data Fifo a = Fifo [a] [a]
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
push :: a -> Fifo a -> Fifo a
|
||||
push x (Fifo l1 l2) = Fifo (x:l1) l2
|
||||
|
@ -35,16 +35,12 @@ sizeFifo (Fifo l1 l2) = length l1 + length l2
|
|||
-- nominal automaton.
|
||||
|
||||
-- The alphabet:
|
||||
data DataInput = Put Atom | Get Atom deriving (Eq, Ord, Show, Read, Generic, NFData)
|
||||
instance BareNominalType DataInput
|
||||
instance Contextual DataInput where
|
||||
when f (Put a) = Put (when f a)
|
||||
when f (Get a) = Get (when f a)
|
||||
data DataInput = Put Atom | Get Atom
|
||||
deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual)
|
||||
|
||||
-- The automaton: States consist of fifo queues and a sink state.
|
||||
-- This representation is not minimal at all, but that's OK, since the
|
||||
-- learner will learn a minimal anyways. The parameter n is the bound.
|
||||
instance BareNominalType a => BareNominalType (Fifo a)
|
||||
fifoExample :: Int -> Automaton (Maybe (Fifo Atom)) DataInput
|
||||
fifoExample n = automaton
|
||||
-- states
|
||||
|
|
|
@ -19,7 +19,7 @@ import GHC.Generics (Generic)
|
|||
|
||||
-- Parametric in the alphabet, because why not?
|
||||
data RunningExample a = Store [a] | Check [a] | Accept | Reject
|
||||
deriving (Eq, Ord, Show, Generic, BareNominalType)
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
runningExample alphabet 0 = automaton
|
||||
(fromList [Accept, Reject])
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||
module Examples.Stack (DataInput(..), stackExample) where
|
||||
|
||||
import Examples.Fifo (DataInput (..))
|
||||
|
@ -10,7 +10,8 @@ import qualified Prelude ()
|
|||
|
||||
|
||||
-- Functional stack data type is simply a list.
|
||||
data Stack a = Stack [a] deriving (Eq, Ord, Show, Generic)
|
||||
data Stack a = Stack [a]
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
|
||||
push :: a -> Stack a -> Stack a
|
||||
push x (Stack l1) = Stack (x:l1)
|
||||
|
@ -35,7 +36,6 @@ sizeStack (Stack l1) = length l1
|
|||
|
||||
-- The automaton: States consist of stacks and a sink state.
|
||||
-- The parameter n is the bound.
|
||||
instance BareNominalType a => BareNominalType (Stack a)
|
||||
stackExample :: Int -> Automaton (Maybe (Stack Atom)) DataInput
|
||||
stackExample n = automaton
|
||||
-- states
|
||||
|
|
|
@ -10,7 +10,6 @@ module ObservationTable where
|
|||
import NLambda hiding (fromJust)
|
||||
import Teacher
|
||||
|
||||
import Control.DeepSeq (NFData, force)
|
||||
import Data.Maybe (fromJust)
|
||||
import Debug.Trace (trace)
|
||||
import GHC.Generics (Generic)
|
||||
|
@ -43,7 +42,7 @@ type Row i o = Fun [i] o
|
|||
|
||||
-- This is a rather arbitrary set of constraints
|
||||
-- But I use them *everywhere*, so let's define them once and for all.
|
||||
type LearnableAlphabet i = (NFData i, Contextual i, NominalType i, Show i)
|
||||
type LearnableAlphabet i = (Contextual i, NominalType i, Show i)
|
||||
|
||||
-- `row is` denotes the data of a single row
|
||||
-- that is, the function E -> O
|
||||
|
@ -83,17 +82,7 @@ data State i = State
|
|||
, ee :: Set [i] -- suffixes
|
||||
, aa :: Set i -- alphabet (remains constant)
|
||||
}
|
||||
deriving (Show, Ord, Eq, Generic, NFData, BareNominalType)
|
||||
|
||||
instance NominalType i => Conditional (State i) where
|
||||
cond f s1 s2 = fromTup (cond f (toTup s1) (toTup s2)) 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{..}
|
||||
deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
|
||||
|
||||
-- Precondition: the set together with the current rows is prefix closed
|
||||
addRows :: LearnableAlphabet i => Teacher i -> Set [i] -> State i -> State i
|
||||
|
|
Loading…
Add table
Reference in a new issue