diff --git a/lib/haskell/natural4/src/LS/Utils.hs b/lib/haskell/natural4/src/LS/Utils.hs index 931614a56..bce8e3137 100644 --- a/lib/haskell/natural4/src/LS/Utils.hs +++ b/lib/haskell/natural4/src/LS/Utils.hs @@ -9,7 +9,9 @@ module LS.Utils runMonoidValidate, swallowErrs, MonoidValidate, - (<||>) + compose, + (<||>), + (<&&>) ) where @@ -21,8 +23,8 @@ import Control.Monad.Validate ) import Data.Coerce (coerce) import Data.Either (rights, partitionEithers) -import Data.Monoid (Ap (Ap)) -import Flow ((|>)) +import Data.Monoid (Ap (Ap), Endo (Endo)) +import Flow ((|>), (.>)) infixl 0 |$> @@ -76,7 +78,15 @@ swallowErrs = mapThenSwallowErrs id runMonoidValidate :: MonoidValidate e a -> Either e a runMonoidValidate x = x |> coerce |> runValidate +-- | Function composition via the endomorphism monoid. +compose :: forall a. [a -> a] -> a -> a +compose = (coerce :: [a -> a] -> [Endo a]) .> mconcat .> coerce + -- | A simple lifted ('||'), copied from Control.Bool (<||>) :: Applicative f => f Bool -> f Bool -> f Bool (<||>) = liftA2 (||) -{-# INLINE (<||>) #-} \ No newline at end of file +{-# INLINE (<||>) #-} + +(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool +(<&&>) = liftA2 (&&) +{-# INLINE (<&&>) #-} \ No newline at end of file diff --git a/lib/haskell/natural4/src/LS/XPile/CoreL4.hs b/lib/haskell/natural4/src/LS/XPile/CoreL4.hs index 7b38a5675..ecbe687c3 100644 --- a/lib/haskell/natural4/src/LS/XPile/CoreL4.hs +++ b/lib/haskell/natural4/src/LS/XPile/CoreL4.hs @@ -211,6 +211,7 @@ import Prettyprinter.Interpolate (__di, di) import Text.Regex.TDFA (AllTextMatches (getAllTextMatches), (=~)) import Text.XML.HXT.Core qualified as HXT import ToDMN.FromL4 (genXMLTreeNoType) +import LS.Utils (compose) -- type ExprM a = Either String (Expr a) type ExprM ann a = MonoidValidate (Doc ann) (Expr a) @@ -716,7 +717,7 @@ prettyDefnCs rname cs = do replacements = [ T.replace (T.pack t) $ T.pack $ show n | (t, n) <- zip (nub myterms) x123 ] - outstr = chain replacements $ mt2text rhs + outstr = compose replacements $ mt2text rhs returntype = "Integer" pure $ if null myterms @@ -743,9 +744,6 @@ prettyDefnCs rname cs = do <> Prettyprinter.line <> commentShow "#" cl -- defn aPlusB : Integer -> Integer -> Integer = \x : Integer -> \y : Integer -> x + y where - -- Function composition via the endomorphism monoid - chain :: [a -> a] -> a -> a - chain = (coerce :: [a -> a] -> [Endo a]) .> mconcat .> coerce x123 = [[di|x#{n}|] | (n :: Int) <- [1..]] diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenLEHCs.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenLEHCs.hs index 3808177a9..dcf0c1f0a 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenLEHCs.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenLEHCs.hs @@ -13,12 +13,36 @@ module LS.XPile.LogicalEnglish.GenLEHCs (leHCFromVarsHC) where import Data.Text qualified as T import Data.HashSet qualified as HS -- import Data.Foldable (toList) --- import Debug.Trace (trace) import Data.Coerce (coerce) -- import Data.String.Interpolate ( i ) import Data.Traversable import LS.XPile.LogicalEnglish.Types + ( -- L4-related types + AtomicBPropn(..) + + -- Intermediate representation types, prisms, and consts + , TemplateVar(..) + , aposSuffix + , VarsHC(VhcF, VhcR) + , VarsFact(..) + , BaseRule(..) + , VarsRule + , AtomicPWithVars + , VCell(..) + + -- LE-related types + , LEhcCell(..) + , LEVar(..) + , NormdVars + , NormalizedVar(..) + , LEhcAtomicP + , LETemplateTxt(..) + , UnivStatus(..) + , RuleWithUnivsMarked + , LERuleForPrint + , LEhcPrint(..) + ) leHCFromVarsHC :: VarsHC -> LEhcPrint @@ -94,31 +118,38 @@ markUnivVarsInRule larule = let lerule :: BaseRule LEhcAtomicP = simplifyVAtomicP <$> larule in snd (mapAccumL markUnivVarsInAtomicPacc HS.empty lerule) - --- TODO: Look into how to do this without this much plumbing +{- TODO: I've thought of a way to do this with less plumbing using optics, +just not sure if streamlining the plumbing is worth the potential increased complexity for others -} markUnivVarsInAtomicPacc :: NormdVars -> LEhcAtomicP -> (NormdVars, AtomicBPropn UnivStatus) markUnivVarsInAtomicPacc nvars = \case ABPatomic lecells -> let (nvars', univStatuses) = markUnivVarsInLeCells nvars lecells in (nvars', ABPatomic univStatuses) + + ABPBaseIs lefts rights -> + let (nvars', leftsWithUnivStats) = markUnivVarsInLeCells nvars lefts + (nvars'', rightsWithUnivStats) = markUnivVarsInLeCells nvars' rights + in (nvars'', ABPBaseIs leftsWithUnivStats rightsWithUnivStats) + ABPIsIn t1 t2 -> isSmtg ABPIsIn t1 t2 ABPIsDiffFr t1 t2 -> isSmtg ABPIsDiffFr t1 t2 + ABPIsOpOf term opof termlst -> let (nvars', term') = identifyUnivVar nvars term (nvars'', univStatuses) = markUnivVarsInLeCells nvars' termlst in (nvars'', ABPIsOpOf term' opof univStatuses) + ABPIsOpSuchTt term ostt lecells -> let (nvars', term') = identifyUnivVar nvars term (nvars'', univStatuses) = markUnivVarsInLeCells nvars' lecells in (nvars'', ABPIsOpSuchTt term' ostt univStatuses) + where isSmtg op t1 t2 = let (nvars', t1') = identifyUnivVar nvars t1 (nvars'', t2') = identifyUnivVar nvars' t2 in (nvars'', op t1' t2') - - --- start by doing it the EASIEST possible way markUnivVarsInLeCells :: NormdVars -> [LEhcCell] -> (NormdVars, [UnivStatus]) markUnivVarsInLeCells init lecells = @@ -152,8 +183,9 @@ simplifyVAtomicP = fmap simplifyVCells simplifyVCells :: VCell -> LEhcCell simplifyVCells = \case - Pred txt -> NotVar txt - TempVar tv -> tvar2lecell tv + NonVarOrNonAposAtom txt -> NotVar txt + AposAtom prefix -> NotVar $ prefix <> aposSuffix + TempVar tv -> tvar2lecell tv tvar2lecell :: TemplateVar -> LEhcCell tvar2lecell = \case diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenNLAs.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenNLAs.hs index e5abdaf01..c63787630 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenNLAs.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/GenNLAs.hs @@ -39,6 +39,7 @@ import Data.Maybe (catMaybes) -- import Debug.Trace (trace) import Data.Coerce (coerce) +import LS.Utils ((<&&>)) import LS.XPile.LogicalEnglish.Types ( -- Common types BoolPropn(..) @@ -46,14 +47,16 @@ import LS.XPile.LogicalEnglish.Types , AtomicBPropn(..) -- Intermediate representation types , TemplateVar(..) - + , VarsHC(VhcF, VhcR) , VarsFact(..) , BaseRule(..) , VarsRule , AtomicPWithVars , VCell(..) - , _TempVar + , _TempVar, _AposAtom + , _EndsInApos + , aposSuffix ) import LS.XPile.LogicalEnglish.Utils (setInsert) import Data.String (IsString) @@ -72,7 +75,6 @@ import Optics import Data.HashSet.Optics (setOf) import Data.Sequence.Optics (seqOf) import Data.Containers.NonEmpty (NE, HasNonEmpty, nonEmpty, fromNonEmpty) --- onNonEmpty, fromNonEmpty, import Data.Sequence (Seq) import Data.Sequences (SemiSequence, intersperse) --groupAllOn import Data.List qualified as L @@ -149,12 +151,12 @@ regexifyVCells :: NE (Seq VCell) -> Either String Regex regexifyVCells = makeRegex . textify strdelimitr regexf . fromNonEmpty where strdelimitr :: String = " " + escapeTxt = PCRE.escape . T.unpack regexf = \case TempVar tvar -> tvar2WordsOrVIregex tvar - Pred nonvartxt -> (PCRE.escape . T.unpack $ nonvartxt) - --TODO: Add tests to check if have to escape metachars in Pred - -- T.unpack nonvartxt - -- PCRE.escape . T.unpack $ nonvartxt + AposAtom prefix -> escapeTxt $ prefix <> aposSuffix + NonVarOrNonAposAtom txt -> escapeTxt txt + textify :: (Foldable t, Monoid c, SemiSequence (t c), Functor t) => Element (t c) -> (a -> c) -> t a -> c textify spaceDelimtr mappingfn = fold . intersperse spaceDelimtr . fmap mappingfn @@ -333,7 +335,7 @@ rawregexifyNLAStr (T.unpack -> nlastr) = >>> splitOn "*" "a class's *a list*" ["a class's ","a list",""] -} - coreRegex = + coreRegex = splitted & itraversed %& indices isVarIdx .~ wordsOrVI & itraversed %& indices (not . isVarIdx) %~ PCRE.escape @@ -367,20 +369,32 @@ nlasFromBody varsABP = let lstNLAs = fmap nlaLoneFromVAtomicP varsABP in HS.fromList . catMaybes . toList $ lstNLAs +-- | Keeps only those VCells that we do want to generate an NLA from +keepVCells :: (Foldable f) => f VCell -> Maybe (f VCell) +keepVCells vcells = if allOf folded notEndInApos vcells then Just vcells else Nothing + where + notEndInApos = isn't (_TempVar % _EndsInApos) <&&> + isn't _AposAtom + nlaLoneFromVAtomicP :: AtomicPWithVars -> Maybe NLA nlaLoneFromVAtomicP = \case - ABPatomic vcells -> mkNLA vcells - ABPIsOpSuchTt _ _ vcells -> mkNLA vcells + ABPatomic φvcs -> selectivelyMkNLA φvcs + ABPIsOpSuchTt _ _ φvcs -> selectivelyMkNLA φvcs -- the other cases are accounted for by lib NLAs/templates, or are just built into LE - ABPIsIn{} -> Nothing -- TODO: Check if `is in` is really built into LE! Seems tt way but haven't run LE query yet + ABPBaseIs{} -> Nothing + ABPIsIn{} -> Nothing ABPIsDiffFr{} -> Nothing ABPIsOpOf{} -> Nothing + + where + selectivelyMkNLA φvcells = keepVCells φvcells >>= mkNLA vcell2NLAtxt :: VCell -> NLATxt vcell2NLAtxt = \case - TempVar tvar -> tvar2NLAtxt tvar - Pred nonvartxt -> coerce nonvartxt + TempVar tvar -> tvar2NLAtxt tvar + AposAtom prefix -> coerce $ prefix <> aposSuffix + NonVarOrNonAposAtom txt -> coerce txt tvar2NLAtxt :: TemplateVar -> NLATxt tvar2NLAtxt = \case diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/IdVars.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/IdVars.hs index 508941878..34ca69764 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/IdVars.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/IdVars.hs @@ -35,8 +35,11 @@ import LS.XPile.LogicalEnglish.Types , AtomicBPropn(..) , L4AtomicP - -- Intermediate representation types + -- Intermediate representation types, prisms, and constants , TemplateVar(..) + -- , _TempVar + --, _AposAtom, _NonVarOrNonAposAtom + -- , aposSuffix , VarsHC(MkVarsFact, MkVarsRule, vfhead, @@ -44,6 +47,7 @@ import LS.XPile.LogicalEnglish.Types , AtomicPWithVars , VCell(..) ) +import Data.String.Interpolate (i) -- $setup -- >>> import Data.Text qualified as T @@ -82,8 +86,9 @@ idVarsInBody gvars = fmap (postprocAP . idVarsInAP gvars) -- | Replace text in VCells replaceTxtVCell :: VCell -> VCell replaceTxtVCell = \case - tv@(TempVar _) -> tv - Pred txt -> Pred $ replaceTxt txt + tv@(TempVar _) -> tv + apAtm@(AposAtom _) -> apAtm + NonVarOrNonAposAtom txt -> NonVarOrNonAposAtom (replaceTxt txt) {- | TODO: Would be better to read in a dictionary of what/how to replace from some config file, @@ -91,82 +96,89 @@ a config file that is kept in sync with the downstream stuff (since have to do this kind of replacement in the converse direction when generating justification) -} replaceTxt :: T.Text -> T.Text -replaceTxt = - replacePeriod . toStrict . replaceWithTrie replacements . fromStrict +replaceTxt = replacePeriod . replaceTxtPlain + +replaceTxtPlain :: T.Text -> T.Text +replaceTxtPlain = toStrict . replaceWithTrie replacements . fromStrict + where + replacements = listToTrie $ mconcat [replaceCommaPercent, replaceInf] + + replaceInf = + [ Replace inf " inf " + | inf <- [" infinity ", " INFINITY ", " INF "] + ] + + replaceCommaPercent = + [ Replace "," " COMMA", + Replace "%" " PERCENT" + ] + {- ^ it's cleaner not to put a space after `percent` + because it's usually something like "100% blah blah" in the encoding + So if you add a space after, you end up getting "100 percent blah blah", which doesn't look as nice. + And similarly with `comma`. + + Couldn't figure out quickly how to get doc tests to work for this function, so not bothering with that for now. (TODO) + >>> replaceTxt "" + "" + >>> replaceTxt "100% guarantee" + "100 PERCENT guarantee" + + >>> replaceTxt "rocks, stones, and trees" + "rocks COMMA stones COMMA and trees" + -} + +-- LE has no trouble parsing dots that appear in numbers, ie things like +-- "clause 2.1 applies" is fine. +-- However, dots used as a full-stop, as in "The car is blue." is not ok +-- and so that "." needs to be turned into "PERIOD". +-- Also, references to clause numbers of the form "14.1.3" are not ok and so +-- must be replaced with "14.1 PERIOD 3". +replacePeriod :: T.Text -> T.Text +replacePeriod = replaceClauseNums . replaceFullStop where - replacements = - listToTrie - [ Replace "," " COMMA", - Replace "%" " PERCENT" - {- ^ it's cleaner not to put a space after `percent` - because it's usually something like "100% blah blah" in the encoding - So if you add a space after, you end up getting "100 percent blah blah", which doesn't look as nice. - And similarly with `comma`. - - Couldn't figure out quickly how to get doc tests to work for this function, so not bothering with that for now. (TODO) - >>> replaceTxt "" - "" - - >>> replaceTxt ("100.5 * 2" :: T.Text) - "100 DOT 5 * 2" - - >>> replaceTxt "100% guarantee" - "100 PERCENT guarantee" - - >>> replaceTxt "rocks, stones, and trees" - "rocks COMMA stones COMMA and trees" - -} - ] - - -- LE has no trouble parsing dots that appear in numbers, ie things like - -- "clause 2.1 applies" is fine. - -- However, dots used as a full-stop, as in "The car is blue." is not ok - -- and so that "." needs to be turned into "PERIOD". - replacePeriod = + replaceFullStop = PCRE.gsub -- https://stackoverflow.com/a/45616898 [PCRE.re|[a-zA-z] + [^0-9\s.]+|\.(?!\d)|] (" PERIOD " :: T.Text) - -- replaceHyphen = - -- PCRE.gsub - -- -- https://stackoverflow.com/a/31911114 - -- [PCRE.re|(?=\S*[-])([a-zA-Z]+)\-([a-zA-Z]+)|] - -- \(s0:s1:_) -> mconcat [s0, " HYPHEN ", s1] :: T.Text + replaceClauseNums = + PCRE.gsub + [PCRE.re|(\d+\.\d+)\.(\d+)|] + \(x:y:_ :: [T.Text]) -> [i|#{x} PERIOD #{y}|] :: T.Text + +-- replaceHyphen = +-- PCRE.gsub +-- -- https://stackoverflow.com/a/31911114 +-- [PCRE.re|(?=\S*[-])([a-zA-Z]+)\-([a-zA-Z]+)|] +-- \(s0:s1:_) -> mconcat [s0, " HYPHEN ", s1] :: T.Text {- | Convert a SimplifiedL4 Cell to a VCell The code for simplifying L4 AST has established these invariants: * every IS NUM has had the IS removed, with the number converted to T.Text and wrapped in a MkCellIsNum - * every IS tt was NOT an IS NUM has been replaced with a `MkCellT "is"`. + * every IS tt was NOT an IS NUM has been marked as belonging to the ABPBaseIs variant of AtomicBP So the only time we need to think about IS-es, going forward, is when we have a MkCellIsNum. In other words, we can convert an arbitrary Cell to a VCell as long as we know the set of given vars, without having to check what other cells are / are not around it. -} cell2vcell :: GVarSet -> Cell -> VCell cell2vcell gvars = \case - MkCellT celltxt -> - if txtIsAGivenVar gvars celltxt - then TempVar (MatchGVar celltxt) - else - let (prefix, isAposV) = isAposVar gvars celltxt - in if isAposV - then TempVar (EndsInApos prefix) - else Pred celltxt + MkCellT celltxt -> celltxt2vcell gvars celltxt MkCellIsNum numtxt -> TempVar (IsNum numtxt) +celltxt2vcell :: GVarSet -> T.Text -> VCell +celltxt2vcell gvars (T.stripSuffix "'s" -> Just prefix) = +-- NOTE / TODO: this matching on "'s" is a bit brittle cos unicode + if txtIsAGivenVar gvars prefix + then TempVar (EndsInApos prefix) + else AposAtom prefix +celltxt2vcell gvars celltxt + | txtIsAGivenVar gvars celltxt = TempVar (MatchGVar celltxt) + | otherwise = NonVarOrNonAposAtom celltxt + txtIsAGivenVar :: GVarSet -> T.Text -> Bool txtIsAGivenVar gvars txt = HS.member (coerce txt) gvars -type PrefixAposVar = T.Text -isAposVar :: GVarSet -> T.Text -> (PrefixAposVar, Bool) -isAposVar gvs (T.stripSuffix "'s" -> Just prefix) = - if txtIsAGivenVar gvs prefix - then (prefix, True) - else ("", False) -isAposVar _ _ = ("", False) --- TODO: this matching on "'s" is a bit brittle cos unicode - - -- {- Deprecating this and the next fn b/c the encoding suggests terms other than the args for op of might not just be either MatchGVar or EndsInApos --- they can also be atoms / non-variables -- -} @@ -178,7 +190,7 @@ isAposVar _ _ = ("", False) -- whichTVar :: T.Text -> TemplateVar -- whichTVar trm -- | txtIsAGivenVar gvars trm = MatchGVar trm --- | isAposVar gvars trm = EndsInApos trm +-- | checkApos gvars trm = EndsInApos trm -- | otherwise = error "shouldn't be anything else" -- -- TODO: add a check upfront for this -- optOfArg :: Cell -> TemplateVar diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Pretty.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Pretty.hs index fad55cd80..bf42022fc 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Pretty.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Pretty.hs @@ -140,6 +140,8 @@ instance Pretty TxtAtomicBP where pretty = \case ABPatomic prop -> prettyprop prop + ABPBaseIs lefts rights -> + [__di|#{prettyprop lefts} is #{prettyprop rights}|] ABPIsIn t1 t2 -> [__di|#{pretty t1} is in #{pretty t2}|] ABPIsDiffFr t1 t2 -> @@ -222,9 +224,9 @@ builtinTemplates = ] dateNlaList = - [ [di|*a date* is *a n* #{timeUnit} #{beforeAfter} *a date*|] + [ [di|*a date* is *a n* #{timeUnit} #{comparison} *a date*|] | timeUnit :: Doc ann <- ["days", "weeks", "months", "years"], - beforeAfter :: Doc ann <- ["before", "after"] + comparison :: Doc ann <- ["before", "after", "within"] ] libTemplates :: Doc ann @@ -252,7 +254,7 @@ libAndBuiltinTemplates = T.strip . myrender $ vsep [libTemplates, builtinTemplates] {- ^ >>> libAndBuiltinTemplates -"*a number* <= *a number*,\n*a date* is before *a date*,\n*a date* is after *a date*,\n*a date* is strictly before *a date*,\n*a date* is strictly after *a date*,\n*a class*'s *a field* is *a value*,\n*a class*'s nested *a list of fields* is *a value*,\n*a class*'s *a field0*'s *a field1* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3*'s *a field4* is *a value*,\n*a number* is a lower bound of *a list*,\n*a number* is an upper bound of *a list*,\n*a number* is the minimum of *a number* and the maximum of *a number* and *a number*,\nthe sum of *a list* does not exceed the minimum of *a list*,\n*a number* does not exceed the minimum of *a list*.\n*a thing* is in *a thing*,\n*a number* < *a number*,\n*a number* > *a number*,\n*a number* =< *a number*,\n*a number* >= *a number*,\n*a number* = *a number*,\n*a date* is *a n* days before *a date*,\n*a date* is *a n* days after *a date*,\n*a date* is *a n* weeks before *a date*,\n*a date* is *a n* weeks after *a date*,\n*a date* is *a n* months before *a date*,\n*a date* is *a n* months after *a date*,\n*a date* is *a n* years before *a date*,\n*a date* is *a n* years after *a date*." +"*a number* <= *a number*,\n*a date* is before *a date*,\n*a date* is after *a date*,\n*a date* is strictly before *a date*,\n*a date* is strictly after *a date*,\n*a class*'s *a field* is *a value*,\n*a class*'s nested *a list of fields* is *a value*,\n*a class*'s *a field0*'s *a field1* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3* is *a value*,\n*a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3*'s *a field4* is *a value*,\n*a number* is a lower bound of *a list*,\n*a number* is an upper bound of *a list*,\n*a number* is the minimum of *a number* and the maximum of *a number* and *a number*,\nthe sum of *a list* does not exceed the minimum of *a list*,\n*a number* does not exceed the minimum of *a list*.\n*a thing* is in *a thing*,\n*a number* < *a number*,\n*a number* > *a number*,\n*a number* =< *a number*,\n*a number* >= *a number*,\n*a number* = *a number*,\n*a date* is *a n* days before *a date*,\n*a date* is *a n* days after *a date*,\n*a date* is *a n* days within *a date*,\n*a date* is *a n* weeks before *a date*,\n*a date* is *a n* weeks after *a date*,\n*a date* is *a n* weeks within *a date*,\n*a date* is *a n* months before *a date*,\n*a date* is *a n* months after *a date*,\n*a date* is *a n* months within *a date*,\n*a date* is *a n* years before *a date*,\n*a date* is *a n* years after *a date*,\n*a date* is *a n* years within *a date*." The T.strip isn't currently necessary, but it seems like a good thing to include to pre-empt any future issues from accidentally adding whitespace. diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/SimplifyL4.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/SimplifyL4.hs index 1a92c7d20..828c8a4e2 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/SimplifyL4.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/SimplifyL4.hs @@ -15,10 +15,10 @@ module LS.XPile.LogicalEnglish.SimplifyL4 (simplifyL4rule, SimpL4(..), SimL4Error(..)) where import Data.Text qualified as T -import qualified Data.Text.Lazy as T (toStrict) -import qualified Data.Text.Lazy.Builder as B -import qualified Data.Text.Lazy.Builder.Int as B -import qualified Data.Text.Lazy.Builder.RealFloat as B +import Data.Text.Lazy qualified as T (toStrict) +import Data.Text.Lazy.Builder qualified as B +import Data.Text.Lazy.Builder.Int qualified as B +import Data.Text.Lazy.Builder.RealFloat qualified as B (FPFormat (..), formatRealFloat) import Control.Monad.Validate ( MonadValidate (..) @@ -31,7 +31,7 @@ import Data.HashSet qualified as HS import Data.Hashable (Hashable) import Data.String (IsString) -import qualified AnyAll as AA +import AnyAll qualified as AA import LS.Types qualified as L4 import LS.Types (RelationalPredicate(..), RPRel(..), MTExpr(..)) import LS.Rule qualified as L4 (Rule(..)) @@ -39,13 +39,13 @@ import LS.XPile.LogicalEnglish.Types ( BoolPropn(..) -- L4-related types , RpcRPrel(..) - + , RParithComp - + , GVar(..) , GVarSet , Cell(..) - + , SimpleL4HC(MkL4FactHc, fgiven, fhead, MkL4RuleHc, rgiven, rhead, rbody) @@ -57,7 +57,7 @@ import LS.XPile.LogicalEnglish.Types , pattern MkIsOpSuchTtBP , pattern MkIsOpOf , pattern MkIsDiffFr - , pattern MkIsIn + , pattern MkIsIn ) -- import LS.XPile.LogicalEnglish.ValidateL4Input -- (L4Rules, ValidHornls, Unvalidated, @@ -146,15 +146,8 @@ simpheadRPC = simpRPCis {- | Given left and right exprs that flank an RPIs, return a L4AtomicP where - s have been marked accordingly in the numcell, - and where the IS is otherwise made normal lowercase text. - -Two cases of IS-ing to consider: - 1. It ends with an IS - in which case we should convert the NUM to text and warp it in a MkCellIsNum - 2. It does not - in which case we should replace the IS with 'is' text - + * if it's an , that's marked accordingly in the numcell, + * otherwise it's made a ABPBaseIs An example of an is-num pattern in a RPConstraint: [ HC @@ -172,14 +165,17 @@ Two cases of IS-ing to consider: simpRPCis :: [MTExpr] -> [MTExpr] -> L4AtomicP simpRPCis exprsl exprsr = let lefts = mtes2cells exprsl - txtRPis = "is" :: T.Text in case exprsr of + -- it's an IS NUM + -- so convert the NUM to text and warp it in a MkCellIsNum (MTI int : xs) -> ABPatomic $ lefts <> [MkCellIsNum (int2Text int)] <> mtes2cells xs (MTF float : xs) -> ABPatomic $ lefts <> [MkCellIsNum (float2Text float)] <> mtes2cells xs + + -- not IS NUM _ -> - ABPatomic (lefts <> [MkCellT txtRPis] <> mtes2cells exprsr) + ABPBaseIs lefts (mtes2cells exprsr) {------------------------------------------------------------------------------- @@ -241,17 +237,20 @@ pattern TermIsSumXWhere term φx = TermIsOpSuchThat RPsum term φx {- ^ Examples of the L4 patterns - TermIsMaxXWhere: - ( RPnary RPis + +TermIsMaxXWhere: +``` + ( RPnary RPis + [ RPMT + [ MTT "savings" ] + , RPnary RPmax [ RPMT - [ MTT "savings" ] - , RPnary RPmax - [ RPMT - [ MTT "x" - , MTT "where" - , MTT "x" - , MTT "is the thing u saved" - ]]]) + [ MTT "x" + , MTT "where" + , MTT "x" + , MTT "is the thing u saved" + ]]]) +``` t1 IS NOT t2: ``` @@ -432,7 +431,15 @@ mtes2cells = fmap mte2cell Thanks to Jo Hsi for finding these! -} float2Text :: RealFloat a => a -> T.Text -float2Text = T.toStrict . B.toLazyText . B.realFloat +float2Text = T.toStrict . B.toLazyText . decFloat + +{- | Differs from B.realFloat only in that we use standard decimal notation (i.e., in the choice of FPFormat) +See https://hackage.haskell.org/package/text-2.1/docs/src/Data.Text.Lazy.Builder.RealFloat.html +-} +decFloat :: RealFloat a => a -> B.Builder +{-# SPECIALIZE decFloat :: Float -> B.Builder #-} +{-# SPECIALIZE decFloat :: Double -> B.Builder #-} +decFloat = B.formatRealFloat B.Fixed Nothing int2Text :: Integral a => a -> T.Text int2Text = T.toStrict . B.toLazyText . B.decimal @@ -453,4 +460,4 @@ pattern MkHeadErr :: T.Text -> SimL4Error pattern MkBodyErr :: T.Text -> SimL4Error pattern MkHeadErr errtxt = Error (HeadErr errtxt) pattern MkBodyErr errtxt = Error (BodyErr errtxt) --} \ No newline at end of file +-} diff --git a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Types.hs b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Types.hs index 2f9a6230f..6df31b7c9 100644 --- a/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Types.hs +++ b/lib/haskell/natural4/src/LS/XPile/LogicalEnglish/Types.hs @@ -35,9 +35,10 @@ module LS.XPile.LogicalEnglish.Types ( , pattern MkIsDiffFr , pattern MkIsIn - -- Intermediate representation types + -- Intermediate representation types, prisms, and consts , TemplateVar(..) , _MatchGVar, _EndsInApos, _IsNum + , aposSuffix , OrigVarPrefix , OrigVarSeq , VarsHC(MkVarsFact, @@ -50,7 +51,7 @@ module LS.XPile.LogicalEnglish.Types ( , VarsRule , AtomicPWithVars , VCell(..) - , _TempVar, _Pred + , _TempVar, _NonVarOrNonAposAtom, _AposAtom -- LE-related types , LEhcCell(..) @@ -116,6 +117,7 @@ In particular, it includes not only variables but also atoms. -} data AtomicBPropn term = ABPatomic [term] + | ABPBaseIs [term] [term] -- not an IS NUM! | ABPIsIn term term | ABPIsDiffFr term term -- ^ Note: the encoding has a few rules that use an atom in the rightmost term @@ -259,6 +261,27 @@ from https://hackage.haskell.org/package/hashable-generics-1.1.7/docs/Data-Hasha type OrigVarSeq = [TemplateVar] -- TODO: Look into replacing [] with a more general Sequence type? +aposSuffix :: T.Text +aposSuffix = "'s" + +{-| This is best understood in the context of the other VarsX data types -} +data VCell = TempVar TemplateVar + | AposAtom !OrigVarPrefix + | NonVarOrNonAposAtom !T.Text + deriving stock (Eq, Ord, Show) + deriving (Generic, Hashable) +makePrisms ''VCell + +{- | This might seem a bit confusing, because now there can be template variables both within a VCell and outside of it (e.g., if it's a ABPIsOpSuchTt). + But I wanted to retain information about what the original variant of AtomicBPropn was for p printing afterwards. + Also, it's helpful to have tt info for generating NLAs, + since the only time we need to generate an NLA is when we have a `baseprop` / `VCell` --- we don't need to do tt for, e.g., ABPIsDiffFr and ABPIsOpOf. + + TODO: add more comments / references to the relevant code + -} +type AtomicPWithVars = AtomicBPropn VCell + + {-| Intermediate representation from which we can generate either LE natl lang annotations or LE rules. Things to note / think about: @@ -290,21 +313,6 @@ pattern MkVarsRule{vrhead, vrbody} , rbody = vrbody}) {-# COMPLETE MkVarsFact, MkVarsRule #-} -{- | This might seem a bit confusing, because now there can be template variables both within a VCell and outside of it (e.g., if it's a ABPIsOpSuchTt). - But I wanted to retain information about what the original variant of AtomicBPropn was for p printing afterwards. - Also, it's helpful to have tt info for generating NLAs, - since the only time we need to generate an NLA is when we have a `baseprop` / `VCell` --- we don't need to do tt for ABPIsDiffFr and ABPIsOpOf. - - TODO: add more comments / references to the relevant code - -} -type AtomicPWithVars = AtomicBPropn VCell - -{-| This is best understood in the context of the other VarsX data types -} -data VCell = TempVar TemplateVar - | Pred !T.Text - deriving stock (Eq, Ord, Show) - deriving (Generic, Hashable) -makePrisms ''VCell {------------------------------------------------------------------------------- LE data types @@ -330,7 +338,7 @@ newtype NormalizedVar = MkNormVar T.Text type NormdVars = HS.HashSet NormalizedVar --- | When generating template instances / non-NLAs, we transform PreTTCells to UnivStatuses, before basically concatenating them to get LETemplateTxts +-- | Are you something we should prefix with an 'a' or not data UnivStatus = PrefixWithA !OrigVarName | NoPrefix !T.Text deriving stock (Eq, Ord, Show) diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/actual.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/actual.le similarity index 96% rename from lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/actual.le rename to lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/actual.le index f339ef0c8..127fd9137 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/actual.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/actual.le @@ -1,7 +1,7 @@ the target language is: prolog. the templates are: - *a bleh*'s one two three four five is val, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*, @@ -111,5 +111,5 @@ the knowledge base lib includes: and x does not exceed the minimum of other list. the knowledge base rules includes: - a bleh's one two three four is val - if bleh's one two three four five is val. \ No newline at end of file + not gvar's one two three four five six is val + if a bleh's one two three four five six is val. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/apos-var-no-annot.csv b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/apos-var-no-annot.csv new file mode 100644 index 000000000..36c9a5333 --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/apos-var-no-annot.csv @@ -0,0 +1,4 @@ +GIVEN,bleh,IS A,Blehy +,buh,IS A,Blehy +DECIDE,not gvar's,one two three four five six,is,val, +IF,bleh's,one two three four five six,is,val, \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/config.yml b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/config.yml new file mode 100644 index 000000000..e977b2cff --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/config.yml @@ -0,0 +1,2 @@ +description: "whenever we have an apos var (i.e. it's a gvar and it's of the form `'s`) in a condition, we won't generate an NLA for that condition" +enabled: true diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/expected.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/expected.le similarity index 96% rename from lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/expected.le rename to lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/expected.le index f339ef0c8..127fd9137 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/expected.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/apos-var-no-annot/expected.le @@ -1,7 +1,7 @@ the target language is: prolog. the templates are: - *a bleh*'s one two three four five is val, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*, @@ -111,5 +111,5 @@ the knowledge base lib includes: and x does not exceed the minimum of other list. the knowledge base rules includes: - a bleh's one two three four is val - if bleh's one two three four five is val. \ No newline at end of file + not gvar's one two three four five six is val + if a bleh's one two three four five six is val. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/actual.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/actual.le similarity index 94% rename from lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/actual.le rename to lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/actual.le index 65112a211..455cf0b2d 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/actual.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/actual.le @@ -1,9 +1,7 @@ the target language is: prolog. the templates are: - additional *a additsavings* is y, - initial *a initsavings* is x, - total *a totsavings* is z, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*, @@ -113,7 +111,5 @@ the knowledge base lib includes: and x does not exceed the minimum of other list. the knowledge base rules includes: - total a totsavings is z - if initial a initsavings is x - and additional a additsavings is y - and z is the sum of [x, y]. \ No newline at end of file + life is goodenough 4 us + if a total savings is healthy. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/base-is-no-annot.csv b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/base-is-no-annot.csv new file mode 100644 index 000000000..96b919dcc --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/base-is-no-annot.csv @@ -0,0 +1,3 @@ +GIVEN,total savings, +DECIDE,life,IS,goodenough,4,us, +IF,total savings,IS,healthy, \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/config.yml b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/config.yml new file mode 100644 index 000000000..42588ac60 --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/config.yml @@ -0,0 +1,2 @@ +description: "Something of the form IS , where does not start with any sort of number, does not generate an NLA / template" +enabled: true diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/expected.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/expected.le similarity index 94% rename from lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/expected.le rename to lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/expected.le index 65112a211..455cf0b2d 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/expected.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/base-is-no-annot/expected.le @@ -1,9 +1,7 @@ the target language is: prolog. the templates are: - additional *a additsavings* is y, - initial *a initsavings* is x, - total *a totsavings* is z, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*, @@ -113,7 +111,5 @@ the knowledge base lib includes: and x does not exceed the minimum of other list. the knowledge base rules includes: - total a totsavings is z - if initial a initsavings is x - and additional a additsavings is y - and z is the sum of [x, y]. \ No newline at end of file + life is goodenough 4 us + if a total savings is healthy. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/actual.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/actual.le new file mode 100644 index 000000000..aba876ccd --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/actual.le @@ -0,0 +1,117 @@ +the target language is: prolog. + +the templates are: + we are looking to be happy, + *a number* <= *a number*, + *a date* is before *a date*, + *a date* is after *a date*, + *a date* is strictly before *a date*, + *a date* is strictly after *a date*, + *a class*'s *a field* is *a value*, + *a class*'s nested *a list of fields* is *a value*, + *a class*'s *a field0*'s *a field1* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3*'s *a field4* is *a value*, + *a number* is a lower bound of *a list*, + *a number* is an upper bound of *a list*, + *a number* is the minimum of *a number* and the maximum of *a number* and *a number*, + the sum of *a list* does not exceed the minimum of *a list*, + *a number* does not exceed the minimum of *a list*. + + +% Predefined stdlib for translating natural4 -> LE. +the knowledge base lib includes: + a number <= an other number + if number =< other number. + + % Note: LE's parsing of [H | T] is broken atm because it transforms that + % into [H, T] rather than the Prolog term [H | T]. + + % a class's nested [] is a value. + + % a class's nested [a field | a fields] is a value + % if the class's the field is an other class + % and the other class's nested the fields is the value. + + a d0 is before a d1 + if d0 is a n days before d1 + and n >= 0. + + a d0 is strictly before a d1 + if d0 is a n days before d1 + and n > 0. + + a d0 is after a d1 + if d1 is before d0. + + a d0 is strictly after a d1 + if d1 is strictly before d0. + + % Nested accessor predicates. + a class's a field is a value + if field is different from name + and field is different from id + and a class0's name is class + or class0's id is class + and class0's field is value. + + a class's a field0's a field1 is a value + if class's field0 is a class0 + and class0's field1 is value. + + a class's a field0's a field1's a field2 is a value + if class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is value. + + a class's a field0's a field1's a field2's a field3 is a value + if class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is a class2 + and class2's field3 is value. + + a class's a field0's a field1's a field2's a field3's a field4 is a value + if the class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is a class2 + and class2's field3 is a class3 + and class3's field4 is value. + + % Arithmetic predicates. + a number is an upper bound of a list + if for all cases in which + a X is in list + it is the case that + X is [a class, a field] + and class's field is a value + and number >= value + or number >= X. + + a number is a lower bound of a list + if for all cases in which + a X is in list + it is the case that + X is [a class, a field] + and class's field is a value + and number =< value + or number =< X. + + % number = min(x, max(y, z)) + a number is the minimum of a x and the maximum of a y and a z + if a m is the maximum of [y, z] + and number is the minimum of [x, m]. + + a number does not exceed the minimum of a list of numbers + if a min is the minimum of list of numbers + and number =< min. + + the sum of a list does not exceed the minimum of a other list + if a x is the sum of list + and x does not exceed the minimum of other list. + +the knowledge base rules includes: + x's factor is 0.001. + + y's factor is 0.00009999 + if we are looking to be happy. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/config.yml b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/config.yml new file mode 100644 index 000000000..2d4f27c8a --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/config.yml @@ -0,0 +1,2 @@ +description: "decimals get converted into decimals with fixed notation" +enabled: true diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/decimals-use-fixed-notation.csv b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/decimals-use-fixed-notation.csv new file mode 100644 index 000000000..66435016d --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/decimals-use-fixed-notation.csv @@ -0,0 +1,6 @@ +GIVEN,factor,IS A,Number, +,x, +,y, +DECIDE,x's factor,IS,0.001, +,y's factor,IS,0.00009999 +,IF,we are,looking,to be happy \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/expected.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/expected.le new file mode 100644 index 000000000..aba876ccd --- /dev/null +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/decimals-use-fixed-notation/expected.le @@ -0,0 +1,117 @@ +the target language is: prolog. + +the templates are: + we are looking to be happy, + *a number* <= *a number*, + *a date* is before *a date*, + *a date* is after *a date*, + *a date* is strictly before *a date*, + *a date* is strictly after *a date*, + *a class*'s *a field* is *a value*, + *a class*'s nested *a list of fields* is *a value*, + *a class*'s *a field0*'s *a field1* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3* is *a value*, + *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3*'s *a field4* is *a value*, + *a number* is a lower bound of *a list*, + *a number* is an upper bound of *a list*, + *a number* is the minimum of *a number* and the maximum of *a number* and *a number*, + the sum of *a list* does not exceed the minimum of *a list*, + *a number* does not exceed the minimum of *a list*. + + +% Predefined stdlib for translating natural4 -> LE. +the knowledge base lib includes: + a number <= an other number + if number =< other number. + + % Note: LE's parsing of [H | T] is broken atm because it transforms that + % into [H, T] rather than the Prolog term [H | T]. + + % a class's nested [] is a value. + + % a class's nested [a field | a fields] is a value + % if the class's the field is an other class + % and the other class's nested the fields is the value. + + a d0 is before a d1 + if d0 is a n days before d1 + and n >= 0. + + a d0 is strictly before a d1 + if d0 is a n days before d1 + and n > 0. + + a d0 is after a d1 + if d1 is before d0. + + a d0 is strictly after a d1 + if d1 is strictly before d0. + + % Nested accessor predicates. + a class's a field is a value + if field is different from name + and field is different from id + and a class0's name is class + or class0's id is class + and class0's field is value. + + a class's a field0's a field1 is a value + if class's field0 is a class0 + and class0's field1 is value. + + a class's a field0's a field1's a field2 is a value + if class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is value. + + a class's a field0's a field1's a field2's a field3 is a value + if class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is a class2 + and class2's field3 is value. + + a class's a field0's a field1's a field2's a field3's a field4 is a value + if the class's field0 is a class0 + and class0's field1 is a class1 + and class1's field2 is a class2 + and class2's field3 is a class3 + and class3's field4 is value. + + % Arithmetic predicates. + a number is an upper bound of a list + if for all cases in which + a X is in list + it is the case that + X is [a class, a field] + and class's field is a value + and number >= value + or number >= X. + + a number is a lower bound of a list + if for all cases in which + a X is in list + it is the case that + X is [a class, a field] + and class's field is a value + and number =< value + or number =< X. + + % number = min(x, max(y, z)) + a number is the minimum of a x and the maximum of a y and a z + if a m is the maximum of [y, z] + and number is the minimum of [x, m]. + + a number does not exceed the minimum of a list of numbers + if a min is the minimum of list of numbers + and number =< min. + + the sum of a list does not exceed the minimum of a other list + if a x is the sum of list + and x does not exceed the minimum of other list. + +the knowledge base rules includes: + x's factor is 0.001. + + y's factor is 0.00009999 + if we are looking to be happy. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/config.yml b/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/config.yml deleted file mode 100644 index b5aab536f..000000000 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/config.yml +++ /dev/null @@ -1,2 +0,0 @@ -description: "t IS SUM t1 ...tn = t is the sum of [t1,...,tn] --- in the simple case where we are just adding two terms" -enabled: true diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/notes/sum-of-terms-simple-with-scenario.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/notes/sum-of-terms-simple-with-scenario.le deleted file mode 100644 index 5d4482e50..000000000 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/notes/sum-of-terms-simple-with-scenario.le +++ /dev/null @@ -1,117 +0,0 @@ -the target language is: prolog. - -the templates are: - additional *a additsavings* is y, - initial *a initsavings* is x, - total *a totsavings* is z, - *a class*'s *a field* is *a value*, - *a class*'s nested *a list of fields* is *a value*, - *a class*'s *a field0*'s *a field1* is *a value*, - *a class*'s *a field0*'s *a field1*'s *a field2* is *a value*, - *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3* is *a value*, - *a class*'s *a field0*'s *a field1*'s *a field2*'s *a field3*'s *a field4* is *a value*, - *a number* is a lower bound of *a list*, - *a number* is an upper bound of *a list*, - *a number* is the minimum of *a number* and the maximum of *a number* and *a number*, - the sum of *a list* does not exceed the minimum of *a list*, - *a number* does not exceed the minimum of *a list*. - - -% Predefined stdlib for translating natural4 -> LE. -the knowledge base prelude includes: - % Note: LE's parsing of [H | T] is broken atm because it transforms that - % into [H, T] rather than the Prolog term [H | T]. - - % a class's nested [] is a value. - - % a class's nested [a field | a fields] is a value - % if the class's the field is an other class - % and the other class's nested the fields is the value. - - a d0 is before a d1 - if d0 is a n days before d1 - and n >= 0. - - a d0 is strictly before a d1 - if d0 is a n days before d1 - and n > 0. - - a d0 is after a d1 - if d1 is before d0. - - a d0 is strictly after a d1 - if d1 is strictly before d0. - - % Nested accessor predicates. - a class's a field0's a field1 is a value - if class's field0 is a class0 - and class0's field1 is value. - - a class's a field0's a field1's a field2 is a value - if class's field0 is a class0 - and class0's field1 is a class1 - and class1's field2 is value. - - a class's a field0's a field1's a field2's a field3 is a value - if class's field0 is a class0 - and class0's field1 is a class1 - and class1's field2 is a class2 - and class2's field3 is value. - - a class's a field0's a field1's a field2's a field3's a field4 is a value - if the class's field0 is a class0 - and class0's field1 is a class1 - and class1's field2 is a class2 - and class2's field3 is a class3 - and class3's field4 is value. - - % Arithmetic predicates. - a number is an upper bound of a list - if for all cases in which - a X is in list - it is the case that - X is [a class, a field] - and class's field is a value - and number >= value - or number >= X. - - a number is a lower bound of a list - if for all cases in which - a X is in list - it is the case that - X is [a class, a field] - and class's field is a value - and number =< value - or number =< X. - - % number = min(x, max(y, z)) - a number is the minimum of a x and the maximum of a y and a z - if a m is the maximum of [y, z] - and number is the minimum of [x, m]. - - a number does not exceed the minimum of a list of numbers - if a min is the minimum of list of numbers - and number =< min. - - the sum of a list does not exceed the minimum of a other list - if a x is the sum of list - and x does not exceed the minimum of other list. - -the knowledge base encoding includes: - total a totsavings is z - if initial a initsavings is x - and additional a additsavings is y - and z is the sum of [x, y]. - -query q is: - 0 < 1. - -scenario simple is: - initial the savings is 1000. - additional the savings is 337. - -%query q is: -% 0 < 1. - -query totalsavings is: - total the savings is which value. \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/sum-of-terms-simple.csv b/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/sum-of-terms-simple.csv deleted file mode 100644 index c2a41f43c..000000000 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/sum-of-terms-simple/sum-of-terms-simple.csv +++ /dev/null @@ -1,9 +0,0 @@ -// might implement nicer syntax in the future,,,,,,,, -GIVEN,totsavings,,,,,,, -,initsavings,,,,,,, -,additsavings,,,,,,, -DECIDE,total,totsavings,IS,z,,,,, -IF,initial,initsavings,IS,x,,,,, -AND,additional,additsavings,IS,y,,,,, -AND,z,IS,SUM,x,,,, -,,,,y,,,, \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/config.yml b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/config.yml deleted file mode 100644 index 1a34f95de..000000000 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/config.yml +++ /dev/null @@ -1,2 +0,0 @@ -description: "regex for filtering out things matched by templates filters out NLAs where the var indicator of a template has been substituted by 1 - 4 space-separated words" -enabled: true diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/template-regex-filters-out-subbed-phrases.csv b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/template-regex-filters-out-subbed-phrases.csv deleted file mode 100644 index f8f9ea2ee..000000000 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-filters-out-subbed-phrases/template-regex-filters-out-subbed-phrases.csv +++ /dev/null @@ -1,4 +0,0 @@ -GIVEN,bleh,IS A,Blehy -,buh,IS A,Blehy -DECIDE,bleh's,one two three four,is,val, -IF,bleh's,one two three four five,is,val, \ No newline at end of file diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/actual.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/actual.le index 105abee75..5365276d7 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/actual.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/actual.le @@ -1,8 +1,7 @@ the target language is: prolog. the templates are: - *a buh* *a bleh*'s word2 is val moarrr, - wah2 *a bleh*'s word2 is val, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*, diff --git a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/expected.le b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/expected.le index 105abee75..5365276d7 100644 --- a/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/expected.le +++ b/lib/haskell/natural4/test/Testcases/LogicalEnglish/template-regex-is-anchored-start-and-end/expected.le @@ -1,8 +1,7 @@ the target language is: prolog. the templates are: - *a buh* *a bleh*'s word2 is val moarrr, - wah2 *a bleh*'s word2 is val, + *a number* <= *a number*, *a date* is before *a date*, *a date* is after *a date*,