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
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))
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.
Related
I have following task:
Define a function replace-element that searches a given list for a given element x and replaces each element x with a given element y.
I am a super beginner and have no idea how to do this.
Maybe there is someone who can help me. Thanks a lot!!
For example:
(replace-element ‘a ‘b ‘(a b c a b c))
(B B C B B C)
Here is a way of doing this which, again, you probably cannot submit as homework, but it shows you an approach.
First of all, tconc and friends to accumulate lists:
(defun empty-tconc ()
;; make an empty accumulator for TCONC
(cons nil nil))
(defun tconc (v into)
;; destructively add V to the end of the accumulator INTO, return
;; INTO
(if (null (car into))
(setf (car into) (list v)
(cdr into) (car into))
(setf (cdr (cdr into)) (list v)
(cdr into) (cdr (cdr into))))
into)
(defun tconc-value (into)
;; Retrieve the value of an accumulator
(car into))
Next the answer:
(defun replace-element (x y l)
(replace-element-loop x y l (empty-tconc)))
(defun replace-element-loop (x y l accumulator)
(if (null l)
(tconc-value accumulator)
(replace-element-loop
x y (rest l)
(tconc (if (eql (first l) x) y (first l)) accumulator))))
Or you do the tail call recursion in one function using optional arguments or key arguments:
(defun replace-element (element replacer l &key (acc '()) (test #'eql))
(cond ((null l) (nreverse acc))
((funcall test (car l) element) (replace-element element replacer (cdr l) :acc (cons replacer acc) :test test))
(t (replace-element element replacer (cdr l) :acc (cons (car l) acc) :test test))))
It is also possible to use reduce for this:
(defun replace-element (element replacer l &key (test #'eql))
(nreverse
(reduce (lambda (res el)
(if (funcall test el element)
(cons replacer res)
(cons el res)))
l
:initial-value '())))
How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
I'm trying to add a given variable x to a list L. Both of which are parameters of the function ADDV. The code I have so far is as follows:
(defun addV(L x)
(cond
((eq L nil) nil)
((eq (cdr L) nil) (list(+(car L) x)))
(+ x (first(last L)))
(butlast L)
(append L x) ) )
With the parameters
L = '(1 2 3 4)
x = 2
When the statement: (+ x (first(last L)))) is evaluated, it's value is 4. The final goal should be
L = '(1 2 3 6)
I'm not sure what I'm doing wrong. Any help would be greatly appreciated. Thanks.
Your code is badly formatted. Re-indenting, we get
(defun addV(L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(+
x
(first (last L)))
(butlast
L)
(append
L
x) ) )
do you see the problem now?
Since (not +) is NIL, the corresponding clause in the COND form is entered. Its body's forms (x and (first (last L))) are evaluated for effects, of which there are none. Then the last form's value is returned.
What you evidently wanted it to be, is
(defun addV (L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(T
(append
(butlast L)
(list (+ x (first (last L))))))))
Coincidentally, the 2nd clause it completely unnecessary and may just be omitted, making it
(defun addV (L x)
(if (not (null L))
(append (butlast L)
(list (+ x (first (last L)))))))
If you can do this destructively, then you can use incf and last:
(defun increment-last (list x)
(prog1 list ; return the list
(incf (first (last list)) x)))
If you do need to make a new list, you'll have to walk to the end of the list to get to the last element. While you're doing that, you could keep track of the elements you've already seen (in reverse order) and efficiently use that reverse order list to construct the new list for you using nreconc:
(defun plus-last (list x)
(do ((list list (rest list))
(rhead '() (list* (first list) rhead)))
((endp (rest list))
(nreconc rhead (list (+ x (first list)))))))
CL-USER> (plus-last '(1 2 3 4) 2)
(1 2 3 6)
If you're not so comfortable with do syntax, you could use a tail recursive function, too (which some Common Lisp implementations can optimize into a loop):
(defun plus-last (list x)
(labels ((pl (list rhead)
(if (endp (rest list))
(nreconc rhead (list (+ x (first list))))
(pl (rest list)
(list* (first list) rhead)))))
(pl list '())))
You could also use loop, and express the logic pretty clearly:
(defun plus-last (list x)
(loop for (a . b) on list
if (null b) collect (+ a x)
else collect a))
This could also be done with maplist:
(defun plus-last (list x)
(maplist (lambda (list)
(if (endp (rest list))
(+ x (first list))
(first list)))
list))
I know this question has been asked before, and my solution is the same as many of the answers but I have a special test case that won't work correctly with the common solution to this problem.
The solution that I have found for the zip problem like many others is
(define (zip l1 l2)(map list l1 l2))
. . .which works great with given arguments such as
(zip '(a b c) '(1 2 3)) => ((a 1) (b 2) (c 3))
but I also want the zip function to work for cases where my arguments do not match length like
(zip '(a b c) '(1)) => ((a 1) (b ()) (c ()))
I have not found a solution to this problem and not really sure how to approach it where each list can be any length.
First, a simple iterative version that works for 2 lists only:
(define (zip lst1 lst2 (placeholder '()))
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lst1 lst1) (lst2 lst2) (res '()))
(if (and (empty? lst1) (empty? lst2))
(reverse res)
(loop (my-cdr lst1) (my-cdr lst2)
(cons (list (my-car lst1) (my-car lst2)) res)))))
such as
(zip '(a b c) '(1 2 3))
=> '((a 1) (b 2) (c 3))
(zip '(a b c) '(1))
=> '((a 1) (b ()) (c ()))
From this, you can generalise to n lists, but to avoid keyword parameters you have to put the placeholder parameter first:
(define (zip placeholder . lsts)
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lsts lsts) (res '()))
(if (andmap empty? lsts)
(reverse res)
(loop (map my-cdr lsts)
(cons (apply list (map my-car lsts)) res)))))
such as
(zip '() '(a b c) '(1 2 3))
==> '((a 1) (b 2) (c 3))
(zip '() '(a b c) '(1))
==> '((a 1) (b ()) (c ()))
(zip '() '(a b c) '(1) '(x y))
=> '((a 1 x) (b () y) (c () ()))
I believe that andmap is the only Racket-specific function here, which probably has some Scheme or SRFI equivalent depending on your implementation.
EDIT
Since the solution is based on creating lists of equal length, instead of duplicating the zip algorithm, you can also first add the placeholders to the lists before doing the classic map-list stuff:
(define (zip placeholder . lsts)
(let* ((max-len (apply max (map length lsts))) ; the length of the longest lists
(equal-length-lists ; adjusts all lists to the same length,
(map ; filling with placeholder
(lambda (lst) (append lst (make-list (- max-len (length lst)) placeholder)))
lsts)))
(apply map list equal-length-lists))) ; classical zip
It's not semantically correct to have (zip '(a b c) '(1)) => ((a 1) (b ()) (c ())) (unless you're specifically using () as a placeholder value); it's more sensible to have ((a 1) (b) (c)). Here's an implementation that achieves that:
(define (zip-with-uneven . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists)) (loop (cdr lists) result))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))
andmap is from Racket. If you're not using Racket, you can use every from SRFI 1 instead.
If you really want to use a placeholder, here's a (Racket-specific) version that supports placeholders. The default placeholder is (void), which I presume is never a valid value you'd want to put in your result list.
(define (zip-with-uneven #:placeholder (ph (void)) . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (cons-with-placeholder a d)
(if (void? a)
d
(cons a d)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists))
(loop (cdr lists) (cons-with-placeholder ph result)))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))
I'm trying to write a scheme function that will return the unique atoms found in the input list such that.
> (unique-atoms '(a (b) b ((c)) (a (b))))
(a c b)
> (unique-atoms '(a . a))
(a)
> (unique-atoms '())
()
I was thinking something like this as a start
(define (unique-atoms l)
(if (null? l)
'()
(eq? (car (l) unique-atoms(cdr (l))))))
but I don't know how to collect the atoms that are unique, and create a new list while checking everything recursively.
The following walks list, term by term. If the next value is a list itself, then a recursive call is made with (append next rest) - that is, as list is walked we are flattening sublists at the same time.
We use a (tail) recursive function, looking, to walk the list and to accumulate the rslt. We add to the result when next is not alreay in rslt.
(define (uniquely list)
(let looking ((rslt '()) (list list))
(if (null? list)
rslt
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(looking rslt (append next rest))
(looking (if (memq next rslt)
rslt
(cons next rslt))
rest))))))
> (uniquely '(a b (a b) ((((a))))))
(b a)
If you really want the code to work for 'improper lists' like '(a . a) then the predicates null? and list? probably need to change.
This problem has two parts:
You need to find a way to visit each element of the given form, recursing into sublists.
You need a way to collect the unique elements being visited.
Here's a solution to the first part:
(define (recursive-fold visitor initial x)
(let recur ((value initial)
(x x))
(cond ((null? x) value)
((pair? x) (recur (recur value (car x)) (cdr x)))
(else (visitor x value)))))
I leave it for you to implement the second part.
I found a half solution where the non unique items are removed, although this wont work for an atom b and a list with b such as '(b (b))
(define (uniqueAtoms l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(uniqueAtoms (cdr l)))
(else
(cons (car l) (uniqueAtoms (cdr l))))))
The easiest way to solve this problem with all kinds of list structures is to divide it into two parts
1) flatten then list - this results in a proper list with no sublists
; if you use Racket, you can use the build-in flatten procedure
; otherwise this one should do
(define (flatten expr)
(let loop ((expr expr) (res '()))
(cond
((empty? expr) res)
((pair? expr) (append (flatten (car expr)) (flatten (cdr expr))))
(else (cons expr res)))))
2) find all unique members of this proper list
(define (unique-atoms lst)
(let loop ((lst (flatten lst)) (res '()))
(if (empty? lst)
(reverse res)
(let ((c (car lst)))
(loop (cdr lst) (if (member c res) res (cons c res)))))))
Tests:
; unit test - Racket specific
(module+ test
(require rackunit)
(check-equal? (unique-atoms '(a (b) b ((c)) (a (b)))) '(a b c))
(check-equal? (unique-atoms '(a (b) b ((c . q)) (a (b . d)))) '(a b c q d))
(check-equal? (unique-atoms '(a . a)) '(a))
(check-equal? (unique-atoms '(a b (a b) ((((a)))))) '(a b))
(check-equal? (unique-atoms '()) '()))