Skip to content

GitLab

Commit a9a3a8c3 authored by remivantrijp's avatar remivantrijp
Browse files

Merge commit 'refs/subrepo/systems/fcg-hybrids/fetch' into subrepo/systems/fcg-hybrids

parents 825ca4a3 1d951154
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 904 additions and 1046 deletions
.gitignore 0 → 100755
View file @ a9a3a8c3
*.lisp~
*.xfasl
*.asd~
*.64xfasl
LICENSE 100644 → 100755
View file @ a9a3a8c3
File mode changed from 100644 to 100755
README.md 100644 → 100755
View file @ a9a3a8c3
File mode changed from 100644 to 100755
clean.sh 0 → 100755
View file @ a9a3a8c3
#!/bin/sh
if test "$1" = "--all"
then
BASE_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
echo "clean.sh called with --all (cleaning base directory and ~/.cache/common-lisp)"
cd $BASE_DIR
bash clean.sh
if [ -d ~/.cache/common-lisp ]; then
echo "cleaning ~/.cache/common-lisp"
cd ~/.cache/common-lisp
bash "$BASE_DIR/clean.sh"
fi
if [ -d ~/quicklisp ]; then
echo "cleaning ~/quicklisp"
cd ~/quicklisp/
bash "$BASE_DIR/clean.sh"
fi
else
find . -name '*.ppcf' -exec rm -v {} \;
find . -name '*.*fsl' -exec rm -v {} \;
find . -name '*.fasl' -exec rm -v {} \;
find . -name '*.fas' -exec rm -v {} \;
find . -name '*.*fasl' -exec rm -v {} \;
find . -name '*.x86f' -exec rm -v {} \;
find . -name '*.*x*fsl' -exec rm -v {} \;
find . -name '*~.lisp' -exec rm -v {} \;
find . -name '*~.asd' -exec rm -v {} \;
find . -name '*~' -exec rm -v {} \;
find . -name '*.elc' -exec rm -v {} \;
find . -name '.#*' -exec rm -v {} \;
find . -name '*.allegro-warnings' -exec rm -v {} \;
find . -name '*.build-report' -exec rm -v {} \;
find . -name '*.64xfasl' -exec rm -v {} \;
rm -rvf .tmp/*
fi
data-structures-and-utils.lisp → configuration-and-utils.lisp
View file @ a9a3a8c3
;; Copyright 2019 Sony Computer Science Laboratories Paris
;; Remi van Trijp (http://www.remivantrijp.eu)
;; Copyright 2019-present
;; Sony Computer Science Laboratories Paris
;; Remi van Trijp (http://www.remivantrijp.eu)
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
......@@ -14,42 +15,55 @@
;; limitations under the License.
;;=========================================================================
(in-package :fcg)
(in-package :nlp-tools)
;;; Data structures.
;;; -------------------------------------------------------------------------------------
(export '(word-dependency-spec
word-dependency-spec-string word-dependency-spec-syn-role word-dependency-spec-unit-name
word-dependency-spec-pos-tag word-dependency-spec-node-id word-dependency-spec-head-id
word-dependency-spec-conjunct-type))
(setf *penelope-host* "http://spacy.fcg-net.org/")
(defstruct word-dependency-spec string syn-role unit-name pos-tag node-id head-id conjunct-type)
;; The FCG-hybrids uses functions from the NLP-tools package as much as possible.
;; For English, however, a combination of SpaCy and the Berkeley Neural Parser
;; is used, so we can ask for both a dependency- and constituent analysis.
;;; Helper functions.
;;; -------------------------------------------------------------------------------------
(defun run-english-parser (sentence &key (model "en"))
"Call the penelope server to get the dependency labels all words in a sentence."
(unless (stringp sentence)
(error "The function <run-english-parser> expects a string as input"))
(send-request "/beng"
(encode-json-to-string `((:sentence . ,(remove-multiple-spaces sentence))
(:model . ,model)))))
(export '(fcg-get-dependency-conversion-table fcg-set-dependency-conversion-table))
(defun convert-ica-string-to-ica-list (string)
"Converts a string representing a constituent analysis into a list representation."
(loop for pair in '(("." "\\.")
("," "\\,")
("''" "PARENTH")
("``" "PARENTH")
("\"" "PARENTH"))
do (setf string (string-replace string (first pair) (second pair))))
(read-from-string string))
(defgeneric retrieve-category-from-conversion-table (category-name conversion-table))
(export '(get-english-sentence-analysis))
(defmethod retrieve-category-from-conversion-table ((category-name t)
(conversion-table list))
(second (assoc category-name conversion-table)
:test #'equal))
(defun get-english-sentence-analysis (sentence &key (model "en")) ;; To do: allow sentence ID.
"Get a dependency and immediate constituent analysis for an English sentence."
(let* ((analysis (run-english-parser (format nil "~a" sentence) :model model))
(dependency-tree (rest (assoc :tree (first (rest (assoc :beng analysis))))))
(constituent-tree (convert-ica-string-to-ica-list (second (assoc :ica (second (first analysis)))))))
(values dependency-tree constituent-tree)))
(defun fcg-get-dependency-conversion-table (&optional cxn-inventory)
(or (when cxn-inventory (get-configuration cxn-inventory :dependency-conversion-table))
t)) ;; At least always return T.
(in-package :fcg)
(defun fcg-set-dependency-conversion-table (cxn-inventory data)
(set-configuration cxn-inventory :dependency-conversion-table data))
(import '(nlp-tools:get-english-sentence-analysis))
;;; Helper functions.
;;; -------------------------------------------------------------------------------------
(defun calculate-boundaries-and-form-constraints (base-transient-structure
unit-tree
&optional (cxn-inventory *fcg-constructions*))
"When the tree is translated, update the boundaries and form constraints."
"Update the boundaries feature of the ROOT unit of a transient structure, and adds form constraints to the ROOT."
(let* ((strings (fcg-extract-selected-form-constraints base-transient-structure '(string)))
;; Remi 26/04/2021
;; Temporary cip-node is necessary to be able to reuse the normal fcg processing functions.
;; Would be better to rewrite the update-list-of-boundaries function.
(temp-node (make-instance 'cip-node
:construction-inventory cxn-inventory
:car (make-cxn-application-result
......@@ -67,4 +81,4 @@
(fcg-get-transient-unit-structure temp-node))))
`(root
(boundaries ,new-boundaries)
(form ,(append strings new-form-constraints)))))
\ No newline at end of file
(form ,(append strings new-form-constraints)))))
english-hybrids/categories.lisp deleted 100644 → 0
View file @ 825ca4a3
;; Copyright 2019 Sony Computer Science Laboratories Paris
;; Remi van Trijp (http://www.remivantrijp.eu)
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;; http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;=========================================================================
;;; ----------------------------------------------------------------------------
;;; *IMPORTANT*: Any changes in the *english-grammar-categories* must remain
;;; compatible with the "type hierarchy" at the end of the file, which is based
;;; on Paul Van Eecke's type hierarchies (see Van Eecke, 2018).
;;; ----------------------------------------------------------------------------
(in-package :fcg)
(export '(clause clausal-subject matrix-clause subclause intransitive-clause transitive-clause ditransitive-clause
phrase NP VP dativeNP advP PrepNP by-phrase
verb aux auxpass
noun compound proper-noun common-noun adjective participle
determiner article quantifier pronoun personal-pronoun possessive-pronoun demonstrative
demonstrative-pronoun args referent
discourse-structure object-complement
functional-structure head *english-grammar-categories*))
;;; 1. Definition of the English grammar categories.
;;; ------------------------------------------------------------------------------
(defparameter *english-grammar-categories* nil "Contains a type hierarchy of the categories of the grammar.")
(setf *english-grammar-categories*
'(;; CLAUSES
;; ---------------------------------------------------------------
(clause ()
(referent ?ref)
(syn-cat ((is-matrix-clause ?plus-or-minus)
(clause-type ?clause-type))))
(matrix-clause (clause)
(syn-cat ((is-matrix-clause +))))
(subclause (clause)
(syn-cat ((is-matrix-clause -))))
;; Phrases
;; ---------------------------------------------------------------
(phrase ()
(referent ?ref)
(parent ?parent)
(head ?head)
(syn-cat ((phrase-type ?phrase-type)
(agreement ?agreement))))
(NP (phrase)
(syn-cat ((phrase-type NP))))
(advp (phrase)
(syn-cat ((phrase-type AdvP))))
(PrepNP (NP)
(syn-cat ((phrase-type PrepNP))))
(by-phrase (PrepNP)
(syn-cat ((case by-phrase))))
(AdjP (phrase)
(syn-cat ((phrase-type AdjP))))
(object-complement (phrase)
(syn-cat ((phrase-type Object-Complement))))
(VP (phrase)
(referent ?ev-ref)
(tam ((tense ?tense)
(aspect ((perfect ?perfect)
(progressive ?prog)))
(modality ?modality)))
(syn-cat ((phrase-type VP))))
;; Mixtures
;; ---------------------------------------------------------------
(clausal-subject (subclause NP))
;; Lex-classes
;; ---------------------------------------------------------------
(verb ()
(syn-cat ((lex-class verb)
(agreement ?agr)
(finite ?finite)
(verb-form ?verb-form))))
(aux (verb)
(syn-cat ((lex-class aux))))
(auxpass (aux)
(syn-cat ((is-passive-marker +))))
(noun ()
(referent ?ref)
(args (?output ?input))
(syn-cat ((agreement ?agr)
(lex-class noun))))
(common-noun (noun)
(syn-cat ((lex-class common-noun))))
(compound (noun))
(proper-noun (noun)
(syn-cat ((lex-class proper-noun))))
(adjective ()
(referent ?ref)
(args (?output ?input))
(syn-cat ((lex-class adjective))))
(determiner ()
(referent ?ref)
(args (?ref ?input))
(syn-cat ((lex-class determiner))))
(article (determiner)
(syn-cat ((lex-class article))))))
;;; 2. Definition of a CATEGORY-SPEC.
;;; ------------------------------------------------------------------------------
;;; A category-spec is a triplet of the form (category-name (parents) (fv-pairs)).
;;; The feature-value pairs of the category-spec are meant to be the VALUE of a
;;; feature in the construction, such as SYN. Overwritting a value only goes
;;; one level deep.
(defun category-name (category-spec)
(first category-spec))
(defun category-parents (category-spec)
(second category-spec))
(defun category-features (category-spec)
(when category-spec
(subseq category-spec 2)))
(defun find-feature-for-category (feature-name category category-tree &key (features-so-far))
"Return only a specific feature-value pair for a category."
(let* ((category-spec (assoc category category-tree))
(parents (category-parents category-spec)))
(tagbody
point-a
(setf features-so-far (union features-so-far
(second (assoc feature-name (category-features category-spec)))
:key #'first))
(when parents
(setf category-spec (assoc (first parents) category-tree)
parents (append (rest parents) (category-parents category-spec)))
(go point-a)))
`(,feature-name ,features-so-far)))
(defun find-feature-value-for-category (feature-name category category-tree &key (features-so-far))
(feature-value (find-feature-for-category feature-name category category-tree :features-so-far features-so-far)))
(defun first-or-var (list-or-var)
"Helper function that returns either the argument if it's a variable, and its first element if it is a list."
(if (variable-p list-or-var)
list-or-var
(first list-or-var)))
(defun find-all-features-for-category (category category-tree &key (features-so-far nil))
"Given a category-name, obtain all the features or a particular feature associated with it."
(let* ((category-spec (assoc (if (consp category) (second category) category) category-tree))
(features (fcg::rename-variables (category-features category-spec))))
(loop for fv-pair in features
for old-feature = (assoc (feature-name fv-pair) features-so-far)
for new-feature = `(,(feature-name fv-pair)
,(let ((old-value (feature-value old-feature))
(new-value (feature-value fv-pair)))
(cond ((null old-value) new-value)
((null new-value) old-value)
((variable-p old-value) new-value)
((variable-p new-value) old-value)
(t
(union old-value new-value :key #'first)))))
do (setf features-so-far (if old-feature
(substitute new-feature old-feature features-so-far :test #'equal)
(cons new-feature features-so-far))))
(loop for parent in (category-parents category-spec)
do (setf features-so-far (find-all-features-for-category parent category-tree
:features-so-far features-so-far)))
features-so-far))
;;; 3. Expansion operator to be used in FCG constructions
;;; ------------------------------------------------------------------------------
;;; (defmethod fcg-expand ((type (eql :category-tree)) &key value source bindings merge?))
;;;
(defparameter *spacy-pos-tag-conversion-table* nil "List of POS Tags and their corresponding categories in the grammar.")
;; Note: this conversion table is far from complete, but contains only relevant conversions.
(setf *spacy-pos-tag-conversion-table*
'(;;("AFX" affix)
;;("JJ" adjective)
;;("JJR" adjective)
;;("JJS" adjective)
("NN" noun)
("NNS" noun)
("NNP" proper-noun)
("NNPS" proper-noun)
("VB" verb)
("VBD" verb)
("VBG" verb)
("VBN" verb)
("VBP" verb)
("VBZ" verb)
("DT" determiner)
("JJ" adjective)
("PRP$" possessive-pronoun)))
\ No newline at end of file
english-hybrids/clear-dependency-tags.lisp deleted 100644 → 0
View file @ 825ca4a3
;; Copyright 2019 Sony Computer Science Laboratories Paris
;; Remi van Trijp (http://www.remivantrijp.eu)
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;; http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;=========================================================================
(in-package :fcg)
;;;;; The FCG-dependency-parser hybrid uses the Spacy dependency parser
;;;;; (see semantic-dependency-parser.lisp in this folder).
;;;;;
;;;;; The Spacy Syntactic Dependency Parser uses the CLEAR style by ClearNLP.
;;;;; http://www.mathcs.emory.edu/~choi/doc/cu-2012-choi.pdf
;;;;; (CLEAR = Center for Computational Language and EducAtion Research, University of Colorado Boulder)
;;;;;
;;;;; This file contains specifications about these dependency-tags and some
;;;;; helper functions to access information from these specs.
;;;;; ------------------------------------------------------------------------------------------
;;;;; Data structures.
;;;;; ------------------------------------------------------------------------------------------
(export '(clear-dependency clear-dependency-specs make-clear-dependency clear-dependency-p))
(defparameter *functions-that-are-categories* nil "List of functions that are categories in the grammar.")
(defparameter *dependency-specs* nil "List of Tags and relevant information.")
(defstruct clear-dependency specs)
(setf *functions-that-are-categories* '(("aux" aux)
("auxpass" auxpass)
("det" determiner)))
(setf *dependency-specs* (make-clear-dependency
:specs '(;; Subject-Related:
("nsubj" functional nominal subject "Nominal Subject")
("nsubjpass" functional nominal subject "Nominal Passive Subject")
("csubj" functional clausal-subject subject "Clausal subject.")
("csubjpass" functional clausal-subject subject "Clausal passive subject.")
("expl" functional nominal subject "Expletive (existential there).")
;; Object-Related:
("dobj" functional nominal object "Direct object")
;; Other core functions:
("agent" functional nominal by-phrase "Agent of passive verb")
("attr" functional nominal object "Non-VP predicate after copula.")
("dative" functional nominal indirect-object "Indirect Object")
("oprd" functional nominal object-complement "Object predicate (= Obj Complement).")
;; Auxiliaries
("aux" lexical verbal aux "Auxiliary.")
("auxpass" lexical verbal auxpass "Passive auxiliary.")
;; hmod - modifier in hyphenation -
;; hyph hyphen
;; Complements
("acomp" functional adjectival complement "Adjectival complement.")
("ccomp" functional clausal object "Clausal complement.")
("xcomp" functional clausal complement "Open clausal complement.")
("complm" marker clausal complementizer "Subordinating conjunction.")
;; Modifiers
("advcl" functional clausal adverbial "Adverbial clause modifier.")
("relcl" functional clausal phrase "Root of the relative clause.")
("acl" functional clausal phrase "Clausal modifier of a noun.")
("advmod" functional advberbial adverbial "Adverbial modifier.")
("mark" functional adverbial advp "Marker for adverbial clause modifier.")
("neg" lexical adverbial adverbial "Negation modifier.")
("npadvmod" functional nominal adverbial "NP as adverbial modifier.")
;; Coordination-related modifiers.
("conj" ignoreable nominal conjunt "Conjunct dependent, e.g. John, Mary and Sam")
("cc" lexical conjunction "Coordinating conjunction.")
("preconj" conjunction conjunction conjunction "Pre-correlative conjunction.")
;; NP-modifiers.
("nmod" lexical nominal modifier "Unclassified modifier of the head noun.")
("appos" functional nominal modifier "Appositional modifier NP of another NP.")
("det" lexical determiner determiner "Determiner of an NP.")
("wdt" lexical determiner determiner "Determiner of an NP.")
("infmod" functional verbal modifier "Infinitival modifier.")
("nn" lexical nominal compound "Noun compound modifier.")
("num" lexical nominal numerical "Numerical modifier.")
("partmod" functional clausal complement "Participial modifier.")
("poss" lexical possessive-pronoun pronominal "Possessive modifier.")
("predet" lexical nominal predeterminer "Predeterminer word such as all.")
("rcmod" functional clausal relative-clause "Relative clause modifier.")
;; Prepositional phrase related modifiers.
("pcomp" functional it-depends complement "Prepositional complement phrase.")
("pobj" functional nominal NP "NP of a prepositional phrase.")
("prep" functional nominal PrepNP "Preposition of a PrepNP.")
;; Quantifier phrase related modifiers.
("number" lexical nominal quantifier "Number quantifier.")
("quantmod" lexical nominal quantifier "Quantifier phrase modifier.")
;; Miscellaneous modifiers.
("amod" lexical nominal adjectival "Adjective.")
("dep" functional unclassified unclassified "Unclassified dependent.")
("intj" lexical interjection interjection "Interjection.")
("meta" lexical meta meta "Meta modifier (randomly inserted in a clause).")
("parataxis" parenthetical parenthetical parenthetical "Parenthetical modifier.")
("prt" lexical particle particle "Particle of a phrasal verb.")
("punct" lexical punctuation punctuation "Punctuation.")
;; Others:
("wp" functional nominal nominal "WH pronoun.")
("case" lexical nominal possessive "Genetive 's.")
("ROOT" root root phrase "Root of the dependency tree."))))
;;;;; ------------------------------------------------------------------------------------------
;;;;; Helper functions for data structures.
;;;;; ------------------------------------------------------------------------------------------
(defmethod retrieve-category-from-conversion-table ((category-name t)
(conversion-table clear-dependency))
(second (assoc category-name (clear-dependency-specs conversion-table)
:test #'string=)))
(defun lex-class-p (dependency-spec)
(eql 'lexical (second dependency-spec)))
(defun dependency-spec-category (dependency-spec)
(fourth dependency-spec))
(defun english-retrieve-category (word-spec)
(or (assoc (word-dependency-spec-syn-role word-spec) *functions-that-are-categories* :test #'string=)
(assoc (word-dependency-spec-pos-tag word-spec) *spacy-pos-tag-conversion-table* :test #'string=)))
(defun find-dependency-spec (dependency-tag)
"Get the information associated with a dependency-tag."
(assoc dependency-tag (clear-dependency-specs *dependency-specs*) :test #'string=))
(defun explain-dependency-tag (tag)
(nth 4 (find-dependency-spec tag)))
;; (explain-dependency-tag "oprd")
;;;;; ------------------------------------------------------------------------------------------
;;;;; Knowledge about the Translation.
;;;;; ------------------------------------------------------------------------------------------
(defun subject-p (tag)
(member 'subject (find-dependency-spec tag)))
;; (subject-p "nsubj")
;; (subject-p "dobj")
(defun passive-subject-p (tag)
(member tag '("nsubjpass" "csubjpass") :test #'string=))
(defun object-p (tag)
(member 'object (find-dependency-spec tag)))
;; (object-p "dobj")
;; (object-p "nsubj")
(defun indirect-object-p (tag)
(member 'indirect-object (find-dependency-spec tag)))
;; (indirect-object-p "dative")
(defun dative-p (tag)
(indirect-object-p tag))
;; (indirect-object-p "dative")
(defun core-function-p (tag)
(or (subject-p tag)
(object-p tag)
(dative-p tag)))
(defun clausal-dependent-p (tag &optional pos-tag)
(or (member 'clausal (find-dependency-spec tag))
;; In some cases, we might have a clausal complement.
;; We check whether the head is verbal.
(and pos-tag
(member 'it-depends (find-dependency-spec tag))
(string= "V" (subseq pos-tag 0 1)))))
;; (clausal-dependent-p "csubj")
(defun functional-dependent-p (tag)
(member 'functional (find-dependency-spec tag)))
;; (functional-dependent-p "nsubj")
;; (functional-dependent-p "det")
(defun verbal-root-p (root)
(string= "V" (subseq (word-dependency-spec-pos-tag root) 0 1)))
(defun verb-p (word-spec)
(let ((pos-tag (word-dependency-spec-pos-tag word-spec)))
(or (string= "V" (subseq pos-tag 0 1))
(string= "MD" pos-tag)))) ;; For modal auxiliaries.
(defun adjective-p (word-spec)
(member (word-dependency-spec-pos-tag word-spec)
'("JJ" "JJR" "JJS") :test #'string=))
(defun by-phrase-p (word-spec)
(string= "agent" (word-dependency-spec-syn-role word-spec)))
(defun PrepNP-p (word-spec)
(string= "prep" (word-dependency-spec-syn-role word-spec)))
(defun auxiliary-p (word-spec)
(member (word-dependency-spec-syn-role word-spec)
'("aux" "auxpass") :test #'string=))
(defun negation-p (word-spec)
(string= "neg" (word-dependency-spec-syn-role word-spec)))
(defun dependency-root-p (word-spec)
(string= "ROOT" (word-dependency-spec-syn-role word-spec)))
(defun adverbial-modifier-p (word-spec)
(string= "advmod" (word-dependency-spec-syn-role word-spec)))
(defun particle-p (word-spec)
(string= "prt" (word-dependency-spec-syn-role word-spec)))
(defun genitive-p (word-spec)
(string= "case" (word-dependency-spec-syn-role word-spec)))
(defun possessor-p (word-spec)
(string= "poss" (word-dependency-spec-syn-role word-spec)))
\ No newline at end of file
english-hybrids/de-render.lisp deleted 100644 → 0
View file @ 825ca4a3
;; Copyright 2019 Sony Computer Science Laboratories Paris
;; Remi van Trijp (http://www.remivantrijp.eu)
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;; http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;=========================================================================
(in-package :fcg)
;; Basic de-render that builds on :de-render-with-scope
;; Does not assume a hybrid.
;; ------------------------------------------------------------------------------------------------------------
(defmethod de-render ((utterance list) (mode (eql :english-de-render)) &key cxn-inventory &allow-other-keys)
"De-render based on :de-render-with-scope but does some post-processing."
(let ((transient-structure
(de-render utterance :de-render-with-scope :cxn-inventory cxn-inventory)))
;; Check for unknown strings.
(set-data transient-structure :unknown-strings nil)
(loop for string in (reverse utterance)
unless (or (word-in-dictionary-p string cxn-inventory)