![[CS logo]](hw1_files/t.png)
CMSC 25000 - Artificial Intelligence
Winter 2004
Assignment #1 Solutions
Solution 1: [10 points]
;;;; CMSC 25000 Artificial Intelligence Solutions
;;; Homework 1
;;; Problem 1
;;; count
(define (atom? x) (or (symbol? x) (number? x) (boolean? x) (null? x)))
;; contract: count: expr --> number where expr is
a scheme expression
;; purpose: to count number of atoms in the scheme expression
(define (count exp)
(cond
((atom? exp) 1)
((empty? exp) 0)
(else (+ (count (first exp)) (count (rest exp))))))
;;; tests
(display "testing count")
(= (count 'a) 1)
(= (count '()) 1)
(= (count '(a b)) 3)
(= (count '((the sun) (rose (over (the clouds))))) 11)
(= (count '(a (b . c))) 4)
Solution 2: [20 points]
;;;; -*- mode:Scheme -*- ;;;;
;; Part of BINDINGS abstraction
(define *null-bindings* '(bindings)) ;; initial value of bindings
;;; UTILITIES
(define first car)
(define rest cdr)
(define second cadr)
;;;; MATCHER
(define (match p d) (do-match p d *null-bindings*))
(define (do-match p d bindings)
;;Arguments: Pattern, datum, optional bindings.
;;Returns: A list of bindings or #f
;;Remarks: Pattern variables are indicated by (?
<variable name>)
;; Prolog's nameless variable
is indicated by (? _)
(cond ((and (null? p) (null? d))
bindings)
((and (atom? p) (atom? d))
(match-atoms p d bindings))
((simple-variable? p)
(match-simple-variable p
d bindings))
((segment-variable? p)
;; rule out standalone segment var - it's not clear
what that means.
;; all other segment variables will be handled by
match-pieces.
#f)
((pair? p)
;; We don't check d here because ((* x)) matches
()
(match-pieces p d bindings))
(else #f)))
(define (match-atoms p d bindings)
;;Are the pattern and datum the same:
(if (eqv? p d)
; eqv? not eq? because of numbers.
;;If so, return the value of BINDINGS:
bindings
;;Otherwise, return #f
#f))
(define (match-simple-variable variable-expression d bindings)
(let ((binding (find-binding variable-expression bindings)))
;;Is the pattern variable on the list of bindings:
(if binding
;;If it is, substitute its value
and try again:
(do-match (extract-value binding)
d bindings)
;;Otherwise, add new binding:
(add-binding variable-expression
d bindings))))
(define (match-pieces p d bindings)
(if (segment-variable? (first p))
(match-segment-variable (first p) (rest p)
d bindings)
(if (pair? d)
(let ((result (do-match (first p) (first d) bindings)))
;;See if the FIRST parts match producing
new bindings:
(if result
;;If they do match, try the REST parts
using the resulting bindings:
(do-match (rest p) (rest d) result)
;;If they do not match, fail.
#f))
#f)))
(define (match-segment-variable
variable-expression rest-p d bindings)
;; THIS IS THE CODE YOU HAVE TO PROVIDE!
(let ((result (matcher rest-p d bindings empty d)))
(if (first result)
(let ((binding (find-binding variable-expression
bindings)))
;;Is the pattern variable on the list of bindings:
(if binding
;;If it is, substitute its value
and try again:
(do-match (cons (extract-value
binding) rest-p) d bindings)
;;Otherwise, add new binding and
recurse:
(do-match rest-p (rest
result) (add-binding variable-expression (first result) bindings))))
#f)))
(define (matcher rest-p d bindings matched-d rest-d)
(let ((result (do-match rest-p d bindings)))
(if (or result (empty? d))
(cons matched-d rest-d)
(matcher rest-p (rest d)
bindings (append matched-d (cons (first d) empty)) (rest rest-d)))))
;;;; BINDINGS ABSTRACTION
;;; adds a new binding for a variable to a bindings list.
;;; a variable expression is of the form (? x) or (* x)
(define (add-binding variable-expression datum bindings)
(if (nameless-variable? variable-expression)
;; If it is a nameless variable, it matches anything
but does not add bindings
bindings
;; add a new binding, remembering that the car of
the list is the symbol 'bindings
(cons (first bindings)
(cons (list (variable-name variable-expression)
datum)
(rest bindings)))))
;;; returns the binding for a variable (or #f if none)
;;; a variable expression is of the form (? x) or (* x)
(define (find-binding variable-expression bindings)
(if (and bindings
(not (nameless-variable? variable-expression)))
;; If it's a nameless variable, don't look for binding.
Otherwise, use
;; assoc to find the binding. (assoc x y) looks
for a list in y whose car
;; is x and returns that, which is just what we need.
(assoc (variable-name variable-expression)
;; Skip the symbol at the beggining of bindings
list.
(rest bindings))
#f))
(define (extract-key binding) (first binding))
(define (extract-value binding) (second binding))
;;; VARIABLES
;;; A test for a (? x) type of variable.
(define (simple-variable? x)
(and (pair? x) (eq? '? (first x))))
;;; A test for a (* x) type of variable.
(define (segment-variable? x)
(and (pair? x) (eq? '* (first x))))
;;; A test for a (? _) or (* _) type of variable.
(define (nameless-variable? x)
(and (pair? x) (memq (first x) '(? *)) (eq? '_ (second x))))
;;; Get the name for a variable, given (? var)
(define (variable-name x) (second x))
;;; UTILITIES
;;; Something that has no further structure to match and can be compared
;;; directly (using eqv?).
(define (atom? x) (or (symbol? x) (number? x) (boolean? x) (null? x)))
;;; Add elt to the end of lst.
(define (add-to-end elt lst)
(append lst (list elt)))
;;; TESTS
(match '(a (? x) b c) '(a d b c)) ;;; ==> (bindings (x d))
(match '(a (? x) b (? x)) '(a c b c)) ;;; == > (bindings (x c))
(match '(a c b d) '(a c b d)) ;;;;==> (bindings)
(match '(a (?x) b (? x)) '(a c b d)) ;;;;==> #f
(match '((* x) c) '(a b c)) ;;;==> (bindings (x (a b)))
(match '(a (* x) c) '(a b c)) ;;;==> (bindings (x (b)))
(match '(a (* x) c (* y) e) '(a b b b c d d d e)) ;;; ==> (bindings (y
(d d d)) (x (b b b)))
(match '(a (* x) c) '(a c)) ;;;==> (bindings (x ()))
(match '(a (* x) c (* x)) '(a b c d)) ;;;==> #f
Questions? Email: vikass@cs.uchicago.edu