eliza-cl.org Eliza Tests

Table of Contents

Preface

The computer code here is not original to me. and this document reflects several of my ongoing projects:

  1. Learning 'classic' AI by working through Peter Norvig's Paradigms of Artificial Intelligence: Case Studies in Common Lisp. Norvig's book is the source for the Lisp code in this project.
  2. Learning more Emacs in general and org-mode in particular.
  3. Developing a work process around Literate Programming.

Introduction

System

This is my first attempt at using ASDF to build a system. The system uses utility files available here. 

;;; To build the system
;;; (asdf:operate 'asdf:load-op :eliza)
;;; then run
;;; (in-package :eliza)

(load "../utils/norvig-utils")
(load "../utils/norvig-debugger")

(defpackage #:eliza
  (:use :common-lisp
        :asdf
        :norvig-utils
        :norvig-debugger
        :kludgecode))

(in-package :eliza)

(defsystem eliza
    :serial t
    :components ((:file "eliza")))

:eliza package

As is the case with ASDF, this is also my first time developing using Common Lisp's package system. 

(in-package :eliza)

Pattern Matching

simple-equal

(defun simple-equal (x y)
  "Are x and y equal. Does not check inside strings."
  (if (or (atom x) (atom y))
      (eql x y)
      (and (simple-equal (first x) (first y))
           (simple-equal (rest x) (rest y)))))

variable-p

This function brings up two interesting aspects of Common Lisp. The first is that atom's are not truely atomic. The second is that predicate syntax in Common Lisp suffers from the same big-language inconsistencies as might be found in PHP. 

(defun variable-p (x)
  "Is x a variable where a variable is a symbol beginning with '?'"
  (and (symbolp x)
       (equal (char (symbol-name x) 0)
              #\?)))

pat-match

The naive version is so straight forward it could be template code for recursing on a list (or two lists). There is a certain concision to the first part which avoids enumerating all the cases of atoms and lists. Though it arises more from the template style than anything else.

A naive version

(defun pat-match (input pattern)
  "Does pattern match input? Any variable can match anything."
  (if (variable-p pattern)
      t
      (if (or (atom pattern) (atom input))
          (eql pattern input)
          (and (pat-match (first input) (first pattern))
               (pat-match (rest input) (rest pattern))))))

A second buggy version

One problem is that (eql pattern input) may return t. While nil is not a problem for append, t is…since t is not a list. Booleans are actually tough if they're overloaded as they are many languages.

The second problem is semi-boolean contexts: those in which nil may be returned from a successful match versus where nil is returned because a predicate turned out to be false. Did I say booleans are tough?

The final problem is that we want the same variable (e.g. ?X) to consistently be bound to the same expression when it appears multiple times in an input. 

(defun pat-match (pattern input)
  "BUGGY Second version."
  (if (variable-p pattern)
      (list (cons pattern input))
      (if (or (atom pattern) (atom input))
          (eql pattern input)
          (append (pat-match (first pattern) (first input))
                  (pat-match (rest pattern) (rest input))))))

pattern matching constants

The first step in the third version is to turn pat-match into a true predicate that only returns nil for failure. It's worth noting that only having a single value that indicates false is helpful here. 

(defconstant fail nil "indicates pat-match failure.")

(defconstant no-bindings '((t . t))
  "Indicates a pattern match success, with no variables.")

abstractions over assoc

Note: The ASDF build system loads these from my norvig-utils repository. They are shown here to maintain consistency with the text.

Building abstractions over assoc enables using the language of variables and bindings rather than low level lisp. 

(defun get-bindings (var bindings)
  "Find a (variable . value) pair in a binding list."
  (assoc var bindings))

(defun binding-val (binding)
  "Get the value part of a single binding."
  (cdr binding))

(defun lookup (var bindings)
  "Get the value part (for var) from a binding list."
  (binding-val (get-bindings var bindings)))

(defun extend-bindings (var val bindings)
  "Add a (var . value) pair to a binding list."
  (cons (cons var val) bindings))

A third version

There are five cases for pat-match:

  1. Bindings list is fail and the match fails.
  2. Pattern is a single variable.
  3. Pattern and input are eql.
  4. Pattern and input are both lists.
  5. None of these holds and the match fails.
(defun pat-match (pattern input &optional (bindings non-bindings))
  "Match pattern against input in the context of bindings."
  (cond ((eq bindings fail) fail)
        ((variable-p pattern)
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((and (consp pattern)
              (consp input))
         (pat-match (rest pattern)
                    (rest input)
                    (pat-match (first pattern)
                               (first input)
                               bindings)))
        (t fail)))

(defun match-variable (var input bindings)
  "Does var match input. Uses bindings. Returns bindings with or without an update depending on match."
  (let ((binding (get-bindings var bindings)))
    (cond ((not binding) (extend-bindings var input bindings))
          ((equal input (binding-val binding)) bindings)
          (t fail))))

Segment Pattern Matching

It is useful to have two types of variables, those that match individual input elements and others that behave like Lisp's &rest parameter. The latter can be thought of as matching segments. This would allow a syntax such as (?P need . ?X). 

;;; Example
(pat-match '((?* ?p) need (?* ?x))
           '(Mr Hulot and I need a vaction))
((?P MR HULOT AND I) (?X A VACTION))

Updating pat-match for the new behavior: 

(defun pat-match (pattern input &optional (bindings no-bindings))
  "Match pattern against input in context of the bindings."
  (cond ((eq bindings fail) fail)
        ((variable-p pattern)
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((segment-pattern-p pattern)
         (segment-match pattern input bindings))
        ((and (consp pattern) (consp input))
         (pat-match (rest pattern)
                    (rest input)
                    (pat-match (first pattern)
                               (first input)
                               bindings)))
        (t fail)))

Adding the new predicate highlights Common Lisp's flexibility in regards to naming symbols by allowing a notation evocative of the kleene star. 

(defun segment-pattern-p (pattern)
  "Is this a segment matching pattern: ((?* var) . pat)"
  (and (consp pattern)
       (starts-with (first pattern) '?*)))

The first pass at segment-match address the problems that arise when the next element of the pattern is contained in the input but there are intervening elements between what has been matched already and the match for the next element of the pattern. It allows looking further ahead in the input at the expense of requiring a segment-variable to be the last variable in a pattern. 

(defun segment-match (pattern input bindings &optional (start 0))
  "Match the segment patter ((?* var) . pat) against input."
  (let ((var (second (first pattern)))
        (pat (rest pattern)))
    (if (null pat)
        (match-variable var input bindings)
        ;; We assume pat starts with a constant
        ;; In other words, a pattern can't have 2 consectutive vars
        (let ((pos (position (first pat)
                             input
                             :start start
                             :test #'equal)))
          (if (null pos)
              fail
              (let ((b2 (pat-match pat
                                   (subseq input pos)
                                   bindings)))
                ;; If this match failed try another longer one
                ;; If it worked, check that the variables match
                (if (eq b2 fail)
                    (segment-match pattern input bindings (+ 1 pos))
                    (match-variable var
                                    (subseq input 0 pos)
                                    b2))))))))

Final

<<eliza-package>>

<<pat-match-constants>>

<<binding-utilities>>

<<variable-p>>

<<match-variable>>

<<pat-match>>

<<segment-match>>

<<segment-pattern-p>>

Tests (experimental)

Introduction

This is mostly an experiment:

  1. At the emacs level it is about building compound documents using #+INCLUDE: to break up org documents.
  2. At the literate programming level it is about beginning to incorporate testing into literate documents.
  3. At the Common Lisp level is about learning lisp-unit for unit testing.
  4. At the Common Lisp development environment level it is about learning quicklisp. It is good that I broke quicklisp and ASDF into seperate exercises. Without understanding a bit about ASDF I was confused when looking at quicklisp and when I looked at quicklisp it just made me confused about ASDF.

Base File

<<lu-install>>

<<lu-test-one>>

Installing lisp-unit

(ql:quickload :lisp-unit)

Test One

(in-package :eliza)
(define-test test-one
    (assert-equal 5 5))

Author: benrudgers

Created: 2017-03-25 Sat 22:07

Validate