This notebook will show a natural language system which parses and interprets sentences containing multiword expressions (or "idioms"), using modern functional programming techniques.
This is implemented in Haskell, and while the narrative should be clear without knowing the language, the code might not be. We're careful to define all the core machinery inside the notebook, rather than relying on outside imports. This is to make it extra clear what is going on algorithmically. We make an exception for a parser combinator library (megaparsec) and various standard imports like Text. However, in a real application, almost all of what we define by hand is already wrapped up more concisely in the free and recursion-schemes packages, so a non-tutorial version of this code would just rely on those.
First, imports:
:e PatternSynonyms
:e TupleSections
:e BlockArguments
:e DeriveFunctor
:e OverloadedStrings
:e LambdaCase
:e GADTs
import Data.Text (Text)
import Data.List (nub)
import Prelude hiding (words, Word)
import qualified Data.Text as T
import Data.Functor.Compose (Compose (getCompose, Compose))
import Text.Megaparsec ( runParserT, ParseErrorBundle, ParsecT, (<|>), errorBundlePretty )
import Data.Void ( Void )
import Control.Monad.Cont (MonadTrans(..), join)
import Text.Megaparsec.Char.Lexer (lexeme)
import Text.Megaparsec.Char ( string, space )
-- import Data.Either.Combinators (mapRight)
import Diagrams.Prelude
Then, the core types, culminating in Tree, the type of binary branching trees.
type Lemma = Text
data Category = NounPhrase | Sentence | Category :/: Category | Category :\: Category
deriving Show
type Word = (Category, Lemma)
data Node a = Branches a a | Word Word deriving Functor
newtype Fix f = In {out :: f (Fix f)}
type Tree = Fix Node
Here is an example of a syntax tree
bartSkateboards ::Tree
bartSkateboards =
In
( Branches
(In (Word (NounPhrase, "Bart")))
( In (Word (Sentence :\: NounPhrase, "skateboards"))
)
)
And another:
bartSeesLisa ::Tree
bartSeesLisa =
In
( Branches
(In (Word (NounPhrase, "Bart")))
( In
( Branches
(In (Word ((Sentence :\: NounPhrase) :/: NounPhrase, "sees")))
(In (Word (NounPhrase, "Lisa")))
)
)
)
The goal of this notebook is to define a simple syntax and semantics for natural language, and an elegant extension to handle multiword expressions.
First, we'll need a type of denotations, or meanings.
data Meaning = Entity Text | TruthValue Bool | Pred1 (Text -> Bool) | Pred2 (Text -> Text -> Bool)
instance Show Meaning where
show (TruthValue b) = show b
show (Entity t) = T.unpack t
show _ = "Meaning"
Our choice of type for denotations, namely Meaning, is the disjoint sum of the types we would want to assign to NounPhrases, Sentences and so on. In general, we want to be able to freely vary this type, so most of our infrastructure will leave this type as a free parameter.
We now introduce the Lexicon type and an example lexicon:
type Lexicon meaning = Node meaning -> meaning
exampleLexicon :: Lexicon Meaning
exampleLexicon = \case
-- Word meanings
Word (NounPhrase, t) -> Entity t
Word (Sentence :\: NounPhrase, "skateboards") -> Pred1 (`elem` ["Bart"])
Word ((Sentence :\: NounPhrase) :/: NounPhrase, "sees") -> Pred2 (curry (`elem` [("Bart", "Lisa")]))
-- Composition rules
Branches (Entity i) (Pred1 f) -> TruthValue (f i)
Branches (Pred2 f) (Entity i) -> Pred1 (f i)
_ -> error "Not in exampleLexicon"
This lexicon tells you how to assign a meaning to any node. If the node is just a leaf, i.e. a word, then it gets mapped to a meaning. If the node is a branching node, then we just say how to combine the meanings of the left and right branches.
This enables us to define our semantics with one very concise higher order function, which is parametrized by a lexicon, and returns a function from a syntax tree to a meaning.
-- fold :: Lexicon meaning -> Tree -> meaning
fold :: Functor f => (f b -> b) -> Fix f -> b
fold lexicon = lexicon . fmap (fold lexicon) . out
This is all we need to interpret sentences! For example:
fold exampleLexicon bartSkateboards
fold exampleLexicon bartSeesLisa
True
False
Some notes:
fold does is to recurse over the syntax tree: at each node, it consults the lexicon. If the node is a leaf, the lexicon says how to convert the word at the leaf into a meaning. If the node contains a left and right subtree, the lexicon says how to combine the meanings (obtained by calling fold) of the subtreesfold to a lexicon is compositional by designBecause fold is so general, we can use it with other Lexicons, to obtain other kinds of results. For example, the linearization of bartSkateboards into a sentence is obtained as follows:
linearizer :: Lexicon Text
linearizer = \case
Word (_, t) -> t
Branches left right -> "(" <> left <> " " <> right <> ")"
fold linearizer bartSkateboards
fold linearizer bartSeesLisa
"(Bart skateboards)"
"(Bart (sees Lisa))"
A more interesting example is the construction of a diagram from a sentence, like so:
:e FlexibleContexts
arrowStyle = (with & lengths .~ none
& shaftStyle %~ lw thick )
-- diagramatizer :: Node (Diagram (V2 Double)) -> Diagram (V2 Double)
diagramatizer = \case
Word (_, t) -> (
lc white (rect (fromIntegral (T.length t) / 7) 0.3) <> (scaleY 0.2 $ scaleX 0.2 $ text $ T.unpack t),
show t)
Branches (left, str1) (right, str2) ->
(((circle 0.2 # named (str1<>"l"<>str2<>"r")) === (
(translate (V2 (-1) (-1)) (left # named (str1<>"l")))
||| (rect 2 1 # lc white) |||
(translate (V2 (1) (-1)) (right # named (str2<>"r"))) )
)
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str1<>"l")
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str2<>"r") ,
(str1<>str2))
diagram $ fst $ fold diagramatizer bartSeesLisa
bartSeesLisaAndBartSkateboards =
In (Branches
bartSeesLisa
(In $ Branches
(In $ Word (NounPhrase, "and"))
bartSkateboards))
diagram $ fst $ fold diagramatizer bartSeesLisaAndBartSkateboards
In natural language, we often encounter situations where standard compositionality doesn't feel sufficient. Consider:
bartSeesReason ::Tree
bartSeesReason =
In
( Branches
(In (Word (NounPhrase, "Bart")))
( In
( Branches
(In (Word ((Sentence :\: NounPhrase) :/: NounPhrase, "sees")))
(In (Word (NounPhrase, "reason")))
)
)
)
diagram $ fst $ fold diagramatizer bartSeesReason
Here, "Bart sees reason" is syntactically like "Bart sees Lisa", but there is a semantic difference. In particular, sees Lisa has a meaning which can be derived compositionally, by combining the meanings of sees and Lisa. By contrast, sees reason is more like a unit on its own, not derived by combining the meanings of sees and reason.
What we would like is to have sees reason as a unit in the lexicon. A hacky way to do this would be to concatenate to form "sees_reason" and treat it as a word. But it's easy to see that this doesn't address the broader problem. For once thing, the words in a multiword expression like "take Entity to task" need not be contiguous.
Multiword expressions can also have subparts which are derived compositionally, as in: takes NUMBER minutes, where NUMBER is itself the result of evaluating a subtree like three or two and a half.
What we want is to expand our notion of what a lexicon is, so that we can lookup not just words and rules of composition, but also evaluated trees. For example, we'd like to look up the tree "takes (NUMBER minutes)" in our lexicon, where NUMBER is the result of evaluating in turn the relevant subtree.
What's nice about our current approach is that instead of starting from scratch, we can just generalize our notions of a Lexicon and fold to accomodate our new needs. And in fact, the theoretical computer science literature provides exactly the correct generalization, in this rather technical paper. Fortunately, the paper's core insight is convertable into code, which we'll see below.
In short, we'll move from Lexicon to GeneralizedLexicon, which will be able to lookup trees. Correspondingly, instead of using fold for the semantics, we will use a generalization we'll call generalizedFold.
data Both f a b = Both a (f b)
type Evaluated f a = Fix (Both f a)
type GeneralizedLexicon = Node (Evaluated Node Meaning) -> Meaning
Lexicon took a Node containing either a word or a pair of Meanings and returned a Meaning. GeneralizedLexicon takes a Node containing either a word or a pair of evaluated trees and returns a Meaning.
An evaluated tree, with type Evaluated Node Meaning, is a tree where at each node, the result of evaluating the tree up to that node is stored alongside the node.
So, a generalized lexicon is able to make a meaning for a node depend not just on the meanings of the node's left and right subtrees, but on the entire evaluated left and right subtrees.
evaluatedTree =
In $ Both (TruthValue True) (Branches
(In $ Both (Entity "Bart") (Word (NounPhrase, "Bart")))
(In $ Both (Pred1 (`elem` ["Bart"]))
(Branches
(In $ Both (Pred2 (const $ const True)) $ Word (Sentence :\: NounPhrase, "sees"))
(In $ Both (Entity "Lisa") $ Word (Sentence :\: NounPhrase, "Lisa"))
)
) )
instance Functor f => Functor (Both f a) where
fmap f (Both a fb) = Both a (fmap f fb)
instance Show Meaning where
show (Entity e) = "Meaning: " <> show e
show (TruthValue b) = "Meaning: " <> show b
show (Pred1 _) = "Meaning: Pred1"
show (Pred2 _) = "Meaning: Pred2"
evaluatedTreeDiagramatizer = \case
Both meaning (Word (_, t)) -> (
lc white (rect (fromIntegral (length (show meaning <> T.unpack t)) / 7) 0.3)
<> scaleY 0.2 (scaleX 0.2 $ text ( show meaning <> " + " <> T.unpack t)),
show t)
Both meaning (Branches (left, str1) (right, str2)) ->
((
(lc white (rect (fromIntegral (length (show meaning)) / 7) 0.3) <> scale 0.2 (text (show meaning <> " + ") # fc red ))
||| (circle 0.2 # named (str1<>"l"<>str2<>"r")) === (
translate (V2 (-1) (-1)) (left # named (str1<>"l"))
||| (rect 2 1 # lc white) |||
translate (V2 1 (-1)) (right # named (str2<>"r")) )
)
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str1<>"l")
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str2<>"r") ,
str1<>str2)
diagram $ fst $ fold evaluatedTreeDiagramatizer evaluatedTree
Here's a generalized lexicon. It contains the idioms discussed above:
Parse error (line 1, column 70): parse error (possibly incorrect indentation or mismatched brackets)
exampleGeneralizedLexicon :: GeneralizedLexicon
exampleGeneralizedLexicon = \case
Word (NounPhrase, t) -> Entity t
Word (Sentence :\: NounPhrase, "skateboards") -> Pred1 (`elem` ["Bart"])
Word ((Sentence :\: NounPhrase) :/: NounPhrase, "sees") -> Pred2 (curry (`elem` [("Bart", "Lisa")]))
Word (_, n)
| n == "5" -> Entity "5"
Branches
( Tree (Word (Sentence :/: NounPhrase, "sees")))
(Tree (Word (NounPhrase, "reason")))
-> Pred1 (`elem` ["Lisa"])
Branches
(Tree (Word (_, "goes")))
(Tree (Word (_, "wild")))
-> Pred1 (`elem` ["Bart"])
Branches
( Tree (Word (_, "takes")))
( Tree (Branches
(Meaning (Entity i))
(Tree (Branches
(Tree (Word (_, "to")))
(Tree (Word (_, "task")))))))
-> Pred1 \case
"Lisa" -> (i `elem` ["Lisa", "Bart"])
_ -> False
Branches (Meaning (Entity i)) (Meaning (Pred1 f)) -> TruthValue (f i)
Branches (Meaning (Pred2 f)) (Meaning (Entity i)) -> Pred1 (f i)
_ -> error "Not in generalized lexicon"
pattern Meaning :: a -> Evaluated Node a
pattern Meaning a <- (In (Both a _))
pattern Tree :: f (Evaluated f a) -> Evaluated f a
pattern Tree a <- (In (Both _ a))
We now need to write generalizedFold, which should have type GeneralizedLexicon -> Tree -> Meaning. This is a little more complex than fold, but is still only around 10 lines:
generalizedFold :: GeneralizedLexicon -> Tree -> Meaning
generalizedFold g = g . extract . c where
c = distribute . fmap (duplicate . emap g . c) . out
emap :: (a -> b) -> Evaluated Node a -> Evaluated Node b
emap f (In (Both a b)) = In (Both (f a) (fmap (emap f) b))
duplicate :: Evaluated Node a -> Evaluated Node (Evaluated Node a)
duplicate w = In $ Both w (fmap duplicate (unwrap w))
distribute :: Node (Evaluated Node a) -> Evaluated Node (Node a)
distribute fc = In $ Both (fmap extract fc) (fmap (distribute . unwrap) fc)
extract :: Evaluated f a -> a
extract (In (Both a _)) = a
unwrap :: Evaluated f a -> f (Evaluated f a)
unwrap (In (Both _ b)) = b
Finally we can do:
generalizedFold exampleGeneralizedLexicon bartSkateboards
Meaning: True
The second part of this story relates to the syntax. As it happens, there is a beautiful symmetry between the semantics and the syntax. Roughly, the semantics consumes trees, while the syntax produces them, and accordingly, instead of writing folds using Lexicons, we'll be writing unfolds using Grammars.
We now describe what a grammar is, and introduce a simple parser.
type Grammar = Category -> Compose [] Node Category
exampleGrammar :: Grammar
exampleGrammar = Compose . \case
Sentence -> [Branches NounPhrase (Sentence :\: NounPhrase)]
NounPhrase -> [
Word (NounPhrase, "Bart"),
Word (NounPhrase, "Lisa"),
Word (NounPhrase, "reason"),
Branches (NounPhrase :/: (Sentence :/: NounPhrase)) (Sentence :/: NounPhrase)]
verbphrase@(Sentence :\: NounPhrase) -> [
Word (verbphrase,"skateboards"),
Branches ((Sentence :\: NounPhrase) :/: NounPhrase) NounPhrase]
verb@((Sentence :\: NounPhrase) :/: NounPhrase) -> [
Word (verb, "sees"),
Word (verb, "takes")
]
noun@(Sentence :/: NounPhrase) -> [Word (noun, "child")]
NounPhrase :/: (Sentence :/: NounPhrase) -> [
Word (NounPhrase :/: (Sentence :/: NounPhrase), "the"),
Word (NounPhrase :/: (Sentence :/: NounPhrase), "a")]
_ -> []
This is a Context Free grammar, which generates a set of sentences. To do this generating, we need an unfold function. unfold will take a starting Category and produce the set of all productions of the grammar that start with that category. We can represent this set as a MultiTree (defined below). This is a convenient representation, because it allows us to handle grammars which produce infinite languages, by appealing to Haskell's lazy evaluation.
type MultiTree = Fix (Compose [] Node)
unfold :: Grammar -> Category -> MultiTree
unfold grammar = a where a = In . fmap a . grammar
sentences = unfold exampleGrammar Sentence
:t sentences
We can view all the sentences of this MultiTree with another fold, as follows:
sentences = unfold exampleGrammar Sentence
multilinearizer :: Compose [] Node ([] Text) -> [] Text
multilinearizer =
join
. mapM (\case Word (_, t) -> [t]; Branches a b -> (["(" <> a' <> " " <> b' <> ")" | a' <- a, b' <- b]))
. getCompose
nub $ fold multilinearizer sentences
["(Bart skateboards)","(Bart (sees Bart))","(Bart (sees Lisa))","(Bart (sees reason))","(Bart (sees (the child)))","(Bart (sees (a child)))","(Bart (takes Bart))","(Bart (takes Lisa))","(Bart (takes reason))","(Bart (takes (the child)))","(Bart (takes (a child)))","(Lisa skateboards)","(Lisa (sees Bart))","(Lisa (sees Lisa))","(Lisa (sees reason))","(Lisa (sees (the child)))","(Lisa (sees (a child)))","(Lisa (takes Bart))","(Lisa (takes Lisa))","(Lisa (takes reason))","(Lisa (takes (the child)))","(Lisa (takes (a child)))","(reason skateboards)","(reason (sees Bart))","(reason (sees Lisa))","(reason (sees reason))","(reason (sees (the child)))","(reason (sees (a child)))","(reason (takes Bart))","(reason (takes Lisa))","(reason (takes reason))","(reason (takes (the child)))","(reason (takes (a child)))","((the child) skateboards)","((the child) (sees Bart))","((the child) (sees Lisa))","((the child) (sees reason))","((the child) (sees (the child)))","((the child) (sees (a child)))","((the child) (takes Bart))","((the child) (takes Lisa))","((the child) (takes reason))","((the child) (takes (the child)))","((the child) (takes (a child)))","((a child) skateboards)","((a child) (sees Bart))","((a child) (sees Lisa))","((a child) (sees reason))","((a child) (sees (the child)))","((a child) (sees (a child)))","((a child) (takes Bart))","((a child) (takes Lisa))","((a child) (takes reason))","((a child) (takes (the child)))","((a child) (takes (a child)))"]
multidiagramatizer =
foldr1 (\(a,b) (c,d) -> (a|||(rect 0.2 0.1 # lc white) ||| (rect 0.03 1 # lc red) ||| c, b<>d)) .
fmap diagramatizer
. getCompose
diagram $ fst $ fold multidiagramatizer sentences
Here we generated all the sentences of exampleGrammar, and folded each into a string.
Parsing can be expressed in a similar way, but slightly more complex code is required. I'll also assume an understanding of combinator parsers. Feel free to skip this section if needed, and take the existence of the parser for granted.
The idea is that we will take the language, expressed as a MultiTree, and fold with a different "lexicon", this time folding into a combinator parser:
type Parser m a = (ParsecT Void T.Text m a)
parser :: Compose [] Node (Parser [] Tree) -> Parser [] Tree
parser ls =
let makeParser = \case
Word (cat, s) -> In . Word . (cat,) <$> string s
Branches a b -> do
t1 <- a
space
t2 <- b
return (In $ Branches t1 t2)
in foldr1 (<|>) $ makeParser <$> getCompose ls
parse :: MultiTree -> Text -> [Either (ParseErrorBundle Text Void) Tree]
parse language = runParserT (fold parser language) ""
parseAndShow :: MultiTree -> Text -> [Text]
parseAndShow language = fmap (either (T.pack . errorBundlePretty) (fold linearizer) ) . parse language
parseAndDisplay language = diagram . head . fmap (either (text . errorBundlePretty) (fst . fold diagramatizer) ) . parse language
parseAndShow (unfold exampleGrammar Sentence) "Bart skateboards"
parseAndDisplay (unfold exampleGrammar Sentence) "Bart skateboards"
["(Bart skateboards)"]
parseAndShow (unfold exampleGrammar Sentence) "a child skateboards"
parseAndDisplay (unfold exampleGrammar Sentence) "a child skateboards"
["((a child) skateboards)"]
mapM_ (putStrLn . T.unpack) $ parseAndShow (unfold exampleGrammar Sentence) "Bart blah"
1:6: | 1 | Bart blah | ^^^^ unexpected "blah" expecting "sees", "skateboards", "takes", or white space
This parser works for infinite grammars! But only right recursion (rules like A -> B A). You need to be a bit cleverer to allow left recursion (e.g rules like A -> A B), so we omit that for now.
This parser also handles ambiguity! If there's more than one parse, you get all of them.
This parser is lazy! If there's a million parses, and you take the first 5, it stops the search for more once it gives you those 5. This makes it, in some settings, fast.
It's straightforward to add feature agreement, to handle things in English like agreement in number between a noun and verb, but I've left this out for the sake of simplicity.
We now have a parser and a semantics. Putting this together, we can trivially write a function that takes strings and interprets them.
parseAndEvaluate :: MultiTree -> Text -> [Text]
parseAndEvaluate language =
fmap (either (T.pack . errorBundlePretty) (T.pack . show . generalizedFold exampleGeneralizedLexicon) )
. parse language
disp language sentence = do
putStrLn $ T.unpack ("Results of interpreting the sentence '" <> sentence <> "':")
mapM_ (putStrLn . T.unpack . ("Meaning: " <>))
$ parseAndEvaluate language sentence
disp (unfold exampleGrammar Sentence) "Bart skateboards"
disp (unfold exampleGrammar Sentence) "Bart sees Lisa"
Results of interpreting the sentence 'Bart skateboards': Meaning: Meaning: True
Results of interpreting the sentence 'Bart sees Lisa': Meaning: Meaning: False
Some notes about what we have done so far:
unfold unfolds a set of sentences from a grammar. This is the opposite of fold in a technical sense (it is the categorical dual)
The property of being Context Free is encoded in unfold and grammar by construction
We saw already that there are multiword expressions that we want to handle specially in the semantics.
The same is true for the syntax, although the multiword expressions that we care about there might not be in complete overlap with the semantics. For example "sees reason" is a semantic multiword expression, but could in theory be treated normally in the syntax.
What are examples of syntactic multiword expressions? One example is "goes wild". You don't really want to treat "wild" as a noun phrase, or to have "go" take objects, otherwise you'd generate "Bart sees wild" or "Bart goes Bart".
As in the semantics, we also want multiword expressions with compositional parts, as in "all the [NOUN]". This needs to be a multiword expression, because "all" normally takes a noun, not a nounphrase like "the children", but at the same time, we want the word after "the" to be any noun that our grammar can generate.
These requirements on multiword expressions can be addressed by the exact counterpart of the generalizedFold, namely a generalizedUnfold and a generalizedGrammar:
data OneOf f a b = Continue (f b) | Pause a
type Partial f a = Fix (OneOf f a)
type GeneralizedGrammar = Category -> (Compose [] Node) (Partial (Compose [] Node) Category)
Partial Node Category represents a syntax tree of which some subtrees simply terminate with a category.
seesReason :: Partial Node Category
seesReason = In $ Continue $ Branches
(In $ Continue $ Word (NounPhrase, "sees"))
(In $ Continue $ Word (NounPhrase, "reason"))
allTheNoun :: Partial Node Category
allTheNoun = In $ Continue $ Branches
(In $ Continue $ Word (NounPhrase, "all"))
(In $ Continue $ Branches
(In $ Continue $ Word (NounPhrase, "the"))
(In $ Pause ((Sentence :\: NounPhrase) :/: NounPhrase))
)
npAndNp :: Partial Node Category
npAndNp = In $ Continue $ Branches
(In $ Pause (NounPhrase))
(In $ Continue $ Branches
(In $ Continue $ Word (NounPhrase, "and"))
(In $ Pause (NounPhrase))
)
instance Functor f => Functor (OneOf f a) where
fmap f (Pause a) = Pause a
fmap f (Continue fb) = Continue (fmap f fb)
evaluatedTreeDiagramatizer = \case
(Continue (Word (_, t))) -> (
lc white (rect (fromIntegral (length (T.unpack t)) / 7) 0.3)
<> scaleY 0.2 (scaleX 0.2 $ text (T.unpack t)),
show t)
Continue (Branches (left, str1) (right, str2)) ->
(
( (circle 0.2 # named (str1<>"l"<>str2<>"r")) === (
translate (V2 (-1) (-1)) (left # named (str1<>"l"))
||| (rect 2 1 # lc white) |||
translate (V2 1 (-1)) (right # named (str2<>"r")) )
)
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str1<>"l")
# connectOutside' arrowStyle (str1<>"l"<>str2<>"r") (str2<>"r") ,
str1<>str2)
Pause cat -> ((rect (fromIntegral (length (show cat)) / 15) 0.2 <> scale 0.1 (text (show cat) # fc red)) # lc red, show cat)
diagram $ fst $ fold evaluatedTreeDiagramatizer seesReason
diagram $ fst $ fold evaluatedTreeDiagramatizer allTheNoun
diagram $ fst $ fold evaluatedTreeDiagramatizer npAndNp
While a standard grammar takes categories to either words or pairs of categories, a generalized grammar takes categories to either words or partial trees. This allows us to express our multiword expressions in the grammar, like so:
exampleGeneralizedGrammar :: GeneralizedGrammar
exampleGeneralizedGrammar = Compose . \case
Sentence -> [Branches ((In . Pause) NounPhrase) ((In . Pause) (Sentence :\: NounPhrase))]
np@NounPhrase -> [
Branches
(words [(np, "all")])
(continue [
Branches
(words [(np, "the")])
((In . Pause) (Sentence :/: NounPhrase) ),
Branches
(words [(np, "of")])
(continue [Branches
(words [(np, "the")])
((In . Pause) (Sentence :/: NounPhrase) )])]),
Word (NounPhrase, "Bart"),
Word (NounPhrase, "Lisa"),
Word (NounPhrase, "reason"),
Branches ((In . Pause) (NounPhrase :/: (Sentence :/: NounPhrase))) ((In . Pause) (Sentence :/: NounPhrase))]
verbphrase@(Sentence :\: NounPhrase) -> [
Word (verbphrase,"skateboard"),
Word (verbphrase,"skateboards"),
Branches ((In . Pause) ((Sentence :\: NounPhrase) :/: NounPhrase)) ((In . Pause) NounPhrase),
Branches
(words [(verbphrase, "goes")])
(words [(verbphrase, "wild"), (verbphrase, "crazy")])]
verb@((Sentence :\: NounPhrase) :/: NounPhrase) -> [
Word (verb, "sees"),
Word (verb, "takes")
]
noun@(Sentence :/: NounPhrase) -> [
Word (noun, "children"),
Word (noun, "child")]
NounPhrase :/: (Sentence :/: NounPhrase) -> [
Word (NounPhrase :/: (Sentence :/: NounPhrase), "the"),
Word (NounPhrase :/: (Sentence :/: NounPhrase), "a")]
_ -> []
continue :: f (g (Partial (Compose f g) a)) -> Partial (Compose f g) a
continue = In . Continue . Compose
words :: Functor f => f Word -> Partial (Compose f Node) a
words wd = In $ Continue (Compose $ Word <$> wd)
Finally, we'll need our generalized unfold:
generalizedUnfold :: GeneralizedGrammar -> Category -> MultiTree
generalizedUnfold f = a . In . Pause . f where
a = In . fmap (a . emap f . collapse) . distribute
emap f = go where
go (In (Pause a)) = In $ Pause (f a)
go (In (Continue fa)) = In $ Continue (go <$> fa)
collapse :: Partial (Compose [] Node) (Partial (Compose [] Node) a) -> Partial (Compose [] Node) a
collapse x = x `bind` id
In (Pause a) `bind` f = f a
In (Continue m) `bind` f = In (Continue ((`bind` f) <$> m))
distribute (In (Pause fx)) = In . Pause <$> fx
distribute (In (Continue ff)) = In . Continue . distribute <$> ff
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "Bart sees Lisa"
Results of interpreting the sentence 'Bart sees Lisa': Meaning: Meaning: False
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "Bart sees reason"
Results of interpreting the sentence 'Bart sees reason': Meaning: Meaning: False
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "Bart goes wild"
Results of interpreting the sentence 'Bart goes wild': Meaning: Meaning: True
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "Bart goes reason"
Results of interpreting the sentence 'Bart goes reason': Meaning: 1:11: | 1 | Bart goes reason | ^^^^^ unexpected "reaso" expecting "crazy", "wild", or white space
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "Bart sees wild"
Results of interpreting the sentence 'Bart sees wild': Meaning: 1:11: | 1 | Bart sees wild | ^^^^ unexpected "wild" expecting "Bart", "Lisa", "all", "reason", "the", 'a', or white space
disp (generalizedUnfold exampleGeneralizedGrammar Sentence) "all of the children skateboard"
Not in generalized lexicon CallStack (from HasCallStack): error, called at <interactive>:34:10 in interactive:Ghci10448
In this last example, "all of the NOUN" is not in the lexicon, but is in the grammar. The parser therefore succeeds, but the evaluator fails.
There's a deep relationship between the theory of structured recursion and natural language. Idioms, or multiword expressions, can either be syntactic, in which case they are expressed in the GeneralizedGrammar or semantic, in which case they are expressed in the GeneralizedLexicon. Often they are both, but they don't need to be.
These two constructions are dual to each other in a formal sense (see appendix).
This story contains some mathematically quite rich ideas, which I don't highlight above, in the interest of clarity and simplicity. Below I outline the correspondences between well-known constructions, and the code in the notebooks.
Node is an example of a Functor.
Tree is the fix point of Node.
Our Lexicon type is known as an f-algebra in the literature, where f refers to the Functor in question. So we could call Lexicon a Node-algebra.
fold is formally a catamorphism, which is a map from the initial f-algebra.
Evaluated f, for a Functor f is the cofree comonad
generalizedFold is a generalized catamorphism, which is parametrized by a comonad and a distributive law. In particular, we choose the cofree comonad, which has a canonical distributive law.
Dually, our Grammar type is known as an f-coalgebra. So a Grammar is a Node-Coalebra.
unfold is an anamorphism which is a map into the terminal f-coalgebra.
Partial f, for a Functor f, is the free monad
generalizedUnfold is a generalized anamorphism, which is parametrized by a monad and a distributive law. In particular, we choose the free monad, which has a canonical distributive law.
In summary:
As for the approach to parsing proposed here, I don't know if it's known in the literature.