Scheme reverse a list - recursion

I am trying to reverse a list in Scheme using DrRacket.
Code:
(define rev
(lambda(l)
(if (null? l)
'()
(append (rev (cdr l)) (list (car l))))))
If I input (rev '(a((b)(c d)(((e)))))), the output is (((b) (c d) (((e)))) a).
I want it to be (((((e)))(d c)(b))a). I looked here: How to Reverse a List? but I get an even worse output. What am I doing wrong? Any help would be appreciated!

This is trickier than it looks, you're trying to do a "deep reverse" on a list of lists, not only the elements are reversed, but also the structure … here, try this:
(define (rev l)
(let loop ((lst l)
(acc '()))
(cond ((null? lst) acc)
((not (pair? lst)) lst)
(else (loop (cdr lst)
(cons (rev (car lst))
acc))))))
It works as expected:
(rev '(a ((b) (c d) (((e))))))
=> '(((((e))) (d c) (b)) a)

This code will do it:
(define (rev-list lst)
(if (null? lst)
null
(if (list? lst)
(append (rev-list (cdr lst)
(list (rev-list (car lst))))
lst)))
And the result is:
>>> (display (rev-list '((1 7) 5 (2 4 (5 9))) ))
(((9 5) 4 2) 5 (7 1))
The idea is simple: Return the arg if it's not a list, return rev-list(arg) otherwise.

Related

Implementing last-non-zero without continuations

last-non-zero takes a list of numbers and return the last cdr whose car is 0.
So, I can implement it using continuations, but how do I do this with natural recursion.
(define last-non-zero
(lambda (ls)
(let/cc return
(letrec
((lnz
(lambda (ls)
(cond
((null? ls) '())
((zero? (car ls)) ;; jump out when we get to last 0.
(return (lnz (cdr ls))))
(else
(cons (car ls) (lnz (cdr ls))))))))
(lnz ls)))))
Here's an obvious version which is not tail-recursive:
(define (last-non-zero l)
;; Return the last cdr of l which does not contain zero
;; or #f if there is none
(cond
((null? l)
#f)
((zero? (car l))
(let ((lnzc (last-non-zero (cdr l))))
;; This is (or lnzc (cdr l)) but that makes me feel bad
(if lnzc
lnzc
(cdr l))))
(else
(last-non-zero (cdr l)))))
Here is that version turned into a tail-recursive equivalent with also the zero test moved around a bit.
(define (last-non-zero l)
(let lnzl ([lt l]
[r #f])
(if (null? lt)
r
(lnzl (cdr lt) (if (zero? (car lt)) (cdr lt) r)))))
It's much clearer in this last version that the list is traversed exactly once.
Please indicate if I have correctly understood the problem:
#lang scheme
; returns cdr after last zero in lst
(define (last-non-zero lst)
; a helper function with 'saved' holding progress
(define (lnz-iter lst saved)
(if (null? lst)
saved
(if (zero? (car lst))
(lnz-iter (cdr lst) (cdr lst))
(lnz-iter (cdr lst) saved))))
(lnz-iter lst '()))
(last-non-zero '(1 2 3 0 7 9)) ; result (7 9)
Racket's takef-right can do it:
> (takef-right '(1 2 0 3 4 0 5 6 7) (lambda (n) (not (zero? n))))
'(5 6 7)
But assuming you have an assignment where you're supposed to write the logic yourself instead of just using a built in function, one easy if not very efficient approach is to reverse the list, build a new list out of everything up to the first zero, and return that. Something like:
(define (last-non-zero ls)
(let loop ([res '()]
[ls (reverse ls)])
(if (or (null? ls) (zero? (car ls)))
res
(loop (cons (car ls) res) (cdr ls)))))
Using your implementation where you return the argument in the event there are no zero you can just have a variable to keep the value you think has no zero values until you hit it and then update both:
(define (last-non-zero lst)
(let loop ((lst lst) (result lst))
(cond ((null? lst) result)
((zero? (car lst)) (loop (cdr lst) (cdr lst)))
(else (loop (cdr lst) result)))))
(last-non-zero '()) ; ==> ()
(last-non-zero '(2 3)) ; ==> (2 3)
(last-non-zero '(2 3 0)) ; ==> ()
(last-non-zero '(2 3 0 1 2)) ; ==> (1 2)
(define last-non-zero
(lambda (l)
((lambda (s) (s s l (lambda (x) x)))
(lambda (s l* ret)
(if (null? l*)
(ret '())
(let ((a (car l*))
(r (cdr l*)))
(if (zero? a)
(s s r (lambda (x) x))
(s s r
(lambda (r)
(ret (cons a r)))))))))))
Also possible, to use foldr:
(define (last-non-zero l)
(reverse (foldl (lambda (e res) (if (zero? e) '() (cons e res))) 0 l)))
Or use recursion:
(define (last-non-zero l (res '()))
(cond ((empty? l) res)
((zero? (car l)) (last-non-zero (cdr l) (cdr l)))
(else (last-non-zero (cdr l) res))))

Leave only the elements that are not repeated in a given list IN SCHEME [duplicate]

I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)

Member function for nested list in Scheme

Can someone show me the error in this code please?
I want to generalize the member function to support nested lists. I need to search thing inside the nested list and return the rest of the list when I found thing. I don't really understand whats wrong with the code below.
(define (memberk thing lis)
(cond
((null? lis) #f)
((list? (car lis))
(cons (memberk thing (car lis))
(memberk thing (cdr lis))))
(else
(if (equal? (car lis) thing)
lis
(memberk thing (cdr lis))))))
Expexted output: (memberk 3 '(1 4 (3 1) 2)) = '((3 1) 2)
Actual output from the code above: '((3 1) . #f)
So how I see this you would like the top level cons that has the key found somewhere in car. I'm thinking something like:
(define (memberk needle lst)
(define (found? haystack)
(or (equal? needle haystack)
(and (pair? haystack)
(or (found? (car haystack))
(found? (cdr haystack))))))
(let loop ((lst lst))
(cond ((null? lst) #f)
((found? (car lst)) lst)
(else (loop (cdr lst))))))
(memberk '(a) '(a b (b (a) c) c d)) ; ==> ((b (a) c) c d)
Something like this?
It is a bit unclear what you want - since there is only one test case.
(define (memberk thing lis)
(cond
[(null? lis)
#f]
[(and (cons? (car lis)) (memberk thing (car lis)))
=> (λ (found) (cons found (cdr lis)))]
[(equal? (car lis) thing)
lis]
[else
(memberk thing (cdr lis))]))

Recursion on list of pairs in Scheme

I have tried many times but I still stuck in this problem, here is my input:
(define *graph*
'((a . 2) (b . 2) (c . 1) (e . 1) (f . 1)))
and I want the output to be like this: ((2 a b) (1 c e f))
Here is my code:
(define group-by-degree
(lambda (out-degree)
(if (null? (car (cdr out-degree)))
'done
(if (equal? (cdr (car out-degree)) (cdr (car (cdr out-degree))))
(list (cdr (car out-degree)) (append (car (car out-degree))))
(group-by-degree (cdr out-degree))))))
Can you please show me what I have done wrong cos the output of my code is (2 a). Then I think the idea of my code is correct.
Please help!!!
A very nice and elegant way to solve this problem, would be to use hash tables to keep track of the pairs found in the list. In this way we only need a single pass over the input list:
(define (group-by-degree lst)
(hash->list
(foldl (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst)))
The result will appear in a different order than the one shown in the question, but nevertheless it's correct:
(group-by-degree *graph*)
=> '((1 f e c) (2 b a))
If the order in the output list is a problem try this instead, it's less efficient than the previous answer, but the output will be identical to the one in the question:
(define (group-by-degree lst)
(reverse
(hash->list
(foldr (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst))))
(group-by-degree *graph*)
=> '((2 a b) (1 c e f))
I don't know why the lambda is necessary; you can directly define a function with (define (function arg1 arg2 ...) ...)
That aside, however, to put it briefly, the problen is that the cars and cdrs are messed up. I couldn't find a way to tweak your solution to work, but here is a working implementation:
; appends first element of pair into a sublist whose first element
; matches the second of the pair
(define (my-append new lst) ; new is a pair
(if (null? lst)
(list (list (cdr new) (car new)))
(if (equal? (car (car lst)) (cdr new))
(list (append (car lst) (list (car new))))
(append (list (car lst)) (my-append new (cdr lst)))
)
)
)
; parses through a list of pairs and appends them into the list
; according to my-append
(define (my-combine ind)
(if (null? ind)
'()
(my-append (car ind) (my-combine (cdr ind))))
)
; just a wrapper for my-combine, which evaluates the list backwards
; this sets the order right
(define (group-by-degree out-degree)
(my-combine (reverse out-degree)))

homework on scheme

how to design a function content which
inputs a single list of atoms lat and which returns
the content of lat.Thus the content of '(a b c a b c d d) is '(a b c d).
The procedure content below should get you what you need.
(define (work x y)
(if (null? (cdr x))
(if (in? (car x) y)
y
(cons (car x) y))
(if (in? (car x) y)
(work (cdr x) y)
(work (cdr x) (cons (car x) y)))))
(define (in? x y)
(if (null? y)
#f
(if (equal? x (car y))
#t
(in? x (cdr y)))))
(define (content x) (work x (list)))
The procedure content accepts a list as a parameter. It sends the list to another procedure called work. This procedure processes the list and adds the items in the list to a new list (if they are not already in the new list). The work procedure makes use of yet another procedure called in, which checks to see if an item is a member of a list.
My solution essentially divides your problem into two sub-problems and makes use of procedures which operate at a lower level of abstraction than your original problem.
Hope that helps.
It is PLT Scheme solution:
(define (is_exists list element)
(cond
[(empty? list) false]
[else
(cond
[(= (first list) element) true]
[else (is_exists (rest list) element)])]))
(define (unique list target)
(cond
[(empty? list) target]
[else
(cond
[(is_exists target (first list)) (unique (rest list) target)]
[else (unique (rest list) (cons (first list) target))])]))
(define (create_unique list)
(unique list empty))
Check it:
> (define my_list (cons '1 (cons '2 (cons '3 (cons '2 (cons '1 empty))))))
> my_list
(list 1 2 3 2 1)
> (create_unique my_list)
(list 3 2 1)
How about little schemer style,
(define (rember-all a lat)
(cond
((null? lat) '())
((eq? a (car lat)) (rember-all a (cdr lat)))
(else (cons (car lat) (rember-all a (cdr lat))))))
(define (content lat)
(cond
((null? lat) '())
(else (cons (car lat)
(content (rember-all (car lat) (cdr lat)))))))
Start from a procedure that simply creates a copy of the passed-in list (very easy to do):
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
To ensure that the output list's elements are unique, we should skip the CONS if the head of REST is already a member of ANS. So we add another condition to do just that:
;;; Create list containing elements of SEQ, discarding duplicates.
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
((member (car rest) ans) ; *new*
(loop ans (cdr rest))) ; *new*
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
The following function takes in a list and returns a new list with only the unique inputs of it's argument using recursion:
(defun uniq (list)
(labels ((next (lst new)
(if (null lst)
new
(if (member (car lst) new)
(next (cdr lst) new)
(next (cdr lst) (cons (car lst) new))))))
(next list ())))
As was mentioned in the comments, common lisp already has this function:
(defun uniq (list)
(remove-duplicates list))
(define (remove-duplicates aloc)
(cond
((empty? aloc) '())
(else (cons (first aloc)
(remove-duplicates
(filter (lambda (x)
(cond
((eq? x (first aloc)) #f)
(else #t)))
(rest aloc)))))))

Resources