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

Got rid of redundant queries + minor changes

Browse source
This commit is contained in:
Joshua Moerman 2021-02-25 14:46:12 +01:00
parent 7b41e7d97c
commit 2004c75471
2 changed files with 16 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/BooleanObservationTable.hs
View file

@ -20,16 +20,16 @@ mqToSubset mq = mapFilter (\(i, o) -> maybeIf (fromBool o) i) . mq
-- A table is nothing more than a part of the language.
-- Invariant: content is always a subset of
-- `rows * columns` union `rows * alph * columns`.
-- `domain` = `rows * columns` union `rows * alph * columns`.
data Table i = Table
{ content :: Set [i]
, domain :: Set [i]
, rowIndices :: Set (RowIndex i)
, colIndices :: Set (ColumnIndex i)
, aa :: Set i
}
deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
-- Currently, it may ask redundant membership queries
instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool where
type Row (Table i) = Set [i]
rows = rowIndices
@ -41,26 +41,31 @@ instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool wher
addRows mq newRows t@Table{..} =
t { content = content `union` newContent
, domain = domain `union` newPartRed
, rowIndices = rowIndices `union` newRows
}
where
newRowsExt = pairsWith (\r a -> r ++ [a]) newRows aa
newPart = pairsWith (++) (newRows `union` newRowsExt) colIndices
newContent = mqToSubset mq newPart
newPartRed = newPart \\ domain
newContent = mqToSubset mq newPartRed
addColumns mq newColumns t@Table{..} =
t { content = content `union` newContent
, domain = domain `union` newPartRed
, colIndices = colIndices `union` newColumns
}
where
newColumnsExt = pairsWith (:) aa newColumns
newPart = pairsWith (++) rowIndices (newColumns `union` newColumnsExt)
newContent = mqToSubset mq newPart
newPartRed = newPart \\ domain
newContent = mqToSubset mq newPartRed
initialBTableWith :: NominalType i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i
initialBTableWith mq alphabet newRows newColumns = Table
{ content = content
, domain = domain
, rowIndices = newRows
, colIndices = newColumns
, aa = alphabet

21
src/SimpleObservationTable.hs
View file

@ -67,9 +67,8 @@ instance (NominalType i, NominalType o) => ObservationTable (Table i o) i o wher
newContent = mq newPartRed
-- I could make a more specific implementation for booleans.
-- But for now we reuse the above, and do minor optimisations
-- 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)
@ -78,28 +77,22 @@ type BTable i = Boolean (Table i Bool)
instance (NominalType i) => ObservationTable (BTable i) i Bool where
-- Special case of a boolean: functions to Booleans are subsets
type Row (BTable i) = Set [i]
-- All the reusable functions are simply coerced
rows = coerce (rows :: _ => Table i Bool -> _)
cols = coerce (cols :: _ => Table i Bool -> _)
rowsExt = coerce (rowsExt :: _ => Table i Bool -> _)
colsExt = coerce (colsExt :: _ => Table i Bool -> _)
alph = coerce (alph :: _ => Table i Bool -> _)
tableAt = coerce (tableAt :: _ => Table i Bool -> _)
--rows = rowIndices . unB
--cols = colIndices . unB
--alph = aa . unB
--tableAt = tableAt . unB
addRows = coerce (addRows :: _ => _ -> _ -> Table i Bool -> Table i Bool)
addColumns = coerce (addColumns :: _ => _ -> _ -> Table i Bool -> Table i Bool)
-- TODO: slightly inefficient
-- These are specific to our representation of Row
row (B Table{..}) r = let lang = mapFilter (\(i, o) -> maybeIf (fromBool o) i) content
in filter (\a -> lang `contains` (r ++ a)) colIndices
rowEps (B Table{..}) = mapFilter (\(i, o) -> maybeIf (fromBool o /\ i `member` colIndices) i) content
--addRows mq newRows = B . addRows mq newRows . unB
addRows = coerce (addRows :: _ => _ -> _ -> Table i Bool -> Table i Bool)
--addColumns mq newColumns = B . addColumns mq newColumns . unB
addColumns = coerce (addColumns :: _ => _ -> _ -> Table i Bool -> Table i Bool)
type BRow i = Row (BTable i)
initialTableWith :: (NominalType i, NominalType o) => MQ i o -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i o
initialTableWith mq alphabet newRows newColumns = Table