I am trying to write a function which compares two lists for homework. When the function run it should be something like this ;(cmp ‘(cat ?x mat ?x) ‘(cat bat mat bat)) => t ;(cmp ‘(cat ?x mat ?x) ‘(cat bat mat sat)) => nil. meaning that in the first list when equal to ?x and the second ?x return true if both are pointing to the same value.
When I run the program now is giving me "error while parsing arguments to special form if: invalid number of elements" Here is my code if you can give me some feedback. Thanks.
;cmp algorithm
;1 if the both lists are empty return true
;2 if only one of the lists is empty return fasle
;3 compare first of the list1 and the first of list2
;if equal go on to the rest of the list with recursive call else return false
(defun cmp (list1 list2)
(setq y '())
(setq z '())
(defparameter *counter* 0)
(cond
((and (null list1) (null list2))
t
)
((or (null list1) (null list2))
nil
)
((or (eq (first list1) (first list2))
(eq (first list1) '?x) )
(cmp (rest list1) (rest list2) )
;if (first list is equal to '?x)
;set the counter to 1
;give the value of (first(rest list2)) to y
;if (first list is equal to '?x) again
;set the counter to 2
;give the value of (first (rest list2)) to z
;i need to compare y and z if eq return true
(if (eq (first list1) '?x)
(princ (first list1 ))
(princ (first(rest list2)))
(1+ *counter*)
(set y (first(rest list2)))
(if (= *counter* 2)
(set z (first (rest list2)))
)
)
(if (= y z) t)
)
(t
nil)
)
)
;(cmp ‘(cat ?x mat ?x) ‘(cat bat mat bat)) => t
;(cmp ‘(cat ?x mat ?x) ‘(cat bat mat sat)) => nil
You're almost there. You're missing how to match generically on any symbol whose first character is ?
and how to pass matches to recursive calls.
You need to save your matches somewhere between calls. A possible approach is pass them in an optional association list of matches:
(defun cmp (list1 list2 &optional matches)
(cond ((and (null list1) (null list2))
t)
((or (null list1) (null list2))
nil)
((and (symbolp (first list1))
(plusp (length (symbol-name (first list1))))
(eql (char (symbol-name (first list1)) 0) #\?))
(let ((assoc (assoc (first list1) matches)))
(cond ((null assoc)
(cmp (rest list1) (rest list2)
(list* (cons (first list1) (first list2))
matches)))
((eql (cdr assoc) (first list2))
(cmp (rest list1) (rest list2) matches)))))
((eql (first list1) (first list2))
(cmp (rest list1) (rest list2) matches))))
A very similar approach to this one which uses a dynamic variable:
(defvar *matches* '())
(defun cmp (list1 list2)
(cond ((and (null list1) (null list2))
t)
((or (null list1) (null list2))
nil)
((and (symbolp (first list1))
(plusp (length (symbol-name (first list1))))
(eql (char (symbol-name (first list1)) 0) #\?))
(let ((assoc (assoc (first list1) matches)))
(cond ((null assoc)
(let ((*matches* (list* (cons (first list1) (first list2))
*matches*)))
(cmp (rest list1) (rest list2))))
((eql (cdr assoc) (first list2))
(cmp (rest list1) (rest list2))))))
((eql (first list1) (first list2))
(cmp (rest list1) (rest list2)))))
Both could be called this way:
> (cmp '(?x b ?x d ?y f ?y h)
'(a b c d e f g h))
nil
> (cmp '(?x b ?x d ?y f ?y h)
'(a b a d e f e h))
t
However, if you already start with an association list of matches, the first one is called like this:
> (cmp '(?x ?y)
'(a b)
'((?x . a)))
t
While the second one is to be used like this:
> (let ((*matches* '((?x . a))))
(cmp '(?x ?y)
'(a b)))
t
Exercise: Make cmp
always match '?
(a symbol whose name is solely the question mark) to anything.
This may be useful if you want an element to be there but you want to ignore it otherwise.
Exercise: Make cmp
more useful and return the list of found associations instead of t
:
> (cmp '(?x ?y)
'(a b))
((?x . a)
(?y . b))
;;; Assuming option one
> (cmp '(?x ?y)
'(a b)
'((?x . a)
(?z . c)))
((?x . a)
(?y . b))
> (cmp '(?x ?y)
'(c b)
'((?x . a)
(?z . c)))
nil
The idea is to return only the found associations, and not the unused ones. So, even though the second test returns non-nil
, ?z
doesn't appear in the result.
While reading the book or documentation will certainly help, sometimes looking at example code, especially after you already understand the problem can help too. So here's an unpretentious straight-forward solution:
(defun compare-using-wildcards (pattern matched)
(loop for p in pattern
for m in matched
with keys = (make-hash-table)
do (unless (eql p m) ; Doesn't matter
; if it starts with ?
; we still don't consider
; it a wildcart symbol, if
; it matches the symbol in
; the other list.
(if (and (symbolp p)
(char= (aref (symbol-name p) 0) #\?))
(multiple-value-bind (registered exists)
(gethash p keys)
(if exists
(unless (eql registered m)
(return))
(setf (gethash p keys) m)))
(return)))
finally (return t)))
(compare-using-wildcards '(cat ?x mat ?x) '(cat bat mat bat)) ; T
(compare-using-wildcards '(cat ?x mat ?x) '(cat bat mat sat)) ; NIL
(compare-using-wildcards '(cat ?x mat ?y) '(cat bat mat sat)) ; T
(compare-using-wildcards '(cat ?x max ?y) '(cat bat mat sat)) ; NIL
But there are lots and lots of ways to do this! For example, if lists are known to be short, it could be feasible to do this via destructuring-bind
. Alternatively, you could've written a "zip" function (a higher order function that feeds cells from multiple lists to other function until it returns non-nil result) and so on.
And a somewhat contrived example. Well, it looks like it should work, unless I'm missing some corner case. It would compare multiple lists against the list with wildcards:
(every (let ((keys (make-hash-table)))
#'(lambda (&rest elements)
(let ((wildcard (car elements)))
(if (and (symbolp wildcard)
(char= (aref (symbol-name wildcard) 0) #\?))
(let ((replacement (gethash wildcard keys))
(i -1))
(if replacement
(every #'(lambda (x)
(eql x (aref replacement (incf i))))
(cdr elements))
(setf (gethash wildcard keys)
(coerce (cdr elements) 'vector))))
(every #'(lambda (x) (eql x wildcard)) elements)))))
'(cat ?x mat ?x)
'(cat bat mat bat)
'(cat bar mat bar)
'(cat bank mat bank)
'(cat bass mat boss))