I am a lisp beginner and i wrote a function to group equal adjacent items in a list. I would be grateful if Lisp experts could give me some advice about a better lispy writing of this function. Thanks in advance!
(defun identity-groups (lst)
(labels ((travel (tail group groups)
(cond ((endp tail) (cons group groups))
((equal (car tail) (car (last group)))
(travel (cdr tail) (cons (car tail) group) groups))
(t (travel (cdr tail) (list (car tail)) (cons group groups))))))
(reverse (travel (cdr lst) (list (car lst)) nil))))
(identity-groups '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7))
;; => ((1) (3) (5) (4 4 4 4) (5) (1) (2 2 2) (1) (2) (3 3 3 3 3) (4) (5) (6) (7))
Looks pretty good!
(equal (car tail) (car (last group))) seems equivalent to (equal (car tail) (car group))
To keep the elements in the original order, reverse the items of every group.
As you build the resulting list groups yourself, it's safe and more efficient to use nreverse instead of reverse.
There is no name clash when using list as parameter, instead of lst, as variables and functions live in different namespaces ("Lisp-2").
It's considered good style to give utility functions like this &key test key arguments so callers can decide on when list elements are considered equal (see e.g. Common lisp :KEY parameter use), to join the club of general functions like member, find and sort.
And a documentation string! :)
Updated version:
(defun identity-groups (list &key (test #'eql) (key #'identity))
"Collect adjacent items in LIST that are the same. Returns a list of lists."
(labels ((travel (tail group groups)
(cond ((endp tail) (mapcar #'nreverse (cons group groups)))
((funcall test
(funcall key (car tail))
(funcall key (car group)))
(travel (cdr tail) (cons (car tail) group) groups))
(t (travel (cdr tail) (list (car tail)) (cons group groups))))))
(nreverse (travel (cdr list) (list (car list)) nil))))
Tests:
(identity-groups '(1 2 2 2 3 3 3 4 3 2 2 1))
-> ((1) (2 2 2) (3 3 3) (4) (3) (2 2) (1))
;; Collect numbers in groups of even and odd:
(identity-groups '(1 3 4 6 8 9 11 13 14 15) :key #'oddp)
-> ((1 3) (4 6 8) (9 11 13) (14) (15))
;; Collect items that are EQ:
(identity-groups (list 1 1 2 2 (list "A") (list "A")) :test 'eq)
-> ((1 1) (2 2) (("A")) (("A")))
The desired function fits the pattern which consists in building a value G1 from a known subresult G0 and a new value, and can be implemented using REDUCE.
The first parameter of the anonymous reducing function is the accumulator, here a list of groups. The second parameter is the new value.
(reduce (lambda (groups value)
(let ((most-recent-group (first groups)))
(if (equal (first most-recent-group) value)
(list* (cons value most-recent-group) (rest groups))
(list* (list value) groups))))
'(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7)
:initial-value ())
The result is:
((7) (6) (5) (4) (3 3 3 3 3) (2) (1) (2 2 2) (1) (5) (4 4 4 4) (5) (3) (1))
One problem in your code is the call to last to access the last group, which makes the code traverse lists again and again. Generally you should avoid treating lists as arrays, but use them as stacks (only manipualte the top elment).
If you need to reverse elements, you can use do it at the end of each group (order among equivalent values), or at the end of the whole function (order among groups).
A 'classical' recursive solution
(defun identity-groups (l &key (test #'eql))
(labels ((group (l last-group acc)
(cond ((null l) (cons last-group acc))
((and last-group (funcall test (car l) (car last-group)))
(group (cdr l) (cons (car l) last-group) acc))
(t
(group (cdr l) (list (car l)) (cons last-group acc))))))
(cdr (reverse (group l '() '())))))
Older version (requires an initial-value not equal to first list element)
So the version above got rid of this key argument.
(defun identity-groups (l &key (test #'eql) (initial-value '(0)))
(labels ((group (l last-group acc)
(cond ((null l) (cons last-group acc))
((funcall test (car l) (car last-group))
(group (cdr l) (cons (car l) last-group) acc))
(t
(group (cdr l) (list (car l)) (cons last-group acc))))))
(cdr (reverse (group l initial-value '())))))
Imperative-style looping construct
Tried for fun also a looping construct with do.
(defun group-identicals (l &key (test #'eql))
(let ((lx) (tmp) (res)) ;; initiate variables
(dolist (x l (reverse (cons tmp res))) ;; var list return/result-value
(cond ((or (null lx) (funcall test x lx)) ;; if first round or
(push x tmp) ;; if last x (lx) equal to current `x`,
(setf lx x)) ;; collect it in tmp and set lx to x
(t (push tmp res) ;; if x not equal to lastx, push tmp to result
(setf tmp (list x)) ;; and begin new tmp list with x
(setf lx x)))))) ;; and set last x value to current x
(cdr (reverse (group l initial-value '())))))
;; cdr removes initial last-group value
;; test:
(group-identicals '(1 2 3 3 4 4 4 4 5 5 6 3 3 3 3))
;; ((1) (2) (3 3) (4 4 4 4) (5 5) (6) (3 3 3 3))
(group-identicals '("a" "b" "b" "c" "d" "d" "d" "e") :test #'string=)
;; (("a") ("b" "b") ("c") ("d" "d" "d") ("e"))
Related
How can I delete the values of list in range(a, b)? I tried with:
#lang racket
(define (remove L i n)
(cond ((null? L)
empty)
((> i 0)
(cons (car L) (remove (cdr L) (sub1 i) n)))
((> n 0)
(remove (cdr L) i (sub1 n)))
(else
L)))
But the result is:
(remove '(1 2 3 4 5) 2 4)
'(1 2)
(remove '(1 2 3 4 5 6 7 8 9) 2 5)
'(1 2 8 9)
I would like to have:
(remove '(1 2 3 4 5) 2 4)
'(1 5)
I think this will be easier to implement if you keep another parameter with the current index:
(define (remove L index start end)
(cond ((null? L)
empty)
((and (>= index start) (<= index end))
(remove (cdr L) (add1 index) start end))
(else
(cons (car L) (remove (cdr L) (add1 index) start end)))))
If you don't want to add one extra parameter, we can always use a named let:
(define (remove L start end)
(let loop ((lst L) (index 1))
(cond ((null? lst)
empty)
((and (>= index start) (<= index end))
(loop (cdr lst) (add1 index)))
(else
(cons (car lst) (loop (cdr lst) (add1 index)))))))
Either way, it works as expected:
(remove '(1 2 3 4 5) 2 4)
=> '(1 5)
(remove '(1 2 3 4 5 6 7 8 9) 2 5)
=> '(1 6 7 8 9)
There are two bugs:
You're using one-based indexing, so the first condition should be (> i 1);
Since the list shrinks in the first recursive clause, you need (sub1 n) there, too.
Passing n makes it count how many elements to remove rather than the index of where to stop.
We need a Scheme function called nondecreaselist, which takes in a list of numbers and outputs a list of lists, which overall has the same numbers in the same order, but grouped into lists that are non-decreasing.
For example, if we have input (1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1), the output should be:
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
How would you implement this? I know we have to use recursion.
My attempt so far:
(define (nondecreaselist s)
(cond ((null? s) '())
((cons (cons (car s)
((if (and (not (null? (cadr s)))
(not (> (car s) (cadr s))))
((cadr s))
('()))))
(nondecreaselist (cdr s))))))
However, this gives me the error:
(int) is not callable:
(define decrease-list
(lambda (l)
((lambda (s) (s s l cons))
(lambda (s l col)
;; limitcase1: ()
(if (null? l)
(col '() '())
;; limitcase2: (a1)
(if (null? (cdr l))
(col l '())
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))
1 ]=> (decrease-list '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
;Value: ((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
I did not comment it, if you have questions you can ask but I think you can also study yourself the code I wrote for you now.
Note also that one can consider the limit cases () and (a1) out of the loop and check these cases only once:
(define decrease-list
(lambda (l)
;; limitcase1: ()
(if (null? l)
'()
;; limitcase2: (a1)
(if (null? (cdr l))
(list l)
((lambda (s) (s s l cons))
(lambda (s l col)
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))
There are a few problems with the posted code. There is no test expression in the second cond clause; there are too many parentheses around the if and its clauses. Perhaps the most significant problem is that the code is attempting to build a non-decreasing list, which is to be consed to the result of (nondecreaselist (cdr s)), but when the non-decreasing sequence is more than one number long this starts again too soon in the input list by going all the way back to (cdr s).
Fixing Up OP Code
The logic can be cleaned up. OP code already is returning an empty list when input is an empty list. Instead of testing (null? (cadr s)) (when (cdr s) is '(), cadr won't work on s), one could test (null? (cdr s)) before code attempts a (cadr s). But it is even better to move this logic; when the input list contains one element, just return a list containing the input list: ((null? (cdr s)) (list s)).
Instead of (and (not (> ;... the logic can be made more clear by testing for > and executing the appropriate action. In this case, when (> (car s) (cadr s)) a new sublist should be started, and consed onto the list of sublists that is the result returned from nondecreaselist.
Otherwise, (car s) should be added to the first sublist in the result returned from nondecreaselist. To accomplish this, we need to construct the return list by consing s onto the first sublist, and then consing that new sublist back onto the cdr of the list of sublists that is the result returned from nondecreaselist.
Here is some revised code:
(define (nondecreaselist s)
(cond ((null? s) '())
((null? (cdr s)) (list s))
((> (car s) (cadr s))
(cons (list (car s))
(nondecreaselist (cdr s))))
(else
(let ((next (nondecreaselist (cdr s))))
(cons (cons (car s)
(car next))
(cdr next))))))
Using a Helper Function
Another approach would be to define a helper function that takes an input list and an accumulation list as arguments, returning a list of lists. The helper function would take numbers from the front of the input list and either add them to the accumulator, creating a non-decreasing list, or it would cons the accumulated non-decreasing list to the result from operating on the rest of the input.
If the input lst to the helper function ndl-helper is empty, then a list containing the accumulated non-decreasing list sublst should be returned. Note that sublst will need to be reversed before it is returned because of the way it is constructed, as described below.
If the accumulator sublst is empty, or if the next number in the input list is greater-than-or-equal-to the largest number in the sublst, then the next number should simply be added to the sublst. By consing the number onto the front of sublst, only the car of sublst needs to be checked, since this will always be the largest (or equal to the largest) value in sublst. But, since sublst is in reverse order, it will need to be reversed before adding it to the growing list of lists.
Otherwise, lst is not empty, and sublst is not empty, and the next number in the input list is less than the largest number in sublst. Thus, a new sublist needs to be started, so the old sublst is reversed and consed onto the result of the remaining computation done by calling the helper function on the remaining lst with an empty accumulator sublst:
(define (nondecreaselist-2 lst)
(define (ndl-helper lst sublst)
(cond ((null? lst) (list (reverse sublst)))
((or (null? sublst)
(>= (car lst) (car sublst)))
(ndl-helper (cdr lst) (cons (car lst) sublst)))
(else
(cons (reverse sublst) (ndl-helper lst '())))))
(ndl-helper lst '()))
Both functions work:
> (nondecreaselist '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
> (nondecreaselist-2 '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
I am working my first project in scheme and have come across an issue. In part of my requirements, I am required to append all top-level sublists
(e.g. '((1 2)(3 4 (5 6))) -> (1 2 3 4 (5 6)) and '((1 2 3)(4 5)) -> (1 2 3 4 5)
I've managed to get it working down to a single list, but this flattens all levels:
(cond
((null? lst)
lst)
((list? lst)
(append2(append-subs(car lst))(append-subs(cdr lst))))
(else
(cons lst '())))
Variations of this (eg. (else lst) run the error "object 6, passed as first arg to cdr, is not correct type". Another method I attempted is as follows:
(cond
((null? lst)
lst)
((>= (len (cdr lst)) 0)
(append2(append-subs(car (list lst)))(append-subs(cdr (list lst)))))
(else
lst)
Which infinitely loops. I'm at a bit of a stand still, so any help would be greatly appreciated. (Note: Use of functions other than those used here is forbidden. Limited to list, list?, if, cond, null? ...)
Your list '(e1 e2 e3) would be like this:
(cons e1 (cons e2 (cons e3 '())))
or if you like dotted notation:
'(e1 . (e2 . (e3 . ())))
Where en is eiter #f or #t for (list? en) Your assignment is to cons en onto the recursion with the same level while with a list you need to append the two.
Here is a general idea how to implement it with level as an input parameter:
;;; flatten a list a certain levels
;;; level of zero is identity
(define (flatten-level level lst)
(cond ((or (zero? level)
(null? lst))
lst)
;; pair? is faster but will fall through for dotted
((list? (car lst))
(append (flatten-level <??> <??>)
(flatten-level <??> <??>)))
(else
(cons <??>
(flatten-level <??> <??>)))))
(flatten-level 0 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> ((1 2) (3 (((4 . 3))) (5 (6))) . 7) (aka identity)
(flatten-level 1 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> (1 2 3 (((4 . 3))) (5 (6)) . 7)
(flatten-level 99 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> (1 2 3 (4 . 3) 5 6 . 7)
How about appending all elements of the top list:
(define (flatten-top-level lst)
(apply append lst))
Which is practically the definition of append*
If '(a (b) (c f)) is a valid input, (first element not a list) then you can try:
(define (flatten-top-level lst)
(apply append
(map (lambda (e) (if (list? e)
e
(list e))) ;make a list from the non-list element
lst)))
2nd option: Fold it!
(define (flatten-top-level lst)
(foldr append '() lst))
For a list (a b c d) where a, b, c, d are sub-lists; it is equal to:
(append a (append b (append c (append d '()))))
Extra: this is tail recurssive and therefore runs in linear time :)
First off, if anyone can find a question where this has already been answered, let me know. All I can find are functions that remove duplicates.
Anyhow, I am trying to write a scheme function (delete V L) that takes a value and a list as arguments, and removes that value from the list and all its sublists. For example, given the following input:
> (deep-delete 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
It would yield:
(1 2 (4) 5 (6 (7)) 8)
So far, this is what I have written, but I know that the if statement (which is to check to see if the element is a sub-list, which implies it too must be operated on) must be placed incorrectly. Also, I cannot wrap my brain around where I should be using cons and where I shouldn't, because I'm still confused about tracking the return values of the recursion. Can someone please take a look and explain what I'm doing wrong?
(define (delete V L)
(if (list? (car L)) (cons (delete V (car L) (cdr L)))
(cond
((null? L) L)
((equal? V (car L)) (delete V (cdr L)))
(else (cons (car L) (delete V (cdr L))))))))
I have a few comments on your code:
First, in your if statement you use (car L) without checking if L is empty.
Also, in line 2 of your code, you do: (delete V (car L) (cdr L)),
but cons takes two arguments, not three. And you forgot to recursively call delete on the cdr.
You wanted:
(cons (delete V (car L)) (delete V (cdr L)))
Why not use a single cond? Since there are several cases, using cond will make the recursive structure of your algorithm more apparent, and errors easier to catch.
See below.
(define (del V L)
(cond ((null? L) L)
((list? (car L))
(cons (del V (car L)) (del V (cdr L))))
((equal? V (car L)) (del V (cdr L)))
(else (cons (car L) (del V (cdr L))))))
This will recursively delete V from L.
(del 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
==> (1 2 (4) 5 (6 (7)) 8)
This is quite easy to achieve with folding; here's an example in Racket using foldr:
(define (deep-delete elt lst (test equal?))
(foldr (lambda (e r)
(if (list? e)
(cons (deep-delete elt e test) r)
(if (test elt e) r (cons e r))))
null
lst))
testing
> (deep-delete 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
'(1 2 (4) 5 (6 (7)) 8)
This removes subtrees from a tree (including atomic ones):
(define (remove-element needle haystack)
(let rec ((haystack haystack))
(cond
((equal? needle haystack) '())
((not (pair? haystack)) haystack)
((equal? needle (car haystack)) (rec (cdr haystack)))
((equal? needle (cdr haystack)) (cons (rec (car haystack)) '()))
(else (cons (rec (car haystack))
(rec (cdr haystack)))))))
(remove-element 'atom 'atom) ; => ()
(remove-element '(1 2 3) '((1 2 3) 1 2 3)) ; => ()
(remove-element '(1 2 3) '((1 2 3) 4 5 6)) ; => (4 5 6)
(remove-element '(1 2 3) '(3 2 1 2 3)) ; ==> (3 2)
(remove-element '3 '((1 2 3) 1 2 3)) ; ==> ((1 2) 1 2)
(remove-element '(1 2 3) '(1 2 3 4)) ; ==> (1 2 3 4)
I'm using R5RS standart of Scheme implementation.
Now imagine you have to find out if an element '(2 3 4) is in a list '(1 2 3 4).
As for the example, and more strictly, you wish:
1. (is-in? '(2 3 4) '(1 2 3 4)) -> #f
2. (is-in? '(2 3 4) '(1 (2 3 4)) -> #t
Question: how to get that kind of behaviour, as in example 1?
Let me explain: when you search throught a list, you could use either car or cdr to get its parts. Now if you recursively go throught the list, you eventually get:
3. (cdr '(1 2 3 4)) -> '(2 3 4)
4. (cdr '(1 (2 3 4)) -> '((2 3 4))
So eventually, we got 2 lists. And you can see here, that sublist '(2 3 4) is contained by both results from 3 and 4.
Please see the contradiction of 3 and 4 with 1 and 2: while '(2 3 4) is not contained in '(1 2 3 4), recursive call of cdr returns '(2 3 4), which is equal to '(2 3 4) - and using equal? function, somewhere inside recursive calls, we eventually get #t for both 1 and 2:
5. (is-in? '(2 3 4) '(1 2 3 4)) -> #t
6. (is-in? '(2 3 4) '(1 (2 3 4)) -> #t
So how to get that kind of behaviour from 1? I want to have a function, which works with all different types of data. Here's my function, which works like 5 and 6 (throught should work as 1 and 2):
(define or (lambda (x y)
(cond ((eq? x y) (eq? x #t))
(#t #t)
)
)
)
(define and (lambda (x y)
(cond ((eq? x y) (eq? x #t))
(#t #f)
)
)
)
(define atom? (lambda (x)
(not (pair? x))
)
)
(define length (lambda (x)
(cond ((eq? x '()) 0)
((atom? x) 1)
(#t (+ (length (car x)) (length (cdr x))))
)
)
)
(define equal? (lambda (x y)
(cond ((and (atom? x) (atom? y)) (eq? x y))
((not (eq? (length x) (length y))) #f)
((not (and (pair? x) (pair? y))) #f)
(#t (and (equal? (car x) (car y)) (equal? (cdr x) (cdr y))))
)
)
)
(define is-in? (lambda (x y)
(cond ((equal? x y) #t)
(#t (cond ((pair? y) (or (is-in? x (car y)) (cond ((eq? (length y) 1) #f)
(#t (is-in? x (cdr y)))
)))
(#t #f)
)
)
)
)
)
Update:
What I want is to have a general function, which can tell you if some object is inside another object. I name entities object to emphasize that the function should work with any input values, simple or complicated like hell.
Example usages:
1. (is-in? 1 '(1 2 3)) ;-> #t
2. (is-in? '(1) '(1 2 3)) ;-> #f
3. (is-in? '(2 . 3) '(1 2 . 3)) ;-> #f
4. (is-in? '(2 . 3) '(1 (2 . 3))) ;-> #t
5. (is-in? '2 '(1 2 . 3)) ;-> #t
6. (is-in? '(2) '(1 2 . 3)) ;-> #f
7. (is-in? '(1 2 (3 4 (5 6 . (7 . 8)) 9) 10 11 (12 . 13)) '(1 (2 3 ((4 ((6 (3 . ((1 2 (3 4 (5 6 . (7 . 8)) 9) 10 11 (12 . 13)))) 3) 4)) 5) 2))) ;-> #t
8. (is-in? '(2 3 4) '((1 (2 3 4)) (1 2 3 4))) ;-> #t
9. (is-in? '(2 3 4) '(1 2 3 4)) ;-> #f
10. (is-in? '(2 3 4) '(1 (2 3 4))) ;-> #t
11. (is-in? '(1) '(1)) ;-> #t
First of all - why are you redefining and, or, equal? and length? those are built-in primitives. Also your definition of atom? is wrong, it should be:
(define (atom? x)
(and (not (pair? x))
(not (null? x))))
I guess you need to implement this from scratch as part of a homework. Let's see how that can be accomplished, fill-in the blanks to get your answer:
(define (is-in? ele lst)
(or <???> ; trivial case: ele == list
(member? ele lst))) ; call helper procedure
(define (member? ele lst)
(cond ((null? lst) ; if the list is empty
<???>) ; then the element is not in the list
((atom? lst) ; if the list is not well-formed
(equal? <???> <???>)) ; then test if ele == list
(else ; otherwise
(or (equal? ele <???>) ; test if ele == the 1st element in the list
(member? ele <???>) ; advance the recursion over the `car`
(member? ele <???>))))) ; advance the recursion over the `cdr`
Notice that the second case in member? is needed because in the examples given there are malformed lists (ending in a non-null value). The above solution will correctly handle all of the examples provided in the question.
(define (is-in? e lst)
(cond ((null? lst) #f) ; if list is empty, we failed
((eq? e (car lst)) #t) ; check 1st element of list
((list? (car lst)) (is-in? e (append (car lst) (cdr lst)))) ; search inside car if it is a list
(#t (is-in? e (cdr lst))))) ; check rest of list
You can replace eq? with something more elaborate to handle other definitions of equality.
Note: this assumes that all sequences are lists; you'll have to tweak it to handle dotted-pairs that are not lists.