Flatten once procedure - scheme

I'm having a bit of a struggle with coding a procedure that flattens a list once, i.e
(flatten-once '((b) (c f) ((d)(e)))) would produce '(b c f (d) (e))). I checked up on a few sources on how the standard flatten procedure works but it implements functions that are not included in the intermediate student with lambda language form I'm required to use. As far as I have it figured out a foldr would be somewhat helpful and have managed to get this
(define (flatten-once lst)
(cond
[(empty? lst) lst]
[else
((foldr cons (first (rest lst)) (first lst)))]))
which returns '(b c f) , so I guess it flattens part of the list. I tried continuing the definition through recursion but that just gives errors, so I guess I'm missing something.

The proposed code is overly complicated, resist the temptation to use folds everywhere, they're not the answer to everything - I say this because I've seen other of your questions and frequently, there's an unnecessary call to foldr or foldl. A simple append will do the trick:
(define (flatten-once lst)
(apply append lst))
It works as expected:
(flatten-once '((b) (c f) ((d)(e))))
=> '(b c f (d) (e))
If the input list contains elements which are not lists, then a bit more of work needs to be done. To be extra-careful, we can do this:
(define (flatten-once lst)
(apply append
(map (lambda (e) (if (cons? e) e (list e)))
lst)))
Now it'll work for inputs such as this one, noticing that the element a was added to the list. Another alternative would be to delete it from the list, if that makes more sense then replace (list e) with '() in the code above.
(flatten-once '(a (b) (c f) ((d)(e))))
=> '(a b c f (d) (e))
Finally, in the spirit of #Alex's answer, this second variant can also be written using foldr:
(define (flatten-once lst)
(foldr (lambda (e acc)
(append (if (cons? e) e (list e)) acc))
'()
lst))

The trick is as Óscar López already said, to use append.
If you want to use a solution with foldr :
(define (flatten-once lst)
(foldr append '() lst))
It should work as expected.

Less elegant that Oscar's version, but without append (and twice as fast in my tests):
(define (flatten-once lst)
(reverse
(let loop ((lst lst) (first #t) (res null))
(if (null? lst)
res
(let ((e (car lst)))
(loop (cdr lst)
first
(if (and first (cons? e))
(loop e #f res)
(cons e res))))))))
NB in intermediate student with lambda language this needs to be expressed as:
(define (flatten-once-helper lst first res)
(if (null? lst)
res
(let ((e (car lst)))
(flatten-once-helper
(cdr lst)
first
(if (and first (cons? e))
(flatten-once-helper e #f res)
(cons e res))))))
(define (flatten-once lst)
(reverse (flatten-once-helper lst #t null)))

Related

Inserting word beside another word starting from the end of list

I have code which is inserting new word on the right side of choosen word
(define insertR
(lambda (new old lst)
(cond
((null? lst) (lst))
(else (cond
((eq? (car lst) old)
(cons old
(cons new (cdr lst))))
(else (cons (car lst)
(insertR new old
(cdr lst)))))))))
i need to make it insert that word beside first appearance of word starting from the end of list. Tried to work with reverse but could not get that to work.
There are two strategies you can take to add it next to the last occurence.
The first is to use a helper and start off with the reverse list. This is very simple and my preferred solution.
(define (insert-by-last-match insert find lst)
(let loop ((lst (reverse lst)) (acc '()))
(if (null? lst)
acc
(let ((a (car lst)))
(if (equal? a find)
(append (reverse (cdr lst))
(list* find insert acc))
(loop (cdr lst) (cons a acc)))))))
The other one is kind of obscure. Whenever you find the element you replace last-match with a callback that replaces the computation since it was made and until it gets called with the replacement and the rest of the list, which of course is the correct result. The work done until the end of the list is simply discarded since it is not used, but we do it since we are not sure if we are going to find a later one and then all the work uptil that is of course included in the result.
(define (insert-by-last-match insert find lst)
(define (helper lst last-match)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)))
(cons a
(if (equal? a find)
(let/cc k
(helper d (lambda () (k (cons insert d)))))
(helper d last-match))))))
(helper lst (lambda () lst)))
call/cc (or its variant let/cc) is often described as time travel or advanced goto. It is not very intuitive. Here is a CPS version:
(define (insert-by-last-match insert find lst)
(define (helper lst last-match k)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)) (k2 (lambda (v) (k (cons a v)))))
(if (equal? a find)
(helper d (lambda () (k2 (cons insert d))) k2)
(helper d last-match k2)))))
(helper lst (lambda () lst) (lambda (v) v)))
Basically this is the same as the previous only that here I have written the CPS code and with the let/cc version the implementation does it for me and I get to use k exactly where I need it. In this version you see there is no magic or time travel but the execution that should happen later is simply replaced at a point.
Write in a similar way insertL and apply it to the reversed list.
And reverse the result. Then you will have an insertion beside first appearance of word starting from the end of list
(define insertL
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons new lst))
(else (cons (car lst) (insertL new old (cdr lst)))))))
(define last-insertR
(lambda (new old lst)
(let* ((rlst (reverse lst))
(result (insertL new old rlst)))
(reverse result))))
test:
(last-insertR 'aa 'a '(b c d a h i a g))
;; '(b c d a h i a aa g)
By the way, the beauty of cond is that you can put the conditions always at the beginning - listed one under the other.
So one can write your insertR nicer as:
(define insertR
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons old (cons new (cdr lst))))
(else (cons (car lst) (insertR new old (cdr lst)))))))

Remove-adjacent-duplicates

I want to implement a function which takes a list as input and returns as value the same list with any sequence of repeated elements reduced to a single element:
Example:
(remove-adjacent-duplicates ’(y a b b a d a b b a d o o)) ; the return'(y a b a d a b a d o)
(remove-adjacent-duplicates ’(yeah yeah yeah)) ;the return '(yeah)
I have managed to do this with the following code:
(define (remove-adjacent-duplicates ls)
(if (null? ls)
'()
(let ((first (car ls)))
(let loop ((known first)
(rest (cdr ls))
(so-far (list first)))
(if (null? rest)
(reverse so-far)
(let ((first-remaining (car rest)))
(loop first-remaining
(cdr rest)
(if (equal? known first-remaining)
so-far
(cons first-remaining so-far)))))))))
But the code is not pretty and contains loop I want a recursion code using utilities such as 'car' 'cdr' and 'cons'.
loop is the name of an inner procedure and is called recursively; look up named lets. You can name it what you want; in my example I have called it iter to avoid this confusion.
You can also simplify a little:
(define (remove-adjacent-duplicates lst)
(let iter ((lst lst) (res '()))
(if (null? lst)
(reverse res)
(let ((next (car lst)))
(iter (cdr lst)
(if (or (null? res) (not (equal? next (car res))))
(cons next res)
res))))))

Lists traversal in Scheme

myList is a list with elements both as symbols or lists of the same type of myList.
For example: myList = '(a b (a d c) d ()) , etc.
I want to write a function in Scheme which would just traverse it (eventually I will replace the symbols with other values).
I wrote this function:
(define traversal (lambda (myList)
(if (null? myList) '()
(if (and (list? (car myList)) (not (null? (car myList))))
(list (traversal (car myList)) (traversal (cdr myList)))
; else if car is an empty list
(if (null? (car myList))
(list (traversal (cdr myList)))
; else car is a symbol
(append (list (car myList)) (traversal (cdr myList))))))))
It gives correct results for some configuration of myList, but definitely it is not the one.
For example,
(display (traversal '((f) h (r t b) (x m b m y) b (c (d)))))
adds additional paranthesis which I don't need.
What would be a correct way to display such a list?
You're testing null? in so many places, where one test is generally enough.
You rarely use list in these traversals, but simply cons.
Also, append is best avoided, and not needed here.
Repetitive use of (car ...) is optimised with a let form.
The simplified form of your code would be:
(define traversal
(lambda (myList)
(if (null? myList)
'()
(let ((c (car myList)))
(cons (if (list? c) (traversal c) c)
(traversal (cdr myList)))))))
EDIT
While this procedure works well for proper lists, it doesn't correctly work for improper lists (although it appears to). The following is a more general approach that works for every kind of S-expression, including proper lists, and I recommend this over the previous code:
(define traversal
(lambda (sexp)
(cond
((null? sexp) '())
((pair? sexp) (cons (traversal (car sexp))
(traversal (cdr sexp))))
(else sexp))))
You are close to the solution. Here are a few hints:
Instead of nested ifs try using the cond form, it is more readable.
The expression (and (list? (car myList)) (not (null? (car myList)))) is correct, but you may use (pair? (car myList)) which is shorter and does almost the same thing.
traversal should return a list but using list with list arguments here
(list (traversal (car myList)) (traversal (cdr myList)))
will return a list of lists. E.g. (list '(a) '(b)) will return ((a) (b)) instead of (a b). In these cases you should use append (append '(a) '(b)) -> (a b).
If a value is not a list but you want to add it to an existing list, use the cons procedure.
(cons 'a '(b c)) -> (a b c).

How to remove non-duplicate elements from a list in Scheme?

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).

how to define last in scheme?

how can I write a function to take the last element of the list?
find the last of a list:
(define (last l)
(cond ((null? (cdr l)) (car l))
(else (last (cdr l)))))
use map to map last to a list:
(map last '((a b) (c d) (e f)))
==> (b d f)
so a new function:
(define (last-list l)
(map last l)
)
(last-list '((a b) (c d) (e f)))
==> (b d f)
May not be the most efficient, but certainly one of the simplest:
(define (last lst)
(car (reverse lst)))
Examples:
(last '(1 2 3 4)) => 4
(last '((a b) (b c) (d e))) => (d e)
The code you've written - to take the last element of a list - is correctly returning the last element of the list. You have a list of lists. There is an outer list
(x y z)
where
x = (a b)
y = (c d)
z = (e f)
So you're getting the last element of the list, z, which is (e f)
Did you want your last function to do something different? If you want it to return the last element of the last nested list, you need to change your base case. Right now you return the car. Instead, you want to check if the car is a list and then call your nested-last function on that.
Make sense?
Your last function is good, but you have to think about what you want to do with it now.
You have a list of lists, and you want to take the last of all those.
So recurse down your list applying it each time:
(define (answer lst)
(cond ((null? (cdr l)) null)
(else (cons (last (car l)) (answer (cdr lst))))
Yet another possibility:
(define (last thelist)
(if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (map last lists))
Edit: just saw that you don't know map, and want a solution without it:
(define (all-last lists)
(if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
As far as getting an empty list goes, I'd guess you're trying to use this map-like front-end with your original definition of last, whereas it's intended to work with the definition of last I gave above. Try the following definitions:
(define (last thelist) (if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
and running a quick test:
(all-last `((a b) (c d) (e f)))
The result should be:
(b d f)
(define last
(lambda (ls)
(list-ref ls (- (length ls) 1))))
I like short, sweet, fast, tail-recursive procedures.
Named let is my friend.
This solves the original problem and returns #f if the list has no last element.
(define (last L) (let f ((last #f) (L L)) (if (empty? L) last (f (car L) (cdr L)))))
The best way to get what you want:
(define (last lst)
(cond [(empty? lst) empty]
[(empty? (rest lst)) (first lst)]
[else (last (rest lst))]))

Resources