mirror of
https://github.com/Jaxan/nominal-lstar.git
synced 2025-04-26 22:27:46 +02:00
Replaces all NominalType with Nominal
This commit is contained in:
Joshua Moerman
parent
98f9c6e295
commit
eb94b82251
19 changed files with 71 additions and 69 deletions
|
|
@ -24,7 +24,7 @@ data Aut = Fifo Int | Stack Int | Running Int | NFA1 | Bollig Int | NonResidual
|
|||
deriving (Show, Read)
|
||||
|
||||
-- existential wrapper
|
||||
data A = forall q i . (NominalType i, Contextual i, Show i, Read i, NominalType q, Show q) => A (Automaton q i)
|
||||
data A = forall q i . (Nominal i, Contextual i, Show i, Read i, Nominal q, Show q) => A (Automaton q i)
|
||||
|
||||
{- HLINT ignore "Redundant $" -}
|
||||
mainExample :: String -> String -> String -> IO ()
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ import System.IO
|
|||
data Learner = NomLStar | NomLStarCol | NomNLStar
|
||||
deriving (Show, Read)
|
||||
|
||||
learn :: (Read i, Contextual i, NominalType i, Show i) => Set i -> IO ()
|
||||
learn :: (Read i, Contextual i, Nominal i, Show i) => Set i -> IO ()
|
||||
learn alphSet = do
|
||||
[learnerName] <- getArgs
|
||||
let t = teacherWithIO2 alphSet
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ cabal-version: 2.2
|
|||
name: nominal-lstar
|
||||
version: 0.1.0.0
|
||||
author: Joshua Moerman
|
||||
copyright: (c) 2016 - 2020, Joshua Moerman
|
||||
copyright: (c) 2016 - 2023, Joshua Moerman
|
||||
build-type: Simple
|
||||
extra-source-files: README.md
|
||||
|
||||
|
|
@ -10,7 +10,8 @@ common stuff
|
|||
default-language: Haskell2010
|
||||
ghc-options: -O2 -Wall
|
||||
build-depends:
|
||||
base >= 4.8 && < 5,
|
||||
-- at most 4.17: one transitive dependency breaks with more recent base
|
||||
base >= 4.8 && < 4.17,
|
||||
haskeline,
|
||||
NLambda >= 1.1
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ import Prelude (Bool (..), Maybe (..), error, show, ($), (++), (.))
|
|||
|
||||
|
||||
-- This returns all witnesses (of the form sa) for non-closedness
|
||||
closednessTest :: (NominalType i, _) => table -> TestResult i
|
||||
closednessTest :: (Nominal i, _) => table -> TestResult i
|
||||
closednessTest t = case solve (isEmpty defect) of
|
||||
Just True -> Succes
|
||||
Just False -> trace "Not closed" $ Failed defect empty
|
||||
|
|
@ -27,7 +27,7 @@ closednessTest t = case solve (isEmpty defect) of
|
|||
defect = filter (not . hasEqRow) (rowsExt t)
|
||||
|
||||
-- We look for inconsistencies and return columns witnessing it
|
||||
consistencyTestDirect :: (NominalType i, _) => table -> TestResult i
|
||||
consistencyTestDirect :: (Nominal i, _) => table -> TestResult i
|
||||
consistencyTestDirect t = case solve (isEmpty defect) of
|
||||
Just True -> Succes
|
||||
Just False -> trace "Not consistent" $ Failed empty defect
|
||||
|
|
@ -39,7 +39,7 @@ consistencyTestDirect t = 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, _) => table -> Automaton (Row table) i
|
||||
constructHypothesis :: (Nominal i, _) => table -> Automaton (Row table) i
|
||||
constructHypothesis t = simplify $ automaton q (alph t) d i f
|
||||
where
|
||||
q = map (row t) (rows t)
|
||||
|
|
@ -48,28 +48,28 @@ constructHypothesis t = simplify $ automaton q (alph t) d i f
|
|||
f = filter (`contains` []) q
|
||||
|
||||
-- Extends the table with all prefixes of a set of counter examples.
|
||||
useCounterExampleAngluin :: (NominalType i, _) => Teacher i -> Set [i] -> table -> table
|
||||
useCounterExampleAngluin :: (Nominal i, _) => Teacher i -> Set [i] -> table -> table
|
||||
useCounterExampleAngluin teacher ces t =
|
||||
let newRows = sum . map (fromList . inits) $ ces
|
||||
newRowsRed = newRows \\ rows t
|
||||
in addRows (mqToBool teacher) newRowsRed t
|
||||
|
||||
-- This is the variant by Maler and Pnueli: Adds all suffixes as columns
|
||||
useCounterExampleMP :: (NominalType i, _) => Teacher i -> Set [i] -> table -> table
|
||||
useCounterExampleMP :: (Nominal i, _) => Teacher i -> Set [i] -> table -> table
|
||||
useCounterExampleMP teacher ces t =
|
||||
let newColumns = sum . map (fromList . tails) $ ces
|
||||
newColumnsRed = newColumns \\ cols t
|
||||
in addColumns (mqToBool teacher) newColumnsRed t
|
||||
|
||||
-- Default: use counter examples in columns, which is slightly faster
|
||||
learnAngluin :: (NominalType i, _) => Teacher i -> Automaton _ i
|
||||
learnAngluin :: (Nominal i, _) => Teacher i -> Automaton _ i
|
||||
learnAngluin teacher = learnLoop useCounterExampleMP teacher (OT.initialBTable (mqToBool teacher) (alphabet teacher))
|
||||
|
||||
-- The "classical" version, where counter examples are added as rows
|
||||
learnAngluinRows :: (NominalType i, _) => Teacher i -> Automaton _ i
|
||||
learnAngluinRows :: (Nominal i, _) => Teacher i -> Automaton _ i
|
||||
learnAngluinRows teacher = learnLoop useCounterExampleAngluin teacher (OT.initialBTable (mqToBool teacher) (alphabet teacher))
|
||||
|
||||
learnLoop :: (NominalType i, ObservationTable table i Bool, _) => _ -> Teacher i -> table -> Automaton (Row table) i
|
||||
learnLoop :: (Nominal i, ObservationTable table i Bool, _) => _ -> Teacher i -> table -> Automaton (Row table) i
|
||||
learnLoop cexHandler teacher t =
|
||||
let
|
||||
-- No worry, these are computed lazily
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import Prelude (Bool (..), Int, Maybe (..), Show (..), ($), (++), (.))
|
|||
-- This does hinder generalisations to other nominal join semi-
|
||||
-- lattices than the Booleans.
|
||||
|
||||
rfsaClosednessTest :: (NominalType i, _) => Set (Row table) -> table -> TestResult i
|
||||
rfsaClosednessTest :: (Nominal i, _) => Set (Row table) -> table -> TestResult i
|
||||
rfsaClosednessTest primesUpp t = case solve (isEmpty defect) of
|
||||
Just True -> Succes
|
||||
Just False -> trace "Not closed" $ Failed defect empty
|
||||
|
|
@ -32,7 +32,7 @@ rfsaClosednessTest primesUpp t = case solve (isEmpty defect) of
|
|||
where
|
||||
defect = filter (\ua -> row t ua `neq` sum (filter (`isSubsetOf` row t ua) primesUpp)) (rowsExt t)
|
||||
|
||||
rfsaConsistencyTest :: (NominalType i, _) => table -> TestResult i
|
||||
rfsaConsistencyTest :: (Nominal i, _) => table -> TestResult i
|
||||
rfsaConsistencyTest t = case solve (isEmpty defect) of
|
||||
Just True -> Succes
|
||||
Just False -> trace "Not consistent" $ Failed empty defect
|
||||
|
|
@ -43,7 +43,7 @@ rfsaConsistencyTest t = case solve (isEmpty defect) of
|
|||
defect = triplesWithFilter (\(u1, u2) a v -> maybeIf (not (tableAt2 (u1 ++ [a]) v) /\ tableAt2 (u2 ++ [a]) v) (a:v)) candidates (alph t) (cols t)
|
||||
tableAt2 s e = singleton True `eq` tableAt t s e
|
||||
|
||||
constructHypothesisBollig :: (NominalType i, _) => Set (Row table) -> table -> Automaton (Row table) i
|
||||
constructHypothesisBollig :: (Nominal i, _) => Set (Row table) -> table -> Automaton (Row table) i
|
||||
constructHypothesisBollig primesUpp t = automaton q (alph t) d i f
|
||||
where
|
||||
q = primesUpp
|
||||
|
|
@ -55,20 +55,20 @@ constructHypothesisBollig primesUpp t = automaton q (alph t) d i f
|
|||
|
||||
-- Adds all suffixes as columns
|
||||
-- TODO: do actual Rivest and Schapire
|
||||
addCounterExample :: (NominalType i, _) => MQ i Bool -> Set [i] -> table -> table
|
||||
addCounterExample :: (Nominal i, _) => MQ i Bool -> Set [i] -> table -> table
|
||||
addCounterExample mq ces t =
|
||||
let newColumns = sum . map (fromList . tails) $ ces
|
||||
newColumnsRed = newColumns \\ cols t
|
||||
in addColumns mq newColumnsRed t
|
||||
|
||||
learnBollig :: (NominalType i, _) => Int -> Int -> Teacher i -> Automaton _ i
|
||||
learnBollig :: (Nominal i, _) => Int -> Int -> Teacher i -> Automaton _ i
|
||||
learnBollig k n teacher = learnBolligLoop teacher (BOT.initialBTableSize (mqToBool teacher) (alphabet teacher) k n)
|
||||
|
||||
-- Slow version
|
||||
learnBolligOld :: (NominalType i, _) => Int -> Int -> Teacher i -> Automaton _ i
|
||||
learnBolligOld :: (Nominal i, _) => Int -> Int -> Teacher i -> Automaton _ i
|
||||
learnBolligOld k n teacher = learnBolligLoop teacher (SOT.initialBTableSize (mqToBool teacher) (alphabet teacher) k n)
|
||||
|
||||
learnBolligLoop :: (NominalType i, _) => Teacher i -> table -> Automaton (Row table) i
|
||||
learnBolligLoop :: (Nominal i, _) => Teacher i -> table -> Automaton (Row table) i
|
||||
learnBolligLoop teacher t =
|
||||
let
|
||||
-- These simplify's do speed up
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ import Prelude (Bool (..), Eq, Int, Ord, Show (..), (++), (.))
|
|||
import qualified Prelude ()
|
||||
|
||||
-- Helper function
|
||||
mqToSubset :: NominalType i => (Set [i] -> Set ([i], Bool)) -> Set [i] -> Set [i]
|
||||
mqToSubset :: Nominal i => (Set [i] -> Set ([i], Bool)) -> Set [i] -> Set [i]
|
||||
mqToSubset mq = mapFilter (\(i, o) -> maybeIf (fromBool o) i) . mq
|
||||
|
||||
-- A table is nothing more than a part of the language.
|
||||
|
|
@ -28,9 +28,9 @@ data Table i = Table
|
|||
, colIndices :: Set (ColumnIndex i)
|
||||
, aa :: Set i
|
||||
}
|
||||
deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
|
||||
deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual)
|
||||
|
||||
instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool where
|
||||
instance (Nominal i, Contextual i) => ObservationTable (Table i) i Bool where
|
||||
type Row (Table i) = Set [i]
|
||||
rows = rowIndices
|
||||
cols = colIndices
|
||||
|
|
@ -62,7 +62,7 @@ instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool wher
|
|||
newContent = mqToSubset mq newPartRed
|
||||
|
||||
|
||||
initialBTableWith :: NominalType i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i
|
||||
initialBTableWith :: Nominal i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i
|
||||
initialBTableWith mq alphabet newRows newColumns = Table
|
||||
{ content = content
|
||||
, domain = domain
|
||||
|
|
@ -75,8 +75,8 @@ initialBTableWith mq alphabet newRows newColumns = Table
|
|||
domain = pairsWith (++) newRows (newColumns `union` newColumnsExt)
|
||||
content = mqToSubset mq domain
|
||||
|
||||
initialBTable :: NominalType i => MQ i Bool -> Set i -> Table i
|
||||
initialBTable :: Nominal i => MQ i Bool -> Set i -> Table i
|
||||
initialBTable mq alphabet = initialBTableWith mq alphabet (singleton []) (singleton [])
|
||||
|
||||
initialBTableSize :: NominalType i => MQ i Bool -> Set i -> Int -> Int -> Table i
|
||||
initialBTableSize :: Nominal i => MQ i Bool -> Set i -> Int -> Int -> Table i
|
||||
initialBTableSize mq alphabet rs cs = initialBTableWith mq alphabet (replicateSetUntil rs alphabet) (replicateSetUntil cs alphabet)
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ import qualified Prelude ()
|
|||
-- 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, NominalType, Contextual)
|
||||
deriving (Show, Eq, Ord, Generic, Nominal, Contextual)
|
||||
|
||||
example1 :: Automaton Example1 Atom
|
||||
example1 = automaton
|
||||
|
|
@ -37,7 +37,7 @@ 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, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
example2 :: Automaton Aut2 Atom
|
||||
example2 = automaton
|
||||
|
|
@ -57,7 +57,7 @@ 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, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
example3 :: Automaton Aut3 Atom
|
||||
example3 = automaton
|
||||
|
|
@ -86,7 +86,7 @@ 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, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
example4 :: Automaton Aut4 Atom
|
||||
example4 = automaton
|
||||
|
|
@ -125,7 +125,7 @@ example4 = automaton
|
|||
|
||||
-- Accepts all two-symbols words with different atoms
|
||||
data Aut5 = Aut5Init | Aut5Store Atom | Aut5T | Aut5F
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
example5 :: Automaton Aut5 Atom
|
||||
example5 = automaton
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ import qualified Prelude ()
|
|||
-- The complement of 'all distinct atoms'
|
||||
-- Not determinizable
|
||||
data NFA1 = Initial1 | Guessed1 Atom | Final1
|
||||
deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
|
||||
deriving (Show, Eq, Ord, Generic, Nominal, Contextual)
|
||||
|
||||
exampleNFA1 :: Automaton NFA1 Atom
|
||||
exampleNFA1 = automaton
|
||||
|
|
@ -43,7 +43,7 @@ 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, NominalType, Contextual)
|
||||
deriving (Show, Eq, Ord, Generic, Nominal, Contextual)
|
||||
|
||||
exampleNFA2 :: Int -> Automaton NFA2 Atom
|
||||
exampleNFA2 n = automaton
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ import qualified Prelude ()
|
|||
-- 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, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
push :: a -> Fifo a -> Fifo a
|
||||
push x (Fifo l1 l2) = Fifo (x:l1) l2
|
||||
|
|
@ -38,7 +38,7 @@ sizeFifo (Fifo l1 l2) = length l1 + length l2
|
|||
|
||||
-- The alphabet:
|
||||
data DataInput = Put Atom | Get Atom
|
||||
deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Read, Generic, Nominal, 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
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ import qualified Prelude ()
|
|||
|
||||
-- Parametric in the alphabet, because why not?
|
||||
data NonResidual a = Q1 | Q2 a | Q3 a a | Q4 a | Q5
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
exampleNonResidual :: Automaton (NonResidual Atom) Atom
|
||||
exampleNonResidual = automaton
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ import Prelude (Eq, Ord, Read, Show)
|
|||
import qualified Prelude ()
|
||||
|
||||
data Res1 a = QR1 a | QR2 | QEmpty
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
-- Language L = { w a | a fresh for w } + {eps}, but anchored with a new symbol
|
||||
exampleResidual1 :: Automaton (Res1 Atom) DataInput
|
||||
|
|
@ -35,10 +35,10 @@ exampleResidual1 = automaton
|
|||
|
||||
-- Example when learning breaks
|
||||
data Res2 a = Guess a | GuessConfused a | Accept
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
data AlphabetR a = A a | Anc a
|
||||
deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Read, Generic, Nominal, Contextual)
|
||||
|
||||
exampleResidual2 :: Automaton (Res2 Atom) (AlphabetR Atom)
|
||||
exampleResidual2 = automaton
|
||||
|
|
|
|||
|
|
@ -18,9 +18,9 @@ import qualified Prelude ()
|
|||
|
||||
|
||||
data RunningExample a = Store [a] | Check [a] | Accept | Reject
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
runningExample :: NominalType a => Set a -> Int -> Automaton (RunningExample a) a
|
||||
runningExample :: Nominal a => Set a -> Int -> Automaton (RunningExample a) a
|
||||
runningExample alphabet 0 = automaton
|
||||
(fromList [Accept, Reject])
|
||||
alphabet
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ import qualified Prelude ()
|
|||
|
||||
-- Functional stack data type is simply a list.
|
||||
newtype Stack a = Stack [a]
|
||||
deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
|
||||
deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
|
||||
|
||||
push :: a -> Stack a -> Stack a
|
||||
push x (Stack l1) = Stack (x:l1)
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
|
||||
module ObservationTableClass where
|
||||
|
||||
import NLambda (NominalType, Set, pairsWith)
|
||||
import Data.Kind (Type)
|
||||
import NLambda (Nominal, Set, pairsWith)
|
||||
import Prelude ((++))
|
||||
|
||||
-- Words are indices to our table
|
||||
|
|
@ -14,9 +15,9 @@ type ColumnIndex i = [i]
|
|||
type MQ i o = Set [i] -> Set ([i], o)
|
||||
|
||||
-- This is a fat class, so that instances could give more efficient implementations
|
||||
class (NominalType table, NominalType i, NominalType o) => ObservationTable table i o | table -> i o where
|
||||
class (Nominal table, Nominal i, Nominal o) => ObservationTable table i o | table -> i o where
|
||||
-- The type of data in a row is determined by the table
|
||||
type Row table :: *
|
||||
type Row table :: Type
|
||||
|
||||
-- getters
|
||||
rows :: table -> Set (RowIndex i)
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ import qualified Prelude ()
|
|||
-- Except when o = Bool, more on that later
|
||||
type Fun i o = Set (i, o)
|
||||
|
||||
dom :: (NominalType i, NominalType o) => Fun i o -> Set i
|
||||
dom :: (Nominal i, Nominal o) => Fun i o -> Set i
|
||||
dom = map fst
|
||||
|
||||
-- A table is nothing more than a part of the language.
|
||||
|
|
@ -34,9 +34,9 @@ data Table i o = Table
|
|||
, colIndices :: Set (ColumnIndex i)
|
||||
, aa :: Set i
|
||||
}
|
||||
deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
|
||||
deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual)
|
||||
|
||||
instance (NominalType i, NominalType o) => ObservationTable (Table i o) i o where
|
||||
instance (Nominal i, Nominal o) => ObservationTable (Table i o) i o where
|
||||
type Row (Table i o) = Fun [i] o
|
||||
rows = rowIndices
|
||||
cols = colIndices
|
||||
|
|
@ -70,11 +70,11 @@ instance (NominalType i, NominalType o) => ObservationTable (Table i o) i o wher
|
|||
-- We can reuse the above tables for the Boolean case and
|
||||
-- perform some minor optimisations.
|
||||
newtype Boolean table = B { unB :: table }
|
||||
deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
|
||||
deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual)
|
||||
|
||||
type BTable i = Boolean (Table i Bool)
|
||||
|
||||
instance (NominalType i) => ObservationTable (BTable i) i Bool where
|
||||
instance (Nominal i) => ObservationTable (BTable i) i Bool where
|
||||
-- Special case of a boolean: functions to Booleans are subsets
|
||||
type Row (BTable i) = Set [i]
|
||||
|
||||
|
|
@ -94,7 +94,7 @@ instance (NominalType i) => ObservationTable (BTable i) i Bool where
|
|||
rowEps (B Table{..}) = mapFilter (\(i, o) -> maybeIf (fromBool o /\ i `member` colIndices) i) content
|
||||
|
||||
|
||||
initialTableWith :: (NominalType i, NominalType o) => MQ i o -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i o
|
||||
initialTableWith :: (Nominal i, Nominal o) => MQ i o -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i o
|
||||
initialTableWith mq alphabet newRows newColumns = Table
|
||||
{ content = content
|
||||
, rowIndices = newRows
|
||||
|
|
@ -106,17 +106,17 @@ initialTableWith mq alphabet newRows newColumns = Table
|
|||
domain = pairsWith (++) newRows (newColumns `union` newColumnsExt)
|
||||
content = mq domain
|
||||
|
||||
initialTable :: (NominalType i, NominalType o) => MQ i o -> Set i -> Table i o
|
||||
initialTable :: (Nominal i, Nominal o) => MQ i o -> Set i -> Table i o
|
||||
initialTable mq alphabet = initialTableWith mq alphabet (singleton []) (singleton [])
|
||||
|
||||
initialTableSize :: (NominalType i, NominalType o) => MQ i o -> Set i -> Int -> Int -> Table i o
|
||||
initialTableSize :: (Nominal i, Nominal o) => MQ i o -> Set i -> Int -> Int -> Table i o
|
||||
initialTableSize mq alphabet rs cs = initialTableWith mq alphabet (replicateSetUntil rs alphabet) (replicateSetUntil cs alphabet)
|
||||
|
||||
initialBTableWith :: NominalType i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> BTable i
|
||||
initialBTableWith :: Nominal i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> BTable i
|
||||
initialBTableWith = coerce initialTableWith
|
||||
|
||||
initialBTable :: NominalType i => MQ i Bool -> Set i -> BTable i
|
||||
initialBTable :: Nominal i => MQ i Bool -> Set i -> BTable i
|
||||
initialBTable = coerce initialTable
|
||||
|
||||
initialBTableSize :: NominalType i => MQ i Bool -> Set i -> Int -> Int -> BTable i
|
||||
initialBTableSize :: Nominal i => MQ i Bool -> Set i -> Int -> Int -> BTable i
|
||||
initialBTableSize = coerce initialTableSize
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import Prelude hiding (map)
|
|||
-- The teacher interface is slightly inconvenient
|
||||
-- But this is for a good reason. The type [i] -> o
|
||||
-- doesn't work well in nlambda
|
||||
mqToBool :: NominalType i => Teacher i -> Set [i] -> Set ([i], Bool)
|
||||
mqToBool :: Nominal i => Teacher i -> Set [i] -> Set ([i], Bool)
|
||||
mqToBool teacher qs = answer
|
||||
where
|
||||
realQ = membership teacher qs
|
||||
|
|
@ -41,7 +41,7 @@ mqToBool teacher qs = answer
|
|||
|
||||
-- 1. This is a fully automatic teacher, which has an internal automaton
|
||||
-- Only works for DFAs for now, as those can be checked for equivalence
|
||||
teacherWithTarget :: (NominalType i, NominalType q) => Automaton q i -> Teacher i
|
||||
teacherWithTarget :: (Nominal i, Nominal q) => Automaton q i -> Teacher i
|
||||
teacherWithTarget aut = Teacher
|
||||
{ membership = foreachQuery $ accepts aut
|
||||
, equivalent = automaticEquivalent bisim aut
|
||||
|
|
@ -50,7 +50,7 @@ teacherWithTarget aut = Teacher
|
|||
|
||||
-- 1b. This is a fully automatic teacher, which has an internal automaton
|
||||
-- NFA have undecidable equivalence, n is a bound on deoth of bisimulation.
|
||||
teacherWithTargetNonDet :: (Show i, Show q, NominalType i, NominalType q) => Int -> Automaton q i -> Teacher i
|
||||
teacherWithTargetNonDet :: (Show i, Show q, Nominal i, Nominal q) => Int -> Automaton q i -> Teacher i
|
||||
teacherWithTargetNonDet n aut = Teacher
|
||||
{ membership = foreachQuery $ accepts aut
|
||||
, equivalent = automaticEquivalent (bisimNonDet n) aut
|
||||
|
|
@ -62,7 +62,7 @@ teacherWithTargetNonDet n aut = Teacher
|
|||
-- Note that parsing is very unforgiving, one mistake, and there is no way back
|
||||
-- Atoms are referenced by Ints. When the user provides a counter example, we
|
||||
-- consider the whole orbit generated by it.
|
||||
teacherWithIO :: (Show i, Read i, NominalType i, Contextual i) => Set i -> Teacher i
|
||||
teacherWithIO :: (Show i, Read i, Nominal i, Contextual i) => Set i -> Teacher i
|
||||
teacherWithIO alph = Teacher
|
||||
{ membership = ioMembership
|
||||
, equivalent = ioEquivalent
|
||||
|
|
@ -70,7 +70,7 @@ teacherWithIO alph = Teacher
|
|||
}
|
||||
|
||||
-- 2b. Same as above. But with machine readable queries (except for EQs maybe)
|
||||
teacherWithIO2 :: (Show i, Read i, NominalType i, Contextual i) => Set i -> Teacher i
|
||||
teacherWithIO2 :: (Show i, Read i, Nominal i, Contextual i) => Set i -> Teacher i
|
||||
teacherWithIO2 alph = Teacher
|
||||
{ membership = ioMembership2
|
||||
, equivalent = ioEquivalent2
|
||||
|
|
@ -80,7 +80,7 @@ teacherWithIO2 alph = Teacher
|
|||
-- 3. A teacher uses a target for the mebership queries, but you for equivalence
|
||||
-- Useful as long as you don't have an equivalence check
|
||||
-- used for NFAs when there was no bounded bisimulation yet
|
||||
teacherWithTargetAndIO :: (Show i, Read i, NominalType i, Contextual i, NominalType q) => Automaton q i -> Teacher i
|
||||
teacherWithTargetAndIO :: (Show i, Read i, Nominal i, Contextual i, Nominal q) => Automaton q i -> Teacher i
|
||||
teacherWithTargetAndIO aut = Teacher
|
||||
{ membership = foreachQuery $ accepts aut
|
||||
, equivalent = ioEquivalent
|
||||
|
|
|
|||
|
|
@ -17,12 +17,12 @@ data Teacher i = Teacher
|
|||
-- Given a hypothesis, returns Nothing when equivalence or a (equivariant)
|
||||
-- set of counter examples. Needs to be quantified over q, because the
|
||||
-- learner may choose the type of the state space.
|
||||
, equivalent :: forall q. (Show q, NominalType q) => Automaton q i -> Maybe (Set [i])
|
||||
, equivalent :: forall q. (Show q, Nominal q) => Automaton q i -> Maybe (Set [i])
|
||||
-- Returns the alphabet to the learner
|
||||
, alphabet :: Set i
|
||||
}
|
||||
|
||||
-- Often a membership query is defined by a function [i] -> Formula. This wraps
|
||||
-- such a function to the required type for a membership query (see above).
|
||||
foreachQuery :: NominalType i => ([i] -> Formula) -> Set[i] -> Set ([i], Formula)
|
||||
foreachQuery :: Nominal i => ([i] -> Formula) -> Set[i] -> Set ([i], Formula)
|
||||
foreachQuery f = map (\q -> (q, f q))
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ import System.IO.Unsafe (unsafePerformIO)
|
|||
import Text.Read (readMaybe)
|
||||
|
||||
-- Posing a membership query to the terminal and waits for used to input a formula
|
||||
ioMembership :: (Show i, NominalType i, Contextual i) => Set [i] -> Set ([i], Formula)
|
||||
ioMembership :: (Show i, Nominal i, Contextual i) => Set [i] -> Set ([i], Formula)
|
||||
ioMembership queries = unsafePerformIO $ do
|
||||
cache <- readIORef mqCache
|
||||
let cachedAnswers = filter (\(a, _) -> a `member` queries) cache
|
||||
|
|
@ -41,7 +41,7 @@ ioMembership queries = unsafePerformIO $ do
|
|||
|
||||
|
||||
-- Same as above, but with a machine-readable format
|
||||
ioMembership2 :: (Show i, NominalType i, Contextual i) => Set [i] -> Set ([i], Formula)
|
||||
ioMembership2 :: (Show i, Nominal i, Contextual i) => Set [i] -> Set ([i], Formula)
|
||||
ioMembership2 queries = unsafePerformIO $ do
|
||||
cache <- readIORef mqCache
|
||||
let cachedAnswers = filter (\(a, _) -> a `member` queries) cache
|
||||
|
|
@ -73,7 +73,7 @@ newtype TestIO i = T [i]
|
|||
|
||||
-- Poses a query to the terminal, waiting for the user to provide a counter example
|
||||
-- User can pose a "test query" which is evaluated on the hypothesis
|
||||
ioEquivalent :: (Show q, NominalType q, Show i, Read i, NominalType i) => Automaton q i -> Maybe (Set [i])
|
||||
ioEquivalent :: (Show q, Nominal q, Show i, Read i, Nominal i) => Automaton q i -> Maybe (Set [i])
|
||||
ioEquivalent hypothesis = unsafePerformIO $ do
|
||||
putStrLn "\n# Is the following automaton correct?"
|
||||
putStr "# "
|
||||
|
|
@ -102,7 +102,7 @@ ioEquivalent hypothesis = unsafePerformIO $ do
|
|||
|
||||
-- Same as above but in different format.
|
||||
-- This is used for automation and benchmarking different nominal tools
|
||||
ioEquivalent2 :: (Show q, NominalType q, Show i, Read i, NominalType i) => Automaton q i -> Maybe (Set [i])
|
||||
ioEquivalent2 :: (Show q, Nominal q, Show i, Read i, Nominal i) => Automaton q i -> Maybe (Set [i])
|
||||
ioEquivalent2 hypothesis = unsafePerformIO $ do
|
||||
putStrLn "EQ\n\"Is the following automaton correct?"
|
||||
print hypothesis
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ import Prelude hiding (filter, map, not, sum)
|
|||
-- Checks bisimulation of initial states (only for DFAs)
|
||||
-- returns some counterexamples if not bisimilar
|
||||
-- returns empty set iff bisimilar
|
||||
bisim :: (NominalType i, NominalType q1, NominalType q2) => Automaton q1 i -> Automaton q2 i -> Set [i]
|
||||
bisim :: (Nominal i, Nominal q1, Nominal q2) => Automaton q1 i -> Automaton q2 i -> Set [i]
|
||||
bisim aut1 aut2 = go empty (pairsWith addEmptyWord (initialStates aut1) (initialStates aut2))
|
||||
where
|
||||
go rel todo =
|
||||
|
|
@ -37,7 +37,7 @@ bisim aut1 aut2 = go empty (pairsWith addEmptyWord (initialStates aut1) (initial
|
|||
-- I am not sure about correctness, but that is not really an issue for our
|
||||
-- use-case. Note that deciding equivalence of NFAs is undecidable, so we
|
||||
-- bound the bisimulation depth.
|
||||
bisimNonDet :: (Show i, Show q1, Show q2, NominalType i, NominalType q1, NominalType q2) => Int -> Automaton q1 i -> Automaton q2 i -> Set [i]
|
||||
bisimNonDet :: (Show i, Show q1, Show q2, Nominal i, Nominal q1, Nominal q2) => Int -> Automaton q1 i -> Automaton q2 i -> Set [i]
|
||||
bisimNonDet n aut1 aut2 = go empty (singleton ([], initialStates aut1, initialStates aut2))
|
||||
where
|
||||
go rel todo0 =
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue