Common Lisp - Pattern Matching - functional-programming

I'm trying to write a function which compare two lists in Common Lisp.
The sign ’&’ indicates any sequence of elements and the sign ’$’ indicates any single element.
(defun match (filter data)
(cond
((atom filter) (eq filter data))
((atom data) NIL)
((eq (car filter) '|$|)
(match (cdr filter) (cdr data)))
((eq (car filter) '|&|)
(cond
((match (cdr filter) data))
(data (match filter (cdr data)))))
((match (car filter) (car data))
(match (cdr filter) (cdr data)))))
which works fine :
(match '(a b c) '(a b c)) ; => T
(match '(a $ c) '(a b c)) ; => T
(match '(a ff c) '(a b c)) ; => NIL
(match '(a & c) '(a z b c)) ; => T
I would like to add a new filter (with the% symbol) which allows the choice between different possible elements, for example
(match '(a %(b 1) c) '(a b c)) ; => T
(match '(a %(b 1) c) '(a 1 c)) ; => T
(match '(a %(b 1) c) '(a z c)) ; => NIL

You have to try all the elements in the sublist after % to see if any of them, combined with the rest of the filter, matches the data:
(defun match (filter data)
(cond
((atom filter) (eq filter data))
((atom data) NIL)
((eq (car filter) '|$|)
(match (cdr filter) (cdr data)))
((eq (car filter) '|&|)
(cond
((match (cdr filter) data))
(data (match filter (cdr data)))))
((eq (car filter) '|%|)
(some #'(lambda (f) (match (cons f (cddr filter)) data)) (cadr filter)) )
((match (car filter) (car data))
(match (cdr filter) (cdr data)))))
You should also add some checking steps to ensure that the filter is correctly formed, i.e. that the element after % is a list, etc...

Related

Is there a way to write your own recursive function to reverse a list in Scheme? [duplicate]

What is the function to reverse a list in Scheme?
It needs to be able to handle nested lists. So that if you do something like (reverse '(a (b c d) e)) you'll get (e (b c d) a) as the output.
How should I approach this problem? I'm not just looking for an answer, but something that will help me learn.
(define (my-reverse ls)
(define (my-reverse-2 ls acc)
(if (null? ls)
acc
(my-reverse-2 (cdr ls) (cons (car ls) acc))))
(my-reverse-2 ls '()))
This uses an accumulator variable to reverse the list, taking the first element off the incoming list and consing it to the front of the accumulator. It hides the accumulator taking function and just exposes the function that takes a list, so the caller doesn't have to pass in the empty list. That's why I have my-reverse-2.
(my-reverse-2 '(a (b c d) e) '()); will call
(my-reverse-2 '((b c d) e) '(a)); which will call
(my-reverse-2 '(e) '((b c d) a)); which will call
(my-reverse-2 '() '(e (b c d) a)); which will return
'(e (b c d) a)
Because the last function call in my-reverse-2 is a call to my-reverse-2, and the return value is passed right through (the return value of the first call is the return value of the second call, and so on) my-reverse-2 is tail optimized, which means it will not run out of room on the stack. So it is safe to call this with a list as long as you like.
If you want it to apply to nested lists use something like this:
(define (deep-reverse ls)
(define (deep-reverse-2 ls acc)
(if (null? ls)
acc
(if (list? (car ls))
(deep-reverse-2 (cdr ls) (cons (deep-reverse (car ls)) acc))
(deep-reverse-2 (cdr ls) (cons (car ls) acc)))))
(deep-reverse-2 ls '()))
This checks to see if the element is a list before adding it to the list, and if it is, reverses it first.
Since it calls itself to revers the inner list, it can handle arbitrary nesting.
(deep-reverse '(a (b c d) e)) -> '(e (d c b) a) which is in reverse alphabetical order, despite the fact that there is a nested list.
It evaluates as so:
(deep-reverse-2 '(a (b c d) e) '()); Which calls
(deep-reverse-2 '((b c d) e) '(a))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(b c d) '()) '(a)))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(c d) '(b)) '(a)))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(d) '(c b)) '(a)))
(deep-reverse-2 '(e) (cons '(d c b) '(a)))
(deep-reverse-2 '(e) '((d c b) a))
(deep-reverse-2 '() '(e (d c b) a))
'(e (d c b) a)
Use:
(define (reverse1 l)
(if (null? l)
nil
(append (reverse1 (cdr l)) (list (car l)))
)
)
Explanation:
Rules:
If the list is empty, then the reverse list is also empty
Else behind the reverse tail of the list, add the first element of the list
Look at this code this way:
reverse1 is name of the function and l is a parameter. If the list is empty then the reverse is also empty.
Else call the reverse1 function with (cdr l) which is the tail of the list and append that to the first alement (car l) that you make as a list.
In your example (pseudocode):
1st iteration
l=>(a (bcd)e)
car l => a
cdr l => (bcd)e
list(car l) =>(a)
------------------
reverse( cdr l)"+"(a)
------------------
2nd iteration
l=>((bcd)e)
car l => (bcd)
cdr l =>e
list(car l)=>(bcd)
--------------------
reverse(cdr l)"+"((bcd))+(a)
-----------------------
3rd iteration
l=>e
car l=> e
cdr l => nil
list (car l) =>(e)
-------------------------
(e (bcd)a)
This is one way that you can make a reverse function that applies to nested lists:
(define (reverse-deep l)
(map (lambda (x) (if (list? x) (reverse-deep x) x)) (reverse l)))
Explanation in pseudo-code:
Start by reversing the list as you would normally do
Then for each element in the reversed list:
- If the element is a list itself: Apply the procedure recursively
- Else: Don't touch the element
You could simply reverse the elements in a list using foldr:
(foldr (lambda (a r) (append r (list a))) empty lst)
This is a reverse function in Racket which I like much better than Scheme.
It uses the match pattern matching function only.
(define/match (rev l)
[('()) '()]
[((list a ... b)) (cons b (rev a))])
> (rev '(a (b c d) e))
'(e (b c d) a)
My solution:
(define (rvrs ls)
(if (null? ls)
empty
(append (rvrs (cdr ls)) (cons (car ls) empty))))
I used code similar to insertion sort:
(define deep-rev-list
(lambda (l)
(cond ((null? l) (quote ()))
((atom? (car l))
(swap-till-end (carl) (deep-rev-list (cdr l))))
(else
(swap-till-end (deep-rev-list (car l)) (deep-rev-list (cdr l)))))))
(define swap-till-end
(lambda (elm lst)
(cond ((null? lst) (cons elm '()))
(else
(cons (car lst) (swap-till-end elm (cdr lst)))))))
(define atom?
(lambda (x)
(and (not (null? x)) (not (pair? x)))))
I am reproducing it from memory. There may be some errors. I will correct the code if that's the case. But the technique used is similar to the commandments for nested lists given in THe Little Schemer :). I checked it in DrRacket.
(deep-rev-list '((1 2) (3) ((4 5)))) returns (((5 4)) (3) (2 1))

Palindrome check with recursion in Lisp

I have developed code to check through input to see if it is a palindrome or not but I am having difficulty figuring out how to print the output. I want the output to return "t" if the input is a palindrome and "nil" if not. Also a challenge that I wanted to give myself was to not use the reverse function so thats why my code is not as simple as it could be. Thanks in advance.
(defun palindromep(l)
(cond ((null l) nil (write nil))
(t (append (list (car l)) (palindromep (cdr l)) (list (car l) )))))
(palindromep '(a b b a))
(terpri)
(palindromep '(a b c b a))
(terpri)
(palindromep '(a b c))
(terpri)
(palindromep '(a (d e) (d e) a))
(terpri)
(palindromep '(a (d e) (e d) a))
Firstly, an empty list is a palindrome! If we reverse it, we get the same empty list.
Secondly, Lisp functions don't print their result values; they return these values.
In an interactive session, it is the listener which prints the resulting value(s) that emerge from the expression being evaluated. That expression itself doesn't have to print anything.
Therefore, we begin like this:
(defun palindromep (l)
(cond
((null l) t) ;; the empty list is a palindrome: yield true.
Note, by the way, that if we write this:
((null l) nil t) ;; the empty list is a palindrome: yield true.
that doesn't do anything. The extra nil expression is evaluated, producing nil, which is thrown away. The Lisp compiler will completely eliminate that.
What if the list is not a list at all, but an atom other than nil? Let's just go with that being a palindrome. A clarification of requirements is needed, though:
((atom l) t)
Now we know we are dealing with a non-empty list. If it has exactly one item, then it is a palindrome:
((null (cdr l)) t)
Now we know we are dealing with a list of two or more items. That is a palindrome if the first and last items are the same, and if the items in between them form a palindrome.
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
The whole thing:
(defun palindromep (l)
(cond
((null l) t)
((atom l) t)
((null (cdr l)) t)
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Code golfing: in the cond construct described by ANSI CL, a clause is permitted to have just one form. If that forms yields a true value, then that value is returned. Thus we can remove the t's:
(defun palindromep (l)
(cond
((null l)) ;; t removed
((atom l)) ;; likewise
((null (cdr l))) ;; likewise
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Documentation about the functions ldiff and last can be found here.
Further golfing: if we have this pattern (cond (A) (B) ... (t Z)) we can just replace it by (or A B ... Z):
(defun palindromep (l)
(or (null l)
(atom l)
(let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior)))))
cond is like a generalization of or that can specify an alternative result value for the each terminating true case.
To go on with code-golfing, since t or nil is expected, you can use only or and nil to express conditionals (and using short-circuitry of or and nil expressions).
Also it is good to be able to determine a :test keyword - since you want to control the crucial testing behavior.
To be able to use also inner lists, one could e.g. use equalp or even a custom comparison function.
(defun palindromep (l &key (test #'equalp))
(or (null l) (and (funcall test (car l) (car (last l)))
(palindromep (butlast (cdr l)) :test test))))
This evaluates
(palindromep '(a (d e) (d e) a))
as t but
(palindromep '(a (d e) (e d) a))
as nil.
Well, it is maybe a philosophical question, whether the latter should be t and the former nil.
To revert that behavior, we could write a custom testing function.
Like this:
(defun reverse* (l &optional (acc '()))
(cond ((null l) acc)
((atom (car l)) (reverse* (cdr l) (cons (car l) acc)))
(t (reverse* (cdr l) (cons (reverse* (car l) '()) acc)))))
(defun to-each-other-symmetric-p (a b)
(cond ((and (atom a) (atom b)) (equalp a b))
(t (equalp a (reverse* b)))))
Well, I use here some kind of a reverse*.
Then if one does:
(palindromep '(a (d e) (d e) a) :test #'to-each-other-symmetric-p) ;; NIL
;; and
(palindromep '(a (d e) (e d) a) :test #'to-each-other-symmetric-p) ;; T
Just to complete the other answers, I would like to point out that not using reverse will not only complicate your code enormously, but also make it far more inefficient. Just compare the above answers with the classic one:
(defun palindromep (l)
(equal l (reverse l)))
reverse is o(l), i.e. it takes time proportional to the length of the list l, and so does equal. So this function will run in o(l). You can't get faster than this.

Counting occurrence of a word in LISP lists

So I have to count the occurrence of a word(or character, to be more specific) in a list in lisp. For example, the input:
(freq 'c '(a c c c c (c c c e)))
should produce a count of 7, since there are 7 c's in the list argument. The code I have is the following but it does not work. I can count the 4 c's that are base elements and the 3 c's that are in the sublist, but I dont know how to add them together. Also, I'm using only primitive data types.
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t ((freq a (cdr L))))))
If it's a character then it's should be written with this prefix -> #\
and the sequence would be a string so there is no need recursion here.
(count #\c "(a c c c c (c c c e))") => 7
What you're dealing with in your example is symbol (with a single quote) through a list which contains other symbols or cons. So if you need to count all the same symbol you could write something like that :
(defparameter *nb* 0)
(defun look-deeper (test seq)
(loop for i in seq do
(compare test i)))
(defun compare (test item)
(let ((type (type-of item)))
(case type
(symbol (when (eql test item) (incf *nb*)))
(cons (look-deeper test item)))))
(look-deeper 'c '(a c c c c (c c c e))) => NIL
*nb* => 7
Or something better..
(defun count-occurences (obj lst)
(let ((acc 0))
(labels ((test (obj-2)
(eq obj obj-2)))
(dolist (x lst)
(if (consp x)
(let ((sample (remove-if-not #'test x)))
(if sample
(incf acc (length sample))))
(if (eq x obj)
(incf acc 1)))))
acc))
We could create a function that takes an obj to test and a lst as the argument and create a local accumulator to keep track of how many times the obj occurs in the list. Then we could create a local function that tests to see if the obj we pass to it is eq to the obj passed as an argument to the global function (also note that if you are working with strings you might want to use string-equal or equal because eq will not work since they are not the same object, but eq will work with symbols which you used in your example). We can then iterate through the list, and if the element in the list is a cons we can use remove-if-not to remove any element that doesn't pass our test (is not eq to the obj), and based on the length of the list increment our accumulator accordingly. If it is not a cons and is eq to our obj we will also increment the accumulator, then we can return the value of our accumulator.
And if we test it:
CL-USER> (count-occurences 'c '(a c c c c (c c c)))
7
Your logic is actually correct, there are just some small mis-parenthesis problems in your code. The only change you need for your code to work is to change you listp and t clauses from
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
into
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
and from
(t ((freq a (cdr L))))
into
(t (freq a (cdr L)))
Then evaluating your function works just as you expect:
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t (freq a (cdr L)))))
(freq 'c '((a (c f c)) c c c (c c (d c f (c 8 c) c) e))) ; => 11 (4 bits, #xB, #o13, #b1011)

LISP - recursive palindrome

I'm trying to write a recursive palindrome function. The code works using two function as follows:
(set str(a b c d))
(defun reverseString (l)
(cond
( (null l) nil)
(T (append (reverseString (cdr l)) (list (car l))))
)
)
(defun palindrome (l)
(cond
( (null l) nil)
(T (append l(reverseString (cdr l)) (list (car l))))
)
)
However, I'm trying to combine it into a single function:
(defun palindrome (l)
(cond
( (null l)
nil
)
(T
(append str(append (palindrome (cdr l)) (list (car l))) )
)
)
)
This returns (A B C D A B C D A B C D A B C D D C B A)
Where I want it to return (a b c d d c b a) and then eventually (a b c d c b a) **not repeating the last character when it reverses.
I know there are easier ways to do this we predefined functions, but I'm trying to challenge myself a bit. However I'm stuck here, and help would be greatly appreciated.
Here is a recursive, single function palindrome:
(defun palindrome(l)
(cond ((null l) nil)
(t (append (list (car l)) (palindrome (cdr l)) (list (car l))))))
The recursion is structured in this way: make a palindrome of the rest of the list, and put at the beginning and at the end the first element of the list.
If you want to have the central element only once, here is an alternative version:
(defun palindrome(l)
(cond ((null l) nil)
((null (cdr l)) (list (car l)))
(t (append (list (car l)) (palindrome (cdr l)) (list (car l))))))
that is, you have to add a new case for the termination of the recursive function: terminate also when there is only one element, and return that element.

How can I reverse a list?

What is the function to reverse a list in Scheme?
It needs to be able to handle nested lists. So that if you do something like (reverse '(a (b c d) e)) you'll get (e (b c d) a) as the output.
How should I approach this problem? I'm not just looking for an answer, but something that will help me learn.
(define (my-reverse ls)
(define (my-reverse-2 ls acc)
(if (null? ls)
acc
(my-reverse-2 (cdr ls) (cons (car ls) acc))))
(my-reverse-2 ls '()))
This uses an accumulator variable to reverse the list, taking the first element off the incoming list and consing it to the front of the accumulator. It hides the accumulator taking function and just exposes the function that takes a list, so the caller doesn't have to pass in the empty list. That's why I have my-reverse-2.
(my-reverse-2 '(a (b c d) e) '()); will call
(my-reverse-2 '((b c d) e) '(a)); which will call
(my-reverse-2 '(e) '((b c d) a)); which will call
(my-reverse-2 '() '(e (b c d) a)); which will return
'(e (b c d) a)
Because the last function call in my-reverse-2 is a call to my-reverse-2, and the return value is passed right through (the return value of the first call is the return value of the second call, and so on) my-reverse-2 is tail optimized, which means it will not run out of room on the stack. So it is safe to call this with a list as long as you like.
If you want it to apply to nested lists use something like this:
(define (deep-reverse ls)
(define (deep-reverse-2 ls acc)
(if (null? ls)
acc
(if (list? (car ls))
(deep-reverse-2 (cdr ls) (cons (deep-reverse (car ls)) acc))
(deep-reverse-2 (cdr ls) (cons (car ls) acc)))))
(deep-reverse-2 ls '()))
This checks to see if the element is a list before adding it to the list, and if it is, reverses it first.
Since it calls itself to revers the inner list, it can handle arbitrary nesting.
(deep-reverse '(a (b c d) e)) -> '(e (d c b) a) which is in reverse alphabetical order, despite the fact that there is a nested list.
It evaluates as so:
(deep-reverse-2 '(a (b c d) e) '()); Which calls
(deep-reverse-2 '((b c d) e) '(a))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(b c d) '()) '(a)))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(c d) '(b)) '(a)))
(deep-reverse-2 '(e) (cons (deep-reverse-2 '(d) '(c b)) '(a)))
(deep-reverse-2 '(e) (cons '(d c b) '(a)))
(deep-reverse-2 '(e) '((d c b) a))
(deep-reverse-2 '() '(e (d c b) a))
'(e (d c b) a)
Use:
(define (reverse1 l)
(if (null? l)
nil
(append (reverse1 (cdr l)) (list (car l)))
)
)
Explanation:
Rules:
If the list is empty, then the reverse list is also empty
Else behind the reverse tail of the list, add the first element of the list
Look at this code this way:
reverse1 is name of the function and l is a parameter. If the list is empty then the reverse is also empty.
Else call the reverse1 function with (cdr l) which is the tail of the list and append that to the first alement (car l) that you make as a list.
In your example (pseudocode):
1st iteration
l=>(a (bcd)e)
car l => a
cdr l => (bcd)e
list(car l) =>(a)
------------------
reverse( cdr l)"+"(a)
------------------
2nd iteration
l=>((bcd)e)
car l => (bcd)
cdr l =>e
list(car l)=>(bcd)
--------------------
reverse(cdr l)"+"((bcd))+(a)
-----------------------
3rd iteration
l=>e
car l=> e
cdr l => nil
list (car l) =>(e)
-------------------------
(e (bcd)a)
This is one way that you can make a reverse function that applies to nested lists:
(define (reverse-deep l)
(map (lambda (x) (if (list? x) (reverse-deep x) x)) (reverse l)))
Explanation in pseudo-code:
Start by reversing the list as you would normally do
Then for each element in the reversed list:
- If the element is a list itself: Apply the procedure recursively
- Else: Don't touch the element
This is a reverse function in Racket which I like much better than Scheme.
It uses the match pattern matching function only.
(define/match (rev l)
[('()) '()]
[((list a ... b)) (cons b (rev a))])
> (rev '(a (b c d) e))
'(e (b c d) a)
You could simply reverse the elements in a list using foldr:
(foldr (lambda (a r) (append r (list a))) empty lst)
My solution:
(define (rvrs ls)
(if (null? ls)
empty
(append (rvrs (cdr ls)) (cons (car ls) empty))))
I used code similar to insertion sort:
(define deep-rev-list
(lambda (l)
(cond ((null? l) (quote ()))
((atom? (car l))
(swap-till-end (carl) (deep-rev-list (cdr l))))
(else
(swap-till-end (deep-rev-list (car l)) (deep-rev-list (cdr l)))))))
(define swap-till-end
(lambda (elm lst)
(cond ((null? lst) (cons elm '()))
(else
(cons (car lst) (swap-till-end elm (cdr lst)))))))
(define atom?
(lambda (x)
(and (not (null? x)) (not (pair? x)))))
I am reproducing it from memory. There may be some errors. I will correct the code if that's the case. But the technique used is similar to the commandments for nested lists given in THe Little Schemer :). I checked it in DrRacket.
(deep-rev-list '((1 2) (3) ((4 5)))) returns (((5 4)) (3) (2 1))

Resources