使用 Lisp 处理自然语言解析树时处理 (, ,) 和 (. .) 等标点符号
Handling (, ,) and (. .) and other punctuation when processing natural language parse trees with Lisp
我的问题与 post 词性标记和解析的自然语言句子的处理有关。具体来说，我正在编写 Lisp post-处理器的一个组件，它将一个句子解析树（例如，斯坦福解析器生成的一个）作为输入，从该解析树中提取所调用的短语结构规则生成解析，然后生成 table 规则和规则计数。输入和输出的示例如下：
(1)句：
John said that he knows who Mary likes
(2) 解析器输出：
(ROOT
(S
(NP (NNP John))
(VP (VBD said)
(SBAR (IN that)
(S
(NP (PRP he))
(VP (VBZ knows)
(SBAR
(WHNP (WP who))
(S
(NP (NNP Mary))
(VP (VBZ likes))))))))))
(3) 我的 Lisp 程序 post- 这个解析树的处理器输出：
(S --> NP VP) 3
(NP --> NNP) 2
(VP --> VBZ) 1
(WHNP --> WP) 1
(SBAR --> WHNP S) 1
(VP --> VBZ SBAR) 1
(NP --> PRP) 1
(SBAR --> IN S) 1
(VP --> VBD SBAR) 1
(ROOT --> S) 1
请注意第 (1) 句中缺少标点符号。那是故意的。我在解析 Lisp 中的标点符号时遇到了麻烦——正是因为某些标点符号（例如逗号）是为特殊目的保留的。但是没有标点符号的解析句子改变了解析规则的分布以及这些规则中包含的符号，如下所示：
(4) 输入句子：
I said no and then I did it anyway
(5) 解析器输出：
(ROOT
(S
(NP (PRP I))
(VP (VBD said)
(ADVP (RB no)
(CC and)
(RB then))
(SBAR
(S
(NP (PRP I))
(VP (VBD did)
(NP (PRP it))
(ADVP (RB anyway))))))))
(6) 输入句子（带标点符号）：
I said no, and then I did it anyway.
(7) 解析器输出：
(ROOT
(S
(S
(NP (PRP I))
(VP (VBD said)
(INTJ (UH no))))
(, ,)
(CC and)
(S
(ADVP (RB then))
(NP (PRP I))
(VP (VBD did)
(NP (PRP it))
(ADVP (RB anyway))))
(. .)))
注意包含标点符号是如何完全重新排列解析树并且还涉及不同的 POS 标记（因此，意味着调用了不同的语法规则来生成它）因此包含标点符号很重要，至少对于我的应用程序而言。
我需要的是发现一种在规则中包含标点符号的方法，这样我就可以产生像下面这样的规则，它会出现在例如 table 中，如 (3)，如下所示:
(8) 所需规则：
S --> S , CC S .
像 (8) 这样的规则实际上是我正在编写的特定应用程序所需要的。
但我发现在 Lisp 中这样做很困难：例如，在 (7) 中，我们观察到 (, ,) 和 (. .) 的出现，这两者在 Lisp 中处理起来都是有问题的。
我在下面包含了我的相关 Lisp 代码。请注意，我是一个新手 Lisp 黑客，所以我的代码不是特别漂亮或高效。如果有人可以建议我如何修改下面的代码，以便我可以解析 (7) 以生成像 (3) 这样的 table，其中包含像 (8) 这样的规则，我将不胜感激。
这是我与此任务相关的 Lisp 代码：
(defun WRITE-RULES-AND-COUNTS-SORTED (sent)
(multiple-value-bind (rules-list counts-list)
(COUNT-RULES-OCCURRENCES sent)
(setf comblist (sort (pairlis rules-list counts-list) #'> :key #'cdr))
(format t "~%")
(do ((i 0 (incf i)))
((= i (length comblist)) NIL)
(format t "~A~26T~A~%" (car (nth i comblist)) (cdr (nth i comblist))))
(format t "~%")))
(defun COUNT-RULES-OCCURRENCES (sent)
(let* ((original-rules-list (EXTRACT-GRAMMAR sent))
(de-duplicated-list (remove-duplicates original-rules-list :test #'equalp))
(count-list nil))
(dolist (i de-duplicated-list)
(push (reduce #'+ (mapcar #'(lambda (x) (if (equalp x i) 1 0)) original-rules-list) ) count-list))
(setf count-list (nreverse count-list))
(values de-duplicated-list count-list)))
(defun EXTRACT-GRAMMAR (sent &optional (rules-stack nil))
(cond ((null sent)
NIL)
((and (= (length sent) 1)
(listp (first sent))
(= (length (first sent)) 2)
(symbolp (first (first sent)))
(symbolp (second (first sent))))
NIL)
((and (symbolp (first sent))
(symbolp (second sent))
(= 2 (length sent)))
NIL)
((symbolp (first sent))
(push (EXTRACT-GRAMMAR-RULE sent) rules-stack)
(append rules-stack (EXTRACT-GRAMMAR (rest sent) )))
((listp (first sent))
(cond ((not (and (listp (first sent))
(= (length (first sent)) 2)
(symbolp (first (first sent)))
(symbolp (second (first sent)))))
(push (EXTRACT-GRAMMAR-RULE (first sent)) rules-stack)
(append rules-stack (EXTRACT-GRAMMAR (rest (first sent))) (EXTRACT-GRAMMAR (rest sent) )))
(t (append rules-stack (EXTRACT-GRAMMAR (rest sent) )))))))
(defun EXTRACT-GRAMMAR-RULE (sentence-or-phrase)
(append (list (first sentence-or-phrase))
'(-->)
(mapcar #'first (rest sentence-or-phrase))))
代码调用如下（使用（1）作为输入，生成（3）作为输出）：
(WRITE-RULES-AND-COUNTS-SORTED '(ROOT
(S
(NP (NNP John))
(VP (VBD said)
(SBAR (IN that)
(S
(NP (PRP he))
(VP (VBZ knows)
(SBAR
(WHNP (WP who))
(S
(NP (NNP Mary))
(VP (VBZ likes)))))))))))
Common Lisp 中的 S 表达式
在 Common Lisp s 表达式中，,、. 等字符是默认语法的一部分。
如果你想在 Lisp s 表达式中使用任意名称的符号，你必须对它们进行转义。使用反斜杠转义单个字符或使用一对竖线转义多个字符：
CL-USER 2 > (loop for symbol in '(\, \. | a , b , c .|)
do (describe symbol))
\, is a SYMBOL
NAME ","
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
\. is a SYMBOL
NAME "."
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
| a , b , c .| is a SYMBOL
NAME " a , b , c ."
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
NIL
分词/解析
如果您想处理其他输入格式而不是 s 表达式，您可能想自己标记化/解析输入。
原始示例：
CL-USER 11 > (mapcar (lambda (string)
(intern string "CL-USER"))
(split-sequence " " "S --> S , CC S ."))
(S --> S \, CC S \.)
更新:
感谢 Joswig 博士的评论和代码演示：两者都非常有帮助。
在上述问题中，我有兴趣克服 , 和 .是 Lisp 的默认语法的一部分（或至少适应这一事实）。所以我最终做的是编写函数 PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ。它所做的是从一个文件中读取一个解析树，作为一系列字符串；从字符串中修剪 white-space；将字符串连接在一起形成解析树的字符串表示；然后逐个字符扫描此字符串，搜索要修改的标点符号实例。修改实施了 Joswig 博士的建议。最后，修改后的字符串被转换为树（列表表示），然后发送到提取器以生成规则 table 和计数。为了实现，我拼凑了一些在 Whosebug 上其他地方找到的代码以及我自己的原始代码。结果（当然不是所有标点都可以处理，因为这只是一个演示）：
(defun PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ (file-name)
(let ((result (make-array 1 :element-type 'character :fill-pointer 0 :adjustable T))
(list-of-strings-to-process (mapcar #'(lambda (x) (string-trim " " x))
(GET-PARSE-TREE-FROM-FILE file-name)))
(concatenated-string nil)
(punct-list '(#\, #\. #\; #\: #\! #\?))
(testchar nil)
(string-length 0))
(setf concatenated-string (format nil "~{ ~A~}" list-of-strings-to-process))
(setf string-length (length concatenated-string))
(do ((i 0 (incf i)))
((= i string-length) NIL)
(setf testchar (char concatenated-string i))
(cond ((member testchar punct-list)
(vector-push-extend #\| result)
(vector-push-extend testchar result)
(vector-push-extend #\| result))
(t (vector-push-extend testchar result))))
(reverse result)
(with-input-from-string (s result)
(loop for x = (read s nil :end) until (eq x :end) collect x))))
(defun GET-PARSE-TREE-FROM-FILE (file-name)
(with-open-file (stream file-name)
(loop for line = (read-line stream nil)
while line
collect line)))
请注意，GET-PARSE-TREE-FROM-FILE 仅从仅包含一棵树的文件中读取一棵树。这两个功能当然不是黄金时段！
最后，可以处理包含（Lisp 保留的）标点符号的解析树——从而达到最初的目标——如下（用户提供包含一个解析树的文件名）：
(WRITE-RULES-AND-COUNTS-SORTED
(PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ filename))
生成以下输出：
(NP --> PRP) 3
(PP --> IN NP) 2
(VP --> VB PP) 1
(S --> VP) 1
(VP --> VBD) 1
(NP --> NN CC NN) 1
(ADVP --> RB) 1
(PRN --> , ADVP PP ,) 1
(S --> PRN NP VP) 1
(WHADVP --> WRB) 1
(SBAR --> WHADVP S) 1
(NP --> NN) 1
(NP --> DT NN) 1
(ADVP --> NP IN) 1
(VP --> VBD ADVP NP , SBAR) 1
(S --> NP VP) 1
(S --> S : S .) 1
(ROOT --> S) 1
该输出是使用以下输入（另存为文件名）的结果：
(ROOT
(S
(S
(NP (PRP It))
(VP (VBD was)
(ADVP
(NP (DT the) (NN day))
(IN before))
(NP (NN yesterday))
(, ,)
(SBAR
(WHADVP (WRB when))
(S
(PRN (, ,)
(ADVP (RB out))
(PP (IN of)
(NP (NN happiness)
(CC and)
(NN mirth)))
(, ,))
(NP (PRP I))
(VP (VBD decided))))))
(: :)
(S
(VP (VB go)
(PP (IN for)
(NP (PRP it)))))
(. !)))
我的问题与 post 词性标记和解析的自然语言句子的处理有关。具体来说，我正在编写 Lisp post-处理器的一个组件，它将一个句子解析树（例如，斯坦福解析器生成的一个）作为输入，从该解析树中提取所调用的短语结构规则生成解析，然后生成 table 规则和规则计数。输入和输出的示例如下：
(1)句：
John said that he knows who Mary likes
(2) 解析器输出：
(ROOT
(S
(NP (NNP John))
(VP (VBD said)
(SBAR (IN that)
(S
(NP (PRP he))
(VP (VBZ knows)
(SBAR
(WHNP (WP who))
(S
(NP (NNP Mary))
(VP (VBZ likes))))))))))
(3) 我的 Lisp 程序 post- 这个解析树的处理器输出：
(S --> NP VP) 3
(NP --> NNP) 2
(VP --> VBZ) 1
(WHNP --> WP) 1
(SBAR --> WHNP S) 1
(VP --> VBZ SBAR) 1
(NP --> PRP) 1
(SBAR --> IN S) 1
(VP --> VBD SBAR) 1
(ROOT --> S) 1
请注意第 (1) 句中缺少标点符号。那是故意的。我在解析 Lisp 中的标点符号时遇到了麻烦——正是因为某些标点符号（例如逗号）是为特殊目的保留的。但是没有标点符号的解析句子改变了解析规则的分布以及这些规则中包含的符号，如下所示：
(4) 输入句子：
I said no and then I did it anyway
(5) 解析器输出：
(ROOT
(S
(NP (PRP I))
(VP (VBD said)
(ADVP (RB no)
(CC and)
(RB then))
(SBAR
(S
(NP (PRP I))
(VP (VBD did)
(NP (PRP it))
(ADVP (RB anyway))))))))
(6) 输入句子（带标点符号）：
I said no, and then I did it anyway.
(7) 解析器输出：
(ROOT
(S
(S
(NP (PRP I))
(VP (VBD said)
(INTJ (UH no))))
(, ,)
(CC and)
(S
(ADVP (RB then))
(NP (PRP I))
(VP (VBD did)
(NP (PRP it))
(ADVP (RB anyway))))
(. .)))
注意包含标点符号是如何完全重新排列解析树并且还涉及不同的 POS 标记（因此，意味着调用了不同的语法规则来生成它）因此包含标点符号很重要，至少对于我的应用程序而言。
我需要的是发现一种在规则中包含标点符号的方法，这样我就可以产生像下面这样的规则，它会出现在例如 table 中，如 (3)，如下所示:
(8) 所需规则：
S --> S , CC S .
像 (8) 这样的规则实际上是我正在编写的特定应用程序所需要的。
但我发现在 Lisp 中这样做很困难：例如，在 (7) 中，我们观察到 (, ,) 和 (. .) 的出现，这两者在 Lisp 中处理起来都是有问题的。
我在下面包含了我的相关 Lisp 代码。请注意，我是一个新手 Lisp 黑客，所以我的代码不是特别漂亮或高效。如果有人可以建议我如何修改下面的代码，以便我可以解析 (7) 以生成像 (3) 这样的 table，其中包含像 (8) 这样的规则，我将不胜感激。
这是我与此任务相关的 Lisp 代码：
(defun WRITE-RULES-AND-COUNTS-SORTED (sent)
(multiple-value-bind (rules-list counts-list)
(COUNT-RULES-OCCURRENCES sent)
(setf comblist (sort (pairlis rules-list counts-list) #'> :key #'cdr))
(format t "~%")
(do ((i 0 (incf i)))
((= i (length comblist)) NIL)
(format t "~A~26T~A~%" (car (nth i comblist)) (cdr (nth i comblist))))
(format t "~%")))
(defun COUNT-RULES-OCCURRENCES (sent)
(let* ((original-rules-list (EXTRACT-GRAMMAR sent))
(de-duplicated-list (remove-duplicates original-rules-list :test #'equalp))
(count-list nil))
(dolist (i de-duplicated-list)
(push (reduce #'+ (mapcar #'(lambda (x) (if (equalp x i) 1 0)) original-rules-list) ) count-list))
(setf count-list (nreverse count-list))
(values de-duplicated-list count-list)))
(defun EXTRACT-GRAMMAR (sent &optional (rules-stack nil))
(cond ((null sent)
NIL)
((and (= (length sent) 1)
(listp (first sent))
(= (length (first sent)) 2)
(symbolp (first (first sent)))
(symbolp (second (first sent))))
NIL)
((and (symbolp (first sent))
(symbolp (second sent))
(= 2 (length sent)))
NIL)
((symbolp (first sent))
(push (EXTRACT-GRAMMAR-RULE sent) rules-stack)
(append rules-stack (EXTRACT-GRAMMAR (rest sent) )))
((listp (first sent))
(cond ((not (and (listp (first sent))
(= (length (first sent)) 2)
(symbolp (first (first sent)))
(symbolp (second (first sent)))))
(push (EXTRACT-GRAMMAR-RULE (first sent)) rules-stack)
(append rules-stack (EXTRACT-GRAMMAR (rest (first sent))) (EXTRACT-GRAMMAR (rest sent) )))
(t (append rules-stack (EXTRACT-GRAMMAR (rest sent) )))))))
(defun EXTRACT-GRAMMAR-RULE (sentence-or-phrase)
(append (list (first sentence-or-phrase))
'(-->)
(mapcar #'first (rest sentence-or-phrase))))
代码调用如下（使用（1）作为输入，生成（3）作为输出）：
(WRITE-RULES-AND-COUNTS-SORTED '(ROOT
(S
(NP (NNP John))
(VP (VBD said)
(SBAR (IN that)
(S
(NP (PRP he))
(VP (VBZ knows)
(SBAR
(WHNP (WP who))
(S
(NP (NNP Mary))
(VP (VBZ likes)))))))))))
Common Lisp 中的 S 表达式
在 Common Lisp s 表达式中，,、. 等字符是默认语法的一部分。
如果你想在 Lisp s 表达式中使用任意名称的符号，你必须对它们进行转义。使用反斜杠转义单个字符或使用一对竖线转义多个字符：
CL-USER 2 > (loop for symbol in '(\, \. | a , b , c .|)
do (describe symbol))
\, is a SYMBOL
NAME ","
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
\. is a SYMBOL
NAME "."
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
| a , b , c .| is a SYMBOL
NAME " a , b , c ."
VALUE #<unbound value>
FUNCTION #<unbound function>
PLIST NIL
PACKAGE #<The COMMON-LISP-USER package, 76/256 internal, 0/4 external>
NIL
分词/解析
如果您想处理其他输入格式而不是 s 表达式，您可能想自己标记化/解析输入。
原始示例：
CL-USER 11 > (mapcar (lambda (string)
(intern string "CL-USER"))
(split-sequence " " "S --> S , CC S ."))
(S --> S \, CC S \.)
更新:
感谢 Joswig 博士的评论和代码演示：两者都非常有帮助。
在上述问题中，我有兴趣克服 , 和 .是 Lisp 的默认语法的一部分（或至少适应这一事实）。所以我最终做的是编写函数 PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ。它所做的是从一个文件中读取一个解析树，作为一系列字符串；从字符串中修剪 white-space；将字符串连接在一起形成解析树的字符串表示；然后逐个字符扫描此字符串，搜索要修改的标点符号实例。修改实施了 Joswig 博士的建议。最后，修改后的字符串被转换为树（列表表示），然后发送到提取器以生成规则 table 和计数。为了实现，我拼凑了一些在 Whosebug 上其他地方找到的代码以及我自己的原始代码。结果（当然不是所有标点都可以处理，因为这只是一个演示）：
(defun PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ (file-name)
(let ((result (make-array 1 :element-type 'character :fill-pointer 0 :adjustable T))
(list-of-strings-to-process (mapcar #'(lambda (x) (string-trim " " x))
(GET-PARSE-TREE-FROM-FILE file-name)))
(concatenated-string nil)
(punct-list '(#\, #\. #\; #\: #\! #\?))
(testchar nil)
(string-length 0))
(setf concatenated-string (format nil "~{ ~A~}" list-of-strings-to-process))
(setf string-length (length concatenated-string))
(do ((i 0 (incf i)))
((= i string-length) NIL)
(setf testchar (char concatenated-string i))
(cond ((member testchar punct-list)
(vector-push-extend #\| result)
(vector-push-extend testchar result)
(vector-push-extend #\| result))
(t (vector-push-extend testchar result))))
(reverse result)
(with-input-from-string (s result)
(loop for x = (read s nil :end) until (eq x :end) collect x))))
(defun GET-PARSE-TREE-FROM-FILE (file-name)
(with-open-file (stream file-name)
(loop for line = (read-line stream nil)
while line
collect line)))
请注意，GET-PARSE-TREE-FROM-FILE 仅从仅包含一棵树的文件中读取一棵树。这两个功能当然不是黄金时段！
最后，可以处理包含（Lisp 保留的）标点符号的解析树——从而达到最初的目标——如下（用户提供包含一个解析树的文件名）：
(WRITE-RULES-AND-COUNTS-SORTED
(PRODUCE-PARSE-TREE-WITH-PUNCT-FROM-FILE-READ filename))
生成以下输出：
(NP --> PRP) 3
(PP --> IN NP) 2
(VP --> VB PP) 1
(S --> VP) 1
(VP --> VBD) 1
(NP --> NN CC NN) 1
(ADVP --> RB) 1
(PRN --> , ADVP PP ,) 1
(S --> PRN NP VP) 1
(WHADVP --> WRB) 1
(SBAR --> WHADVP S) 1
(NP --> NN) 1
(NP --> DT NN) 1
(ADVP --> NP IN) 1
(VP --> VBD ADVP NP , SBAR) 1
(S --> NP VP) 1
(S --> S : S .) 1
(ROOT --> S) 1
该输出是使用以下输入（另存为文件名）的结果：
(ROOT
(S
(S
(NP (PRP It))
(VP (VBD was)
(ADVP
(NP (DT the) (NN day))
(IN before))
(NP (NN yesterday))
(, ,)
(SBAR
(WHADVP (WRB when))
(S
(PRN (, ,)
(ADVP (RB out))
(PP (IN of)
(NP (NN happiness)
(CC and)
(NN mirth)))
(, ,))
(NP (PRP I))
(VP (VBD decided))))))
(: :)
(S
(VP (VB go)
(PP (IN for)
(NP (PRP it)))))
(. !)))