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)
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.
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"))
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 :)
Remove duplicates in a MULTI-LEVEL list (using Common Lisp) without changing list's inner structure. This problem seems to be a hard nut and a big headache for me.
Source list:
(1 2 (6 5) 2 3 (5 4)) ==> Result: (1 (6) 2 3 (5 4))
Here's my not-working decision:
LispWokrs:
(defun F (l &optional (lst (remove-duplicates (flatten l))))
(cond
((null l) nil)
((atom (car l))
(if (member (car l) lst)
(cons (car l) (F (cdr l) (remove (car l) lst)))
(F (cdr l) lst)))
(t (cons (F (car l) lst) (F (cdr l) lst)))))
I tried to use lst for keeping a clear set (1 2 6 5 3 4) and I've been trying to remove an element from this set each time I add a new element.
But what I get is almost the same source sequence (parallel recursion...):
(f '(1 2 (6 5) 2 3 (5 4))) ==> (1 2 (6 5) 3 (5 4))
(f '(А ((B C E) D (B E A)))) ==> (А ((B C E) D (B E A)))
Then I searched over the net, but there was no decision for this problem.
Try this:
(defun multi-level-list-remove-duplicates (tree)
(let ((seen NIL))
(labels ((rec (l)
(cond
((null l) NIL)
((consp (car l)) (cons (rec (car l))
(rec (cdr l))))
((member (car l) seen) (rec (cdr l)))
(T (push (car l) seen)
(cons (car l) (rec (cdr l)))))))
(rec tree))))
This maintains a list of already-seen values in seen and removes these if seen again. The recursive function rec closes over this value and thus all the sub-lists share one seen variable for each call to multi-level-list-remove-duplicates.
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.