I have this code:
(define remove
(λ (x y)
(cond
((null? y) '())
((eq? x (car y)) (delete x (cdr y)))
(else (cons (car y) (delete x (cdr y))))
)))
Input: (remove 'c '(w((x)(c q)(((o))))w))
This will not go inside the inner parenthesis. If I try to remove 'w', it will remove all occurrences of it because they are outside of the parenthesis. So, I can't take out anything from the inside.
The solution is a bit more elaborate, you'll have to use the template for traversing a list of lists. Also, is better to use equal? instead of eq?, consult the documentation to understand the differences. A possible implementation follows, I took the liberty of renaming the parameters to something more meaningful:
(define remove
(λ (ele lst)
(cond
((null? lst) '()) ; if the list is empty then we're done
((not (pair? (car lst))) ; if the first element is an atom
(if (equal? (car lst) ele) ; check if it's the one we're looking for
(remove ele (cdr lst)) ; if so we skip over it, eliminating it
(cons (car lst) (remove ele (cdr lst))))) ; otherwise we add it
(else (cons (remove ele (car lst)) ; else advance recursion
(remove ele (cdr lst))))))) ; over both `car` and `cdr`
Now it works as expected:
(remove 'c '(w ((x) (c q) (((o)))) w))
=> '(w ((x) (q) (((o)))) w)
Related
I was reading the book On Lisp by Paul Graham. In Chapter 4, Utility Functions, he gives examples of small functions that operate on lists, which would be helpful while writing a larger program.
One of them is flatten. Given a nested list at any arbitrary level as argument, flatten will remove all the nested elements and put them on the top level.
Below is my attempt at implementing flatten:
(defun flatten (lst)
(labels ((rflatten (lst1 acc)
(dolist (el lst1)
(if (listp el)
(rflatten el acc)
(push el acc)))
acc))
(reverse (rflatten lst nil))))
But the above function does not flatten lists properly.
; returns (1) instead of (1 2)
(print (flatten '(1 (2))))
(1)
Calling the function with (1 (2)) returns (1) instead of (1 2).
I cannot find what's wrong with my implementation of flatten. Is it the way I am using
labels? Or is it the the way I am using the dolist macro? The dolist macro always returns nil. But that should not matter as I am using an accumulator acc to store the flattened list.
push changes the symbol binding in scope. Thus the recursion (rflatten el acc) has it's own acc which is the result there but you don't do anything with the returned result and it doesn't alter the callee acc.
Perhaps a (setf acc (rflatten el acc)) would fix that:
(defun flatten (lst)
(labels ((rflatten (lst1 acc)
(dolist (el lst1)
(if (listp el)
(setf acc (rflatten el acc))
(push el acc)))
acc))
(reverse (rflatten lst nil))))
You're actually very close. As Sylwester mentions, the issue is that (push el acc) only modifies the local binding of el (of which there's a new one for each call to rflatten. As Rainer mentions, it's not really an accumulator in the traditional sense, so I'm going not going to call it acc, but result. Since you're already defining a local function, there's no reason not to define result in a wider scope:
(defun flatten (lst)
(let ((result '()))
(labels ((rflatten (lst1)
(dolist (el lst1)
(if (listp el)
(rflatten el)
(push el result)))))
(rflatten lst)
(nreverse result))))
There are actually a few ways to clean this up, too. The first is a matter of style and taste, but I'd use an &aux variable to bind result, so
(defun flatten (lst &aux (result '()))
...)
The next is that dolist can take a third argument, a form to evaluate as for the return value. This is often used in a "push to create a list, then reverse for the return value" idiom, e.g.,
(let ((result '()))
(dolist (x list (nreverse result))
...
(push ... result)))
You don't want to reverse after every dolist, but you can still return result from the dolist, and thus from rflatten. Then you can simply call nreverse with the result of rflatten:
(defun flatten (lst &aux (result '()))
(labels ((rflatten (lst1)
(dolist (el lst1 result)
(if (listp el)
(rflatten el)
(push el result)))))
(nreverse (rflatten lst))))
A non-recursive code which builds the result by conses, following comments and starting from a code by user:Sylwester:
(defun flatten (lst &optional back acc)
(loop
(cond
((consp lst) (psetq lst (cdr lst) ; parallel assignment
back (cons (car lst) back)))
(back
(if (consp (car back))
(psetq lst (cdar back)
back (cons (caar back) (cdr back)))
(psetq acc (if (car back) (cons (car back) acc) acc)
back (cdr back))))
(t
(return acc))))) ; the result
It's not pretty, but it seems to work. Parallel assignment PSETQ is used to simulate tail-recursive call frame update without worrying about precise sequencing.
Implements the same process as the one encoded nicely by
(defun flatten2 (l z)
(cond
((endp l) z)
((listp (car l)) (flatten2 (car l) (flatten2 (cdr l) z)))
((atom (car l)) (cons (car l) (flatten2 (cdr l) z)))))
(defun flatten (l)
(flatten2 l nil))
with implicit stack operations explicated as list structure manipulations among the variables.
I discovered a solution which does not use helper functions or variable assignment, and constructs the list in a forward manner, which I think is easier to understand.
(defun flatten (lst &aux (re '()))
(cond
((null lst) '())
((listp (car lst))
(append (flatten (car lst))
(append (flatten (cdr lst))
re)))
(t (cons (car lst)
(append (flatten (cdr lst)) re)))))
And we can easily adapt it to control the depth of the flattening!
(defun flatten* (lst depth &aux (re '()))
(cond
((null lst) '())
((listp (car lst))
(append (cond
((= 0 depth) ; flatten none
(list (car lst)))
((< 0 depth) ; flatten down
(flatten* (car lst) (- depth 1)))
((= -1 depth) ; flatten all
(flatten* (car lst) depth))
((< depth -1) ; flatten up
(list (flatten* (car lst) (+ depth 1)))))
(append (flatten* (cdr lst) depth)
re)))
(t (cons (car lst)
(append (flatten* (cdr lst) depth) re)))))
I'm trying to do a program in scheme for a school assignment. Given a list, it's supposed to return all given permutations of that list. My issue is that I don't know why it would work for numbers but not characters. Doesn't seem like it would change any of the logic!
Here is my code:
(define (remove1 x lst)
(cond
((null? lst) '())
((= x (car lst)) (remove1 x (cdr lst)))
(else (cons (car lst)
(remove1 x (cdr lst))))))
(define (permute lst)
(cond
((= (length lst) 1) (list lst))
(else (apply append (map (lambda (i)
(map (lambda (j) (cons i j))
(permute (remove1 i lst))))
lst)))))
(permute '(1 2 3))
= is used for comparing numbers; for more general comparisons, use eq?, equal? or (as has been suggested) eqv?.
I've appreciate some helping hand over here. I'm trying to construct a procedure which delete duplicated elements in a list. This part is easy. But then I also want to delete duplicated elements (which may also be lists) and if it is a list the duplicated elements in that list should also be deleted, e.g (make-set (list 1 2 3 2 (list 1 3 2 4 3 4) (list 1 3 2 4 3 4))) should be '(1 3 2 (1 2 3 4)) but in our case it becomes '(1 3 2 2 3 4). Which isn't what we want. What am I doing wrong? Thanks :)
;; Checks if an element x appears in a list (set)
(define (element-of-set? x set)
(cond (( null? set) false)
((equal? x (car set)) true)
(else (element-of-set? x (cdr set)))))
;; Delete duplicated elements of a list (set)
(define make-set
(lambda (lst)
(cond ((null? lst) '())
((if (list? (car lst))
(cond ((null? (car lst))
'()
)
((element-of-set? (caar lst) (car lst)) (make-set (cdar lst))
)
(else (cons (caar lst) (make-set cadr lst))))
(cond ((element-of-set? (car lst) (cdr lst)) (make-set (cdr lst)))
(else (cons (car lst) (make-set (cdr lst))))))))))
Actually, if you want to build a function make-set that manages a generalized, untyped concept of set (that is a set that can contain either numbers or recursively other sets), the definition is quite complex. Here is my try.
;; check if x is contained in set
(define (contained? x set)
(cond ((null? set) false)
((my-equal? x (car set)) true)
(else (contained? x (cdr set)))))
;; check if all the elements of set1 are contained in set2
(define (set-contained? set1 set2)
(cond ((null? set1) true)
((null? set2) false)
(else (and (contained? (car set1) set2)
(set-contained? (cdr set1) set2)))))
;; check if set1 is equal to set2
(define (set-equal? set1 set2)
(and (= (length set1) (length set2))
(set-contained? set1 set2)))
;; check if x1 is equal to x2, when x1 and x2 can be sets or elements
(define (my-equal? x1 x2)
(cond ((list? x1) (and (list? x2) (set-equal? x1 x2)))
((list? x2) false)
(else (eq? x1 x2))))
;; add the element x to set, if not already present
(define (add-to-set x set)
(cond ((null? set) (list x))
((my-equal? x (car set)) set)
(else (cons (car set) (add-to-set x (cdr set))))))
;; make a set from a list lst
(define (make-set lst)
(cond ((null? lst) '())
((list? (car lst)) (add-to-set (make-set (car lst)) (make-set (cdr lst))))
(else (add-to-set (car lst) (make-set (cdr lst))))))
(make-set (list 1 2 3 2 (list 1 3 2 4 3 4) (list 1 3 2 4 3 4))) ; => '(1 3 (1 2 3 4) 2)
The function make-set builds the set by inserting in turn each element of the original list in a new set, so to check if the element is already present (also, if the element is a list, first it is transformed in a set). The other functions should be easy to understand, given the following convention:
If a parameter is called set, the function expects a list which has been already represented as set.
If a parameter is called x, then it is either a number or a set.
The specification of make-set is a little unclear, but maybe this works for you:
(define make-set
(lambda (lst)
(cond ((null? lst) '())
((list? (car lst)) (cons (make-set (car lst)) (make-set (cdr lst))))
((element-of-set? (car lst) (cdr lst)) (make-set (cdr lst)))
(else (cons (car lst) (make-set (cdr lst)))))))
Note that using lst is not in common use.
A nice convention is to use x as an element in a list and use xs as a list of x-elements.
I wrote this code to create a list from en number of arguments given
(define (create-list . e)
e)
But I need it to remove any duplicated numbers from the list within this block itself.
I have tried and searched for hours and can't find a solution without placing dozens of lines of code on other blocks.
For example let's say my input is
(create-list . 2 2 3 5 5 )
I need the list created to be '(2 3 5) and not '(2 2 3 5 5 )...
The order of the numbers doesn't matter.
Basically, you need to do something like:
(define (create-list . e) (dedupe e))
I can think of a really simple but probably inefficient way to do this:
(define (dedupe e)
(if (null? e) '()
(cons (car e) (dedupe (filter (lambda (x) (not (equal? x (car e))))
(cdr e))))))
If you can't use existing functions like filter, you can make one yourself:
(define (my-filter pred ls)
(cond ((null? ls) '())
((pred (car ls)) (cons (car ls) (my-filter pred (cdr ls))))
(else (my-filter pred (cdr ls)))))
This one is faster:
(define (remove-duplicates l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(remove-duplicates (cdr l)))
(else
(cons (car l) (remove-duplicates (cdr l))))))
But even better,
mit-scheme provides delete-duplicates, which does exactly what you want.
The most efficient (traversing the list once) way to do this is to define a function which goes through the list element-by-element. The function stores a list of which elements are already in the de-duped list.
An advantage of this solution over #Tikhon Jelvis's, is that the list elements don't need to be in order, to be deduplicated.
Given a function elem, which says if a is an element of l:
(define (elem? a l)
(cond ((null? l) #f)
((equal? a (car l)) #t)
(else (elem? a (cdr l)))))
We can traverse the list, storing each element we haven't seen before:
(define (de_dupe l_remaining already_contains)
(cond ((null? l_remaining) already_contains)
((elem? (car l_remaining) already_contains) (de_dupe (cdr l_remaining) already_contains))
(else (de_dupe (cdr l_remaining) (cons (car l_remaining) already_contains)))))
Note: for efficiency, this returns the elements in reverse order
(define (delete x)
(cond
((null? x) x)
((= (length x) 1) x) | ((null? (cdr x)) x)
((= (car x) (cadr x)) (delete (cdr x)))
(#t (cons (car x) (delete (cdr x))))
)
)
I'd like to create a Scheme function that yields true if it is passed a list that is composed entirely of identical elements. Such a list would be '(1 1 1 1). It would yield false with something like '(1 2 1 1).
This is what I have so far:
(define (list-equal? lst)
(define tmp (car lst))
(for-each (lambda (x)
(equal? x tmp))
lst)
)
Clearly this is incorrect, and I'm new to this. I guess I'm unable to express the step where I'm supposed to return #t or #f.
Thanks in advance!
EDIT:
I fiddled a bit and found a solution that seems to work very well, and with a minimal amount of code:
(define (list-equal? lst)
(andmap (lambda (x)
(equal? x (car lst)))
lst))
Thanks again for the help everyone.
Minimal amount of code, if you don't care that it only works for numbers:
(define (list-equel? lst)
(apply = lst))
Examples:
> (list-equel? '(1 1 2 1))
#f
> (list-equel? '(1 1 1 1))
#t
> (list-equel? '(1))
#t
The andmap solution is nice, but if andmap is not available, you can use this. It uses basic operations (and, or, null check, equality check) and handles empty lists and one element lists. Similar to Sean's implementation, but no helper definition is necessary.
(define (list-equal? args)
(or (or (null? args)
(null? (cdr args)))
(and (eq? (car args) (cadr args))
(list-equal? (cdr args)))))
Try something like this:
(define (list-equal? lst)
(define (helper el lst)
(or (null? lst)
(and (eq? el (car lst))
(helper (car lst) (cdr lst)))))
(or (null? lst)
(helper (car lst) (cdr lst))))
This might not be the cleanest implementation, but I think it will correctly handle the cases of empty lists and one-element lists.
In R6RS there's the for-all function, which takes a predicate and a list, and returns #t if the predicate returns true for all elements in the list and #f otherwise, which is exactly what you need here.
So if you're using R6RS (or any other scheme dialect that has the for-all function), you can just replace for-each with for-all in your code and it will work.
(define (list-equal? lst)
(if (= (cdr lst) null)
true
(and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst)))))
Something like this should work:
(define (list-equal? lst)
(cond ((< (length lst) 2) #t)
(#t (and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst))))))
The other answers in this thread all seem too complicated (I read through them all), so here's my take on it:
(define (all-equal? lst)
(define item (car lst))
(let next ((lst (cdr lst)))
(cond ((null? lst) #t)
((equal? item (car lst)) (next (cdr lst)))
(else #f))))
(It does not work with an empty list, by design. It's easy to add a (if (null? lst) #t ...) if necessary.)
A short, concise solution:
#lang racket
(define (all-equal? lst)
(for/and
([i (in-permutations lst)])
(equal? (first i) (second i))))
; TEST CASES
(require rackunit)
(check-false (all-equal? '(1 2 3)))
(check-true (all-equal? '(1 1 1)))
(check-true (all-equal? '()))
Note that this uses racket, so this may not work with your scheme implementation.
Yet another solution:
(define (all-same ls)
(cond
((or (null? ls)
(null? (cdr ls))) #t)
(else (and (equal? (car ls) (next ls))
(all-same (cdr ls)))))))
(define (next ls)
(cond
((or (null? ls)
(null? (cdr ls))) '())
(else (cadr ls)))))
For is bad in these languages. Try
(define list-equal?
(lambda (lst)
(if (= lst null)
(true)
(foldr = (car lst) (cdr lst))
)))