I'm looking for an answer that turns a list of atoms into a single list recursively.
An example would be, (slist '(a (b c) (d e (f) g) h)) into (slist (a b c d e f g h))
Any answer will be helpful.
What you're trying to do is called flattening a list. Here are a bunch of options:
; required predicate
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
; naïve version using append
(define (flatten1 lst)
(cond ((null? lst)
'())
((not (pair? lst))
(list lst))
(else
(append (flatten1 (car lst))
(flatten1 (cdr lst))))))
; naïve version using append, map, apply
(define (flatten2 lst)
(if (atom? lst)
(list lst)
(apply append (map flatten2 lst))))
; efficient version using fold-left
(define (flatten3 lst)
(define (loop lst acc)
(if (atom? lst)
(cons lst acc)
(foldl loop acc lst)))
(reverse (loop lst '())))
; very efficient version with no higher-order procedures
(define (flatten4 lst)
(let loop ((lst lst)
(acc '()))
(cond ((null? lst)
acc)
((not (pair? lst))
(cons lst acc))
(else
(loop (car lst) (loop (cdr lst) acc))))))
Any of the above will work as expected. For instance, using flatten4:
(flatten4 '(a (b c) (d e (f) g) h))
=> '(a b c d e f g h)
Depending on the interpreter you're using, it's quite possible that it already includes an implementation. For example, in Racket:
(flatten '(a (b c) (d e (f) g) h))
=> '(a b c d e f g h)
In Lisp, as opposed to Scheme, you have to accept the fact that the atom nil represents an empty list in your list structure. So, strictly speaking, when you flatten a list, you do not obtain all of the atoms from the tree structure; only those ones that do not represent empty lists and list terminators.
You also have to make a design decision: does your code handle improper lists and circular list? That is to say, what should these cases do:
(flatten '(a . b)) ;; (a b), accurate diagnostic or failure?
(flatten '#1=(a . #1#)) ;; (a), accurate diagnostic or failure?
Do you handle the situation and collect the actual non-list atoms that are present in the tree structure, regardless of cycles or improper termination? Or do you detect the situation accurately and report a meaningful diagnostic? Or just ignore the possibility and let the code blow up in lower level functions, or perform runaway recursion?
If you don't care about dealing with improper lists and circular structure, flattening a list is recursively defined like this.
A non-list is flattened by returning a list containing that atom.
A list is flattened by flattening all of its elements and catenating them.
In Lisp it's usually easier and clearer to write the code than the English spec or pseudo-code:
(defun flatten (obj)
"Simple flatten: no handling of improper lists or cycles"
(if (listp obj)
(mapcan #'flatten obj)
(list obj)))
Note that although mapcan is destructive, that doesn't present a problem here, because it only ever catenates list structure that is constructed within our function call and not any incoming list structure. Stated in other words, our output does not share structure with the input.
You've already checked a correct answer, but here is a trivial implementation which clearly indicates the recursion:
(define (slist list)
(if (null? list)
'()
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(append (slist next) (slist rest))
(cons next (slist rest))))))
Related
I am learning Scheme and wanted to write a recursive program that reverses a given list.
In one test case however, I noticed that a (b c) e -> e (b c) a.
What I'm trying to get is a (b c) e -> e (c b) a.
This is what I have:
(define (deep-reverse lst)
(if (null? lst)
'()
(begin
(display (car lst))
(display "\n")
(if (null? (cdr lst))
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))
) //End of inner if
))) //End of begin, outer if, define
When I attempt to run the code with
(deep-reverse '(1 (b c) (a b)))
I get:
1
(b c)
(a b)
mcdr: contract violation
expected: mpair?
given: 1
The issue is with (list (reverse (car lst))), although in an isolated test case it works fine. Which leads me to believe that the issue may have to do with append.
Thank you in advance.
Edit: Going from (list (reverse (car lst))) to (reverse (list(car lst))) makes the code run without an error but doesn't reverse (a b) to (b a).
As the error message explains, your problem is that you are trying to reverse a number. Firstly, let's remove some of the unnecessary conditions and debugging stuff in your program, arriving at this simpler program. Let's step through this program to see what's going on:
(define (deep-reverse lst)
(if (null? lst)
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))))
We start with
(deep-reverse '(1 (b c) (a b)))
Substituting the argument we get
(if (null? '(1 (b c) (a b)))
'()
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b)))))))
Because the condition is #f, this simplifies to
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b))))))
To evaluate the first argument, first find the cdr, and call deep-reverse on that. I will skip the steps here but you should easily be able to test that it works correctly.
(append '((b a) (c b)) (list (reverse (car '(1 (b c) (a b))))))
Next we evaluate the car:
(append '((b a) (c b)) (list (reverse 1)))
And here we see what the problem is: we can't reverse a single number!
The issue is that your deep-reverse should have two distinct behaviours recursively:
on a number, or symbol, or other non-list entity, don't do anything, because it does not make sense to reverse a number
on a list, deep reverse it
There are two reasons why your current program does not do this properly:
it only does a shallow reverse on the elements of the list; that is, it won't deep reverse '(((a b) (c d)) ((e f) (g h))) correctly
it fails if it ever encounters a number or other non-list, like a symbol
The easy fix is to add a condition to check if it's a pair? first before attempting to reverse it. If it's not pair?, then lst must either be nil (which we may leave as-is) or a non-list object (which we may also leave as-is)
(define (deep-reverse lst)
(if (pair? lst)
(append (deep-reverse (cdr lst)) (list (deep-reverse (car lst))))
lst))
Finally, I should note that the pattern we are using here is really a foldr pattern. We can abstract away this pattern with foldr:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldr (lambda (x y) (append y (list (deep-reverse x)))) '() xs))
(else xs)))
But we note also that this is inefficient, because append is an expensive operation. Modifying the algorithm to a tail recursive one makes it clear that this is actually a foldl:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldl (lambda (x y) (cons (deep-reverse x) y)) '() xs))
(else xs)))
which is how such a function might be written in typical idiomatic Scheme, or as pointed out by Will Ness,
(define (deep-reverse xs)
(cond ((pair? xs) (reverse (map deep-reverse xs)))
(else xs)))
I have been trying to transform a linear list into a set but with no avail. Everytime I run this, I get some weird compilation errors like "badly formed lambda" which points to the way I use append. Here is my code:
(defun mem(e l)
(cond
((null l) nil)
((equal e (car l)) t)
((listp (car l)) (mem e (car l)))
(t(mem e (cdr l)))
)
)
(defun st(l k)
(cond
((null l) nil)
(( mem '(car l) 'k) (st (cdr l) k))
((listp (car l)) (st (car l) k))
( t (st (cdr l) (append((car l) k)) ))
(t(mem e (cdr l)))
)
)
EDIT: frankly I just want to remove the duplicates from list l
Prefer Standard Library Functions
EDIT: frankly I just want to remove the duplicates from list l
Common Lisp has a remove-duplicates function. The documentation inclues examples:
Examples:
(remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD"
(remove-duplicates '(a b c b d d e)) => (A C B D E)
(remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E)
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A))
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%))
Are you trying to flatten the list too?
From your code for mem, where you do:
((listp (car l)) (mem e (car l)))
it looks like you want your member function to also recurse into sublists. That's a bit questionable, even when working with sets, since sets can traditionally include other sets. E.g., {{3},{4},5} is a set containing 5, the set {3}, and the set {4}. It's not the same as the set {3,4,5}. Your st function also looks like it's trying to recurse into lists, which makes it seem like you want to flatten you lists, too. Again, that's a bit questionable, but if you want to do that, then your conversion to a set would be easier as a "flatten, then remove duplicates" process:
(defun flatten (list)
"Returns a fresh list containing the leaf elements of LIST."
(if (listp list)
(mapcan 'flatten list)
(list list)))
;; CL-USER> (flatten '(1 2 (3 4) 5 ((6))))
;; (1 2 3 4 5 6)
(defun to-set (list)
"Returns a set based on the elements of LIST. The result
is a flat list containing the leaf elements of LIST, but
with any duplicate elements removed."
(delete-duplicates (flatten list)))
;; CL-USER> (to-set '(1 3 (3 4) ((4) 5)))
;; (1 3 4 5)
Notes
I get some weird compilation errors like "badly formed lambda" which points to the way I use append.
Yes, you're trying to call append like: (append((car l) k)). That's actually not a problem for append. Remember, the syntax for a function call in Lisp is (function argument…). That means that you've got:
(append ((car l) k))
<function> <argument1>
But your argument1 is also a function call:
((car l) k )
<function> <argument1>
In Common Lisp, you can't use (car l) as a function. The only thing that can appear for a function is a symbol (e.g., car, append) or a lambda expression (e.g., (lambda (x) (+ x 1)).
You want to call (append (car l) k) instead.
First, CL does not have a set data type.
Lists, however, can be used as sets, you do not need to write any special code for that.
Second, I don't understand what your st function is supposed to do, but I bet that in the second cond clause you should not quote (car l) and k. You should use meaningful names for your functions and avoid abbreviations. As per your explanation in the comment, you should use pushnew instead.
Third, your mem function is quite weird, I am pretty sure you do not mean what you wrote: e is searched along a path in the tree l, not in the list l. As per your explanation in the comment, you should check both car and cdr:
(defun tree-member (tree element &key (test #'eql))
(if (consp tree)
(or (tree-member (car tree) element :test test)
(tree-member (cdr tree) element :test test))
(funcall test element tree)))
I'm trying to write a scheme function that will return the unique atoms found in the input list such that.
> (unique-atoms '(a (b) b ((c)) (a (b))))
(a c b)
> (unique-atoms '(a . a))
(a)
> (unique-atoms '())
()
I was thinking something like this as a start
(define (unique-atoms l)
(if (null? l)
'()
(eq? (car (l) unique-atoms(cdr (l))))))
but I don't know how to collect the atoms that are unique, and create a new list while checking everything recursively.
The following walks list, term by term. If the next value is a list itself, then a recursive call is made with (append next rest) - that is, as list is walked we are flattening sublists at the same time.
We use a (tail) recursive function, looking, to walk the list and to accumulate the rslt. We add to the result when next is not alreay in rslt.
(define (uniquely list)
(let looking ((rslt '()) (list list))
(if (null? list)
rslt
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(looking rslt (append next rest))
(looking (if (memq next rslt)
rslt
(cons next rslt))
rest))))))
> (uniquely '(a b (a b) ((((a))))))
(b a)
If you really want the code to work for 'improper lists' like '(a . a) then the predicates null? and list? probably need to change.
This problem has two parts:
You need to find a way to visit each element of the given form, recursing into sublists.
You need a way to collect the unique elements being visited.
Here's a solution to the first part:
(define (recursive-fold visitor initial x)
(let recur ((value initial)
(x x))
(cond ((null? x) value)
((pair? x) (recur (recur value (car x)) (cdr x)))
(else (visitor x value)))))
I leave it for you to implement the second part.
I found a half solution where the non unique items are removed, although this wont work for an atom b and a list with b such as '(b (b))
(define (uniqueAtoms l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(uniqueAtoms (cdr l)))
(else
(cons (car l) (uniqueAtoms (cdr l))))))
The easiest way to solve this problem with all kinds of list structures is to divide it into two parts
1) flatten then list - this results in a proper list with no sublists
; if you use Racket, you can use the build-in flatten procedure
; otherwise this one should do
(define (flatten expr)
(let loop ((expr expr) (res '()))
(cond
((empty? expr) res)
((pair? expr) (append (flatten (car expr)) (flatten (cdr expr))))
(else (cons expr res)))))
2) find all unique members of this proper list
(define (unique-atoms lst)
(let loop ((lst (flatten lst)) (res '()))
(if (empty? lst)
(reverse res)
(let ((c (car lst)))
(loop (cdr lst) (if (member c res) res (cons c res)))))))
Tests:
; unit test - Racket specific
(module+ test
(require rackunit)
(check-equal? (unique-atoms '(a (b) b ((c)) (a (b)))) '(a b c))
(check-equal? (unique-atoms '(a (b) b ((c . q)) (a (b . d)))) '(a b c q d))
(check-equal? (unique-atoms '(a . a)) '(a))
(check-equal? (unique-atoms '(a b (a b) ((((a)))))) '(a b))
(check-equal? (unique-atoms '()) '()))
I'm new in scheme programming and I'm learning basic algorithms, like how to define map, append and so on.
But there is an algorithm for which I can't find an implementation. I speak about transforming an M-dimensional list into one dimension. I tried to define it by myself, but without success.
What exactly I want:
'(a b c (d (e)) (g f h)) => '(a b c d e g f h)
I think the term you want to search for is "Flatten". The simplest way to write it is this: if it's not a list, then return a list of length one containing it. If it is a list, then apply append to the result of mapping a recursive call over its elements.
There are a couple of ways to flatten a list. First, a straightforward solution using only primitive list procedures:
(define (flatten lst)
(cond ((null? lst)
'())
((not (list? lst))
(list lst))
(else
(append (flatten (car lst))
(flatten (cdr lst))))))
This other solution uses the map higher-order procedure and apply (as suggested by John Clements):
(define (flatten lst)
(if (not (list? lst))
(list lst)
(apply append (map flatten lst))))
And finally, as has been mentioned in the comments, the built-in flatten procedure found in some Scheme implementations like Racket (I don't know if it's available in bigloo):
(require racket/list)
(flatten '(a b c (d (e)) (g f h)))
im trying to write a function in Scheme where i accept a list and return all the different derangements (look below for definition) as a list of lists
derangement: A list where no item is in the same place as the original list
ex: '(a b c) -> '(cab)
any help is appreciated!
Compute all of the permutations of the input list and then filter out the ones that have an element in the same position as the input list. If you need more detail, leave a comment.
Edit 1:
Define (or maybe it's defined already? Good exercise, anyway) a procedure called filter that takes as its first argument a procedure p and a list l as its second argument. Return a list containing only the values for which (p l) returns a truthy value.
Define a procedure derangement? that tests if a list l1 is a derangement of l2. This will be handy when paired with filter.
The most obvious solution would be something like this:
(define filtered-permutations
(lambda (lst)
(filter
(lambda (permuted-list)
(deranged? permuted-list lst))
(permute lst))))
Since the number of derangements is considerably lower than then number of permutations, however, this is not very efficient. Here is a solution that mostly avoids generating permutations that are not derangements, but does use filter once, for the sake of simplicity:
(define deranged?
(lambda (lst1 lst2)
(if (null? lst1)
#t
(if (eq? (car lst1) (car lst2))
#f
(deranged? (cdr lst1) (cdr lst2))))))
(define derange
(lambda (lst)
(if (< (length lst) 2)
;; a list of zero or one elements can not be deranged
'()
(permute-helper lst lst))))
(define derange-helper
(lambda (lst template)
(if (= 2 (length lst))
(let ((one (car lst))
(two (cadr lst)))
(filter
(lambda (x)
(deranged? x template))
(list (list one two) (list two one))))
(let ((anchor (car template)))
(let loop ((todo lst)
(done '())
(result '()))
(if (null? todo)
result
(let ((item (car todo)))
(if (eq? item anchor)
;; this permutation would not be a derangement
(loop (cdr todo)
(cons item done)
result)
(let ((permutations
(map
(lambda (x)
(cons item x))
(derange-helper (append (cdr todo) done)
(cdr template)))))
(loop (cdr todo)
(cons item done)
(append result permutations)))))))))))