I am writing a function to duplicate all the items in a list, so that a list like (a (b c)) becomes (a a (b b c c)), however my function returns (a a b b c c). How do I ensure I retain the internal list structure? Here is my current code:
(define double
(lambda (l)
(cond ((null? l) '())
((list? l) (append (double (car l)) (double (cdr l))))
(else (append (list l) (list l)) )
)
))
To preserve the structure of the list, you have to avoid using append. Here is an implementation:
(define (double lst)
(cond
[(null? lst) empty]
[(list? (car lst))
(cons (double (car lst))
(double (cdr lst)))]
[else
(cons (car lst) (cons (car lst)
(double (cdr lst))))]))
For example,
> (double '(a (b c) ((a b) (c d))))
'(a a (b b c c) ((a a b b) (c c d d)))
Shallow copy:
(define (copy-list lst)
(map values lst))
And of course map is like this for one list argument:
(define (map f lst)
(if (null? lst)
'()
(cons (f (car lst))
(map f (cdr lst)))))
Deep copy:
(define (copy-tree tree)
(accumulate-tree tree values cons '()))
And this is how accumulate-tree is made:
(define (accumulate-tree tree term combiner null-value)
(let rec ((tree tree))
(cond ((null? tree) null-value)
((not (pair? tree)) (term tree))
(else (combiner (rec (car tree))
(rec (cdr tree)))))))
Related
So I'm programming in scheme and made a function that removes duplicated but it doesn't work for nested. I can't really figure out a good way to do this, is there a way to modify the current code I have and simply make it work with nested? lists?
Here's my code
(define (duplicates L)
(cond ((null? L)
'())
((member (car L) (cdr L))
(duplicates (cdr L)))
(else
(cons (car L) (duplicates (cdr L))))))
So your procedure jumps over elements that exist in the rest of the list so that (duplicates '(b a b)) becomes (a b) and not (b a). It works for a flat list but in a tree you might not have a first element in that list but a list. It's much easier to keep the first occurrence and blacklist future elements. The following code uses a hash since you have tagged racket. Doing this without a hash requires multiple-value returns or mutation.
(define (remove-duplicates lst)
(define seen (make-hasheqv))
(define (ins val)
(hash-set! seen val #t)
val)
(let aux ((lst lst))
(cond ((null? lst) lst)
((not (pair? lst)) (if (hash-has-key? seen lst) '() (ins lst)))
((pair? (car lst)) (let ((a (aux (car lst))))
(if (null? a) ; if the only element is elmininated
(aux (cdr lst))
(cons a (aux (cdr lst))))))
((hash-has-key? seen (car lst)) (aux (cdr lst)))
(else (cons (ins (car lst)) ; NB! order of evaluation in Racket is left to right but not in Scheme!
(aux (cdr lst)))))))
;; test
(remove-duplicates '(a b a)) ; ==> (a b)
(remove-duplicates '(a (a) b a)) ; ==> (a b)
(remove-duplicates '(a (b a) b a)) ; ==> (a (b))
(remove-duplicates '(a b (a b) b a)) ; ==> (a b)
(remove-duplicates '(a (a . b) b a)) ; ==> (a b)
(remove-duplicates '(a b (a b . c) b a . d)) ; ==> (a b c . d)
I am getting "Error: Invalid lambda: (lambda (insert-all))."
(define permutations
(lambda (L)
(let
((insert-all
(lambda (e Ls)
(let
((insert-one
(lambda (L)
(letrec
((helper
(lambda(L R)
(if (null? R)
(list (append L(list e)R))
(helper (append L (list (car R) ) ) (cdr R) )
))))
(helper '() L)))))
(apply append(map insert-one Ls)))))))
(cond ((null? L) '() )
((null?(cdr L)) (list L))
(else (insert-all (car L) (permutations ((cdr L))))))))
It is supposed to return all permutations of a given list.
The form that you have provided in not valid scheme. Specifically, your highest-level let form does not have a body. You might be thinking that the cond clause is the body but owing to your parenthesis it is not part of the let. Honestly, this is the fault of your formatting. Here is a 'properly' formatted Scheme form:
(define (permutations L)
(let ((insert-all
(lambda (e Ls)
(let ((insert-one
(lambda (L)
(let helper ((L '()) (R L))
(if (null? R)
(list (append L (list e) R))
(helper (append L (list (car R)))
(cdr R)))))))
(apply append (map insert-one Ls))))))
(cond ((null? L) '())
((null? (cdr L)) (list L))
(else (insert-all (car L)
(permutations (cdr L)))))))
At least it compiles and runs, although it doesn't produce the right answer (although I don't know what the proper input it):
> (permutations '(a b c))
((c b a))
> (permutations '((a b) (1 2)))
(((1 2) (a b)))
Here is an implementation that works:
(define (permutations L)
(define (insert-all e Ls)
(apply append
(map (lambda (e)
(map (lambda (x) (cons e x)) Ls))
e)))
(cond ((null? L) '())
((null? (cdr L)) (map list (car L)))
(else (insert-all (car L)
(permutations (cdr L))))))
> (permutations '((a b) (1 2) (x y)))
((a 1 x) (a 1 y) (a 2 x) (a 2 y) (b 1 x) (b 1 y) (b 2 x) (b 2 y))
The basic structure of your code was fine; just the implementation of your insert-one and helper were lacking.
So I have this program that needs to be written in Scheme using Racket that has the following properties and I am stumped. The function is called sublist? with two inputs of S and L which are both lists. It checks whether S is a sublist of L and returns #t or #f.
Examples would be similar to:
sublist? of (A A) and (A B C) is #f
sublist? of (A B C) and (A B D A B C D) is #t
sublist? of (A (B)) and (C ((A (B))) (C)) is #t
A small function called extractLists needs to be created to extract the lists and (atomicSublist S L) is used to check the two extracted lists to see if every element of S is in L.
So far I have
(define (atomicSublist S L)
(cond ((null? L) #f)
((equal? S (car L)) #t)
(else (atomicSublist S (cdr L)))))
The second part does not really do anything and doesn't even output the extracted value of S.
Updated code:
Just for testing I use atomicSublist to check for now.
Begin with a simpler problem and then generalize.
How would you write a function that checks whether a symbol 'a is an a list or not?
I don't think you want this check ((equal? S (car L) ) #t) as the car of L will never be equal to the list S.
Heres what I came up with for atomicSublist.
(define (atomicSublist S L)
(cond
[(null? S) #t]
[(member? (car S) L) (atomicSublist (cdr s) L)]
[else #f]))
The question is a little ambiguous. What should this return? (sublist? '(a (b)) '(a b c d e)) ??
Anyway here is what i wrote:
(define (sublist? s l)
(cond ((null? s) true)
((atom? (car s))
(cond ((exists? (car s) l) (sublist? (cdr s) (remove-elm (car s) l)))
(else false)))
(else
(cond ((sublist? (car s) l) (sublist? (cdr s) (remove-elm (car s) l)))
(else false)))))
(define (exists? elm l)
(cond ((null? l) false)
((atom? (car l))
(cond ((symbol=? elm (car l)) true)
(else (exists? elm (cdr l)))))
(else
(cond ((exists? elm (car l)) true)
(else (exists? elm (cdr l)))))))
(define (remove-elm elm l)
(cond ((null? l) '())
((null? elm) l)
((atom? elm)
(cond ((atom? (car l))
(cond ((symbol=? elm (car l)) (cdr l))
(else (cons (car l) (remove-elm elm (cdr l))))))
(else
(cons (remove-elm elm (car l)) (remove-elm elm (cdr l))))))
(else
(remove-elm (cdr elm) (remove-elm (car elm) l)))))
(define (atom? elm)
(and (not (null? elm)) (not (pair? elm))))
(sublist? '(a a) ('a b c d e)) returns #f. (sublist? '(a b c) '(a d b e c f)) returns #t. (sublist? '(a (b)) '(c ((a (b)) e f))) returns #t. (sublist? '(a (b) b) '(c ((a (b)) e f))) retrns #f. However, (sublist? '(a (b)) '(a b c d)) returns #t.
Given a list,
(define ll '(a a a b c c c d e e e e))
I want to remove all non-duplicate elements and leave only one copy of the duplicate one, i.e. after removing, the result would be
(a c e)
My algorithm is:
Traverse through the list, comparing current element with next element.
If they're equal, then cons the current element with the list of the next recursive call. For example,
(a a a b c)
Move from left to right, encounter a and a.
(cons a (remove-nondup (cddr lst)))
Otherwise, skip current and next element.
(remove-nondup (cddr lst))
The problem I'm having is
(define (remove-nondup lst)
(if (>= (length lst) 2)
(if (eq? (car lst) (cadr lst))
(cons (car lst) (remove-nondup (cdr lst)))
(remove-nondup (cddr lst)))
lst))
The problem that I'm having is if there are more than 3 consecutive elements, I have no way to keep track of the previous-previous one. So I wonder should I use another procedure to remove all duplicates? or I can just put them into one procedure?
So my alternative current solution was,
(define (remove-dup lst)
(if (>= (length lst) 2)
(if (eq? (car lst) (cadr lst))
(cons (car lst) (remove-dup (cddr lst)))
(cons (car lst) (remove-dup (cdr lst))))
lst))
(define (remove-nondup-helper lst)
(if (>= (length lst) 2)
(if (eq? (car lst) (cadr lst))
(cons (car lst) (remove-nondup-helper (cdr lst)))
(remove-nondup (cddr lst)))
lst))
; call the helper function and remove-dup
(define (remove-nondup lst)
(remove-dup (remove-nondup-helper lst)))
Here's my solution: first, grab bagify (any version will do). Then:
(define (remove-singletons lst)
(define (singleton? ass)
(< (cdr ass) 2))
(map car (remove singleton? (bagify lst))))
remove is from SRFI 1. If you're using Racket, run (require srfi/1) first. Or, use this simple definition:
(define remove #f) ; Only needed in Racket's REPL
(define (remove pred lst)
(cond ((null? lst) lst)
((pred (car lst)) (remove pred (cdr lst)))
(else (cons (car lst) (remove pred (cdr lst))))))
Here's a way that uses only standard library functions and only tail calls, though it performs linear searches to see if an item has already been seen or put in the result:
(define remove-nondup
(λ (ls)
(reverse
(let loop ([ls ls] [found '()] [acc '()])
(cond
[(null? ls)
acc]
[(memq (car ls) found)
(loop (cdr ls)
found
(if (memq (car ls) acc)
acc
(cons (car ls) acc)))]
[else
(loop (cdr ls)
(cons (car ls) found)
acc)])))))
(remove-nondup '(a a a b c c c d e e e e)) =>
(a c e)
(remove-nondup '(a a a b c c c d e e e e f a a f)) =>
(a c e f)
The loop is a "named let": a handy way to stick a helper procedure inside a procedure without a lot of syntactic clutter.
If you only want to shrink consecutive duplicates down to one item, and remove items only when they don't occur twice consecutively, then here's a way to "remember" the item two cells ago without searching for it, and using only tail calls:
(define remove-nonconsecdup
(λ (ls)
(reverse
(letrec (
[got1 (λ (ls prev acc)
(cond
[(null? ls)
acc]
[(eq? prev (car ls))
(got2 (cdr ls) (cons prev acc))]
[else
(got1 (cdr ls) (car ls) acc)]))]
[got2 (λ (ls acc)
(cond
[(null? ls)
acc]
[(eq? (car acc) (car ls))
(got2 (cdr ls) acc)]
[else
(got1 (cdr ls) (car ls) acc)]))])
(if (null? ls)
'()
(got1 (cdr ls) (car ls) '()))))))
(remove-nonconsecdup '(a a a b c c c d e e e e)) =>
(a c e)
(remove-nonconsecdup '(a a a b c c c d e e e e f a a f)) =>
(a c e a)
I don't like reversing lists, but calling reverse is easy. If the extra cons'ing done by reverse is a problem, you could do non-tail calls or stick the items at the end of the list, but that's harder to do efficiently (but easy with a non-standard library macro).
(define *graph* (read (open-input-file "test.sxml")))
(define get
(lambda (l)
(cond ((null? l) '())
((equal? 'opm:artifacts (car l)) l)
(else (get (cdr l))))))
(get *graph*)
I have this recursive function that goes through the list and returns the rest of a list that starts with "opm:artifacts".
It works on other lists.
For example, it works for the list (1 2 3 4); when I call the function,
(get 2) returns (2 3 4).
test.sxml is a list. I checked it with list?.
(define (get l)
(match l
[(? null?) '()]
[(list 'opm:artifacts _ ...) l]
[(list _ rs ...) (get rs)]))
(define (get mat ls*)
(define (get* ls)
(cond ((null? ls) '())
((and (list? (car ls)) (not (null? (car ls))))
(if (equal? mat (caar ls))
(car ls)
(let ((sub-result (get* (car ls))))
(if (null? sub-result)
(get* (cdr ls))
sub-result))))
(else (get* (cdr ls)))))
(let ((result (get* ls*)))
(if (null? result)
'()
(cdr result))))
(get 'b '(a (b c d) e)) ;-> '(c d)
(get 'b '((a (b c d) e))) ;-> '(c d)
(get '() '( 4 6 () (2 ()) (() () ()))) ;-> '(() ())
I've also generalized it so you can hand in what you want it to match against.