Let's say I have a list like this one:
(define test '(r x -))
I want to know how can I distinguish each of the values in the list, for exaple:
(define (distinguish test) (equal? (car test) r)) -> Of course this returns error, but I would like it to return #t or something like that.
Thanks for the help!
A symbol not quoted in code is a variable
(define r 'x) ; define the variable r to be the symbol x
(eq? (car test) r) ; ==> #f (compares the symbol r with symbol x)
(eq? (cadr test) r) ; ==> #t (compares the symbol x with the symbol x)
(eq? (car test) 'r) ; ==> #t (compares the symbol r with the symbol r)
Symbol in list comparison
(define test-list '(fi fa foo))
(define test-symbol 'fi)
(eq? (car test-list) test-symbol) ; ==> #t (compares fi with fi)
(eq? 'fi 'fi) ; ==> #t (compares fi with fi)
Character in String comparison (The question title is about character not symbol):
(define test-string "test")
(define test-char #\t)
(eqv? (string-ref test-string 0) test-char) ; ==> #t (compares #\t with #\t)
(eqv? #\t #\t) ; ==> #t (compares #\t with #\t)
Related
I'm trying to replace any occurrences of a given string in a list with "X", using basic LISP commands (e.g. no mapcar) in a recursive function.
(defun removetext (symbol list replaced)
(if (not list) ; if initial list has been exhausted, return replaced list
replaced
(progn
(if (eql (car list) symbol) ; otherwise, if first element of list = symbol, replace with "X"
(removetext symbol (cdr list) (cons "X" replaced))
(removetext symbol (cdr list) (cons (car list) replaced)) ; otherwise keep it
)
(format t "~D" replaced)
)
)
)
This does not work if I call it with (removetext "E" '(A B C D E F F E) "").
This returns NIL and the printout looks like (F F E D C B A . )(F E D C B A . )(E D C B A . )(D C B A . )(C B A . )(B A . )(A . ).
I want it to return (A B C D X F F X).
(defun removetext (symbol list replaced)
(if (null list)
(reverse replaced)
(if (eql (car list) symbol)
(removetext symbol (cdr list) (cons 'x replaced))
(removetext symbol (cdr list) (cons (car list) replaced)))))
Example:
CL-USER > (removetext 'E '(A B C D E F F E) ())
(A B C D X F F X)
None of the other answers so far have addressed an important problem in your code. Given this slightly different but structurally similar version of your function:
(defun replace-thing (list thing by &key (test #'eql))
(labels ((replace-it (tail replaced)
(if (null tail)
(reverse replaced)
(progn
(if (funcall test (first tail) thing)
(replace-it (rest tail) (cons by replaced))
(replace-it (rest tail) (cons (first tail) replaced)))
(format t "~&got ~S~%" replaced)))))
(replace-it list '())))
This will fail in the same way as one of the ways yours does:
> (replace-thing '(a b c) 'a 'c)
(b c)
(c)
nil
nil
And the reason it's failing is because what progn does. You've written
(progn
... compute the thing you care about ...
(format ...))
And the value(s) of progn are the value(s) of the last form in its body, so in this case the value of (format ...) which is nil.
There are two solutions to this: one that works for you and one that is more general.
The solution that works for you is to realise that replaced is never altered (your function does no mutation, which is good), so you can safely print it first:
(progn
(format t "~& ~S~%" replaced)
(if (funcall test (first tail) thing)
(replace-it (rest tail) (cons by replaced))
(replace-it (rest tail) (cons (first tail) replaced))))
This change will make my function work.
A more general solution is to realise that what you want is some form, say first-thing which, when used as
(first-thing
thing1
...
thingn)
Will:
do the things in its body in order;
then return the value(s) of the first of them.
Well, you can write such a form pretty easily as a macro. Here's a slightly restricted version:
(defmacro first-thing (thing1 &body more-things)
(let ((sn (make-symbol "STASH")))
`(let ((,sn ,thing1))
,#more-things
,sn)))
Then
> (first-thing 1 (print "hi") (print "there"))
"hi"
"there"
1
But in fact you don't need to do that: CL offers both this restricted one and a more general one:
the restricted one is prog1 – (prog1 thing1 ... thingn) evaluates the things in order and then returns the first value of the first thing;
the general one is multiple-value-prog1 – (multiple-value-prog1 thing1 ... thingn) evaluates the things in order and then returns all the values of the first one.
multiple-value-prog1 is almost certainly more expensive than prog1 since it needs to stash multiple values somewhere and hence almost certainly conses. In your case you only need prog1 though, so a version of (my version of) your function is:
(defun replace-thing (list thing by &key (test #'eql))
(labels ((replace-it (tail replaced)
(if (null tail)
(reverse replaced)
(prog1
(if (funcall test (first tail) thing)
(replace-it (rest tail) (cons by replaced))
(replace-it (rest tail) (cons (first tail) replaced)))
(format t "~& ~S~%" replaced)))))
(replace-it list '())))
And
> (replace-thing '(a b c) 'a 'z)
(b z)
(z)
nil
(z b c)
If you want to replace occurrences of a string you'll need to pass a list of strings. You passed a list of symbols, not strings. Now you can still replace those symbols with a particular string, but they are not string themselves. The list:
'(a b c d e f e)
is a list of symbols, not string:
(defun remove-text (str lst)
(if (atom lst)
lst
(if (string-equal (symbol-name (car lst)) str)
(cons "X" (remove-text str (cdr lst)))
(cons (car lst) (remove-text str (cdr lst))))))
We can pass a string as an argument to check, and then a list of symbol. Our base case will test to see if the list is an atom, at which point we will simply return the list. If not, we will use string-equal to see if the symbol name of the car of the list(which will return the string value of the symbol) is equal to our string. Then we can then cons "X" unto the beginning of the list if that is the case, and then recursively call the function again. If not, we can simply cons the car of the list to the beginning of the list, and recursively call the function again. This function is not tail-recursive, but it recursive, and it does avoid creating a new list structure to store thee result, without destructively altering the structure of the original list. We can test it below:
CL-USER> (remove-text "E" '(a b c d e f f e))
(A B C D "X" F F "X")
I'm debugging this code on DrRacket:
#lang racket
(define last-element-on-list
(lambda l
(cond ((null? l) '())
((null? (cdr l)) (car l))
(else (last-element-on-list (cdr l)))
)
)
)
(define lst '(
(n 25 f +)
(s 25 m +)
(ll 20 no -)))
(list-ref lst 0)
(last-element-on-list (list-ref lst 0))
The code (list-ref lst 0) returns '(n 25 f +), but when I get into the procedure last-element-on-list the parameter l has the value ((n 25 f +)).
Why l is a list of list in procedure last-element-on-list?
There's a difference between the (lambda (x) ...) form and the (lambda x ...) form.
Observe the difference between these two examples:
;; Example 1.
(define f
(lambda (x)
(if (list? x)
(display "x is a list!")
(display "x is not a list"))))
(f 1) ; Displays "x is not a list".
;; Example 2.
(define g
(lambda x
(if (list? x)
(display "x is a list!")
(display "x is not a list"))))
(g 1) ; Displays "x is a list!".
The (lambda x ...) form allows the lambda to take any number of arguments, with all the arguments put into a list bound to x in the lambda's body. i.e. x is the list of arguments.
That's why when you give g a list (e.g. (g '(1 2 3))), x will be '((1 2 3)) (a list of lists).
To fix your code:
(define last-element-on-list
(lambda (l) ; <- ATTENTION.
(cond ((null? l) '()) ; FIXME: raise error instead.
((null? (cdr l)) (car l))
(else (last-element-on-list (cdr l))))))
You can read more about lambda in The Racket Guide. In particular, look at section 4.4.1 (Declaring a Rest Argument).
I think it will be better to raise an error when calling your procedure on an empty list –
(define last-element-of-list
(lambda (l)
(cond ((null? l)
(error 'last-element-of-list "cannot get last element of empty list"))
((null? (cdr l))
(car l))
(else
(last-element-of-list (cdr l))))))
(last-element-of-list '(1)) ;; 1
(last-element-of-list '(1 2)) ;; 2
(last-element-of-list '(1 2 3)) ;; 3
(last-element-of-list '(1 2 3 4)) ;; 4
(last-element-of-list '()) ;; error: cannot get last element of empty list
(define fun4
(lambda ( ls)
(cond ((null? ls ) #f)
(cons (((eqv? 'a (car ls))) && ((eqv? 'b (cdr ls)))))
(else (pattern2 cdr ls)))))
In this it showing error - procedure application: expected procedure, given: #t (no arguments),
What is the erroe in my code. Is logic is fine ???
There are many, many errors in your solution. Let's see what's wrong in each of the conditions:
The base case of the recursion (empty list) is wrong: an empty list is the exit of the recursion, and it means that the list was traversed correctly and it follows the pattern
Another base case is missing: what if the list has a single element?
If the pattern doesn't hold, we must return #f immediately, and notice how we use cadr for accessing the second element, because && doesn't work in Scheme, you must use and for the logical and operation. Also you have unnecessary, erroneous parentheses surrounding each test (by the way: those were the ones causing the "expected procedure" error)
Only if none of the above conditions hold we advance the recursion, and we do so by moving two elements further down the list using cddr. Also you must call fun4 to advance the recursion, not pattern2
This is the correct way to solve the problem, notice how the above issues were addressed:
(define fun4
(lambda (ls)
(cond ((null? ls) #t) ; 1
((null? (cdr ls)) #f) ; 2
((not (and (eq? 'a (car ls)) (eq? 'b (cadr ls)))) #f) ; 3
(else (fun4 (cddr ls)))))) ; 4
Always test your procedures, the above will work correctly:
(fun4 '())
=> #t
(fun4 '(a))
=> #f
(fun4 '(a b))
=> #t
(fun4 '(a b a))
=> #f
(fun4 '(a b a b))
=> #t
As a final note, if the empty list is not supposed to follow the pattern, then check for it before calling fun4 and return #f if the initial input list is empty.
(define fun
(lambda (ls)
(cond ((null? ls) #t)
((and (eq? (car ls) 'a) ; the first item is a
(list? (cdr ls)) ; the rest of the list
(not (null? (cdr ls))) ; which is not null
(eq? (cadr ls) 'b) ; and it starts with b
(fun (cddr ls))) #t) ; and the rest of the expression is
(else #f)))) ; also in the A B format
Running:
> (fun '(a b a b))
#t
> (fun '(a b a))
#f
> (fun '(a b))
#t
> (fun '(a))
#f
> (fun '())
#t
>
So much wheel reinvention. Just use SRFI 1!
(require srfi/1)
(define (fun4 lst)
(every eq? lst (circular-list 'a 'b)))
(This operates under the assumption that (a b a) should be valid rather than invalid.)
i've got a problem: I need to find if list equal to the second one, for example:
(set%eq? '(1 2 3) '(1 2 3)) ===> #t
(set%eq? '(1 2 3) '(2 3 4)) ===> #f
That examples are correct in my program, but this one is not:
(set%eq? (quote ((quote one) (quote two) (quote three))) (quote ((quote one) (quote two)
(quote three)))) ====> #f but i need #t
what's wrong?
this is my program:
(define (set-eq? xs ys)
(cond ((and (null? xs) (null? ys)) #t)
((null? ys) #f)
((eq? (car xs) (car ys)) (set-eq? (cdr xs) (cdr ys)))
((eq? (car xs) (car (reverse ys))) (set-eq? (cdr xs) (cdr (reverse ys))))
(else #f)))
There are a couple of mistakes in the posted code, and FYI, the procedure tests whether two lists are equal, it's not really testing for equality between two sets:
(define (set-eq? xs ys)
(cond ((and (null? xs) (null? ys)) #t)
((or (null? xs) (null? ys)) #f) ; missing case
((equal? (car xs) (car ys)) (set-eq? (cdr xs) (cdr ys))) ; use equal?
; deleted unnecessary case here. Anyway, why are you reversing the list?
(else #f)))
Now this will work:
(set-eq? '(1 2 3) '(1 2 3))
=> #t
(set-eq? '(1 2 3) '(2 3 4))
=> #f
(set-eq? (quote ((quote one) (quote two) (quote three)))
(quote ((quote one) (quote two) (quote three))))
=> #t
In fact, this will work, too:
(equal? '(1 2 3) '(1 2 3))
=> #t
(equal? '(1 2 3) '(2 3 4))
=> #f
(equal? (quote ((quote one) (quote two) (quote three)))
(quote ((quote one) (quote two) (quote three))))
=> #t
...But this won't work, the lists are clearly different:
(set-eq? '(1 2 3 4) '(4 1 2 3))
=> #f
If you intended to test for equality between two sets, you have to completely rethink the algorithm. Here's an idea: write asubset? procedure that tests if a list is a subset of another list (that is: if all the elements in one list are contained in the other list), and then test whether (and (subset? l1 l2) (subset? l2 l1)) is true, if that happens, then they're equal according to the set definition of equality.
Base on the comments from OP it's clear that these are set-eq?
(set-eq? '(a b c) '(c b a)) ; ==> #t
(set-eq? '(a b c) '(b c a)) ; ==> #t
(set-eq? '() '()) ; ==> #t
(set-eq? '(a b) '(a b c)) ; ==> #f
(set-eq? '(a b c) '(a c)) ; ==> #f
If the lists are without duplicates one could iterate the first list and try to find it in the second. If found we recurse with the two lists without the match.
#!r6rs
(import (rnrs)
(rnrs lists))
(define (set-eq? xs ys)
(if (null? xs)
(null? ys) ; #t if both sets are empty, otherwise #f
(let ((cur (car xs)))
(and (memq cur ys) ; first element is found
(set-eq? <??> (remq <??> <??>)))))) ; recurse without first in both lists
There are ways to get this faster. E.q. Hash the first list and iterate the second. If all matches and hashtable-size is the same as the number of iterations it's #t.
I'm new to Common Lisp and have been working on a simple pattern matcher as a first project. I'm having trouble using the star (*) operator to represent 0 or more of any element in a list. So the pattern (x * z) and the matcher (x y y y z) would return true, but the pattern (x * z) and the matcher (x y) would return false.
My first thoughts:
(loop for x in pattern-list
(eq x '*)
;if x is *, pause iterating through this list
(loop for y in matcher-list
;somehow iterate one more value in the pattern list
(eq x y) ;does the value just after the * in the pattern list equal the value in y?
;if they aren't the same symbol, just iterate matcher until they match, then resume incrementing though the pattern list
))
Sorry if my syntax and parenthesis are a little off.
This is a smaller piece to a larger pattern matcher that I was working on. Here's what I have so far (In this case, list1 is pattern-list and list2 is matcher-list):
The bulk of this code originated from this SO post:
Setting up a equal function in common lisp using only "eq"
(defun comp-q (list1 list2) ;defun
(if (and (not (null list1)) ;if list1 is not null AND
(not (null list2))) ;if list2 is not null
(let ((a (car list1)) (b (car list2))) ;a is the car (front) of list1 and b is the car of list 2
(cond ((and (listp a) (listp b)) ;cond, evaluate the first thing in the list - are a and b lists?
(and (comp-q a b) ;recursive call on a and b
(comp-q (cdr list1) (cdr list2)))) ;recursive call on the cdr (tail) of a and b
(t ;like an else for cond
(and (or (eq a b) (eq a '?)) ;are a and b equal OR is a a '?'
(comp-q (cdr list1) (cdr list2)))))) ;recursive call on the cdr of a and b
(= (length list1) (length list2)))) ;are the lists equal? only triggered if the null test fails (are they both not null)
Is using the loop macro my best bet? Is it possible to "pause" or keep track of iterations over a list (I know this is array-esque)? Or should I try to continue working recursively by calling the car and cdr of each list that is being implemented in the comp-q defun?
Thanks.
Since nobody has given any answer yet, and since a recursive approach was suggested, I have come up with an example in Racket to get you started. It should be straightforward to convert to Common Lisp.
(define (match pattern matcher)
; is the symbol a wildcard (i.e. does it end with an asterisk?
; yes -> return true + the symbol without the asterisk
; no -> return false + the symbol itself
(define (is-wildcard sym)
(let ((str (symbol->string sym)))
(if (string=? (substring str (sub1 (string-length str))) "*")
(values #t (string->symbol (substring str 0 (sub1 (string-length str)))))
(values #f sym))))
; we know wi is a wildcard; let's loop over matcher until done
(define (match-wildcard wi pattern matcher)
(if (empty? matcher)
(list (cdr pattern) matcher)
(if (eq? wi (car matcher))
(match-wildcard wi pattern (cdr matcher))
(list (cdr pattern) matcher))))
; main loop
(if (or (empty? pattern) (empty? matcher))
(and (empty? pattern )(empty? matcher))
(let ((pa (car pattern)) (ma (car matcher)))
(if (eq? pa ma)
(match (cdr pattern) (cdr matcher))
(let-values (((wildcard wi) (is-wildcard pa)))
(if wildcard
(apply match (match-wildcard wi pattern matcher))
#f))))))
Examples:
(match '(x y* z) '(x y y y z))
=> #t
(match '(x z* y) '(x y))
=> #t
(match '(x y* z) '(x y))
=> #f
(match '(x y*) '(x y))
=> #t
HTH!