How can I convert this recursive solution into an iterative one? - algorithm

I have the following recursive function in Lisp
(defun f (item tree)
(when tree
(if (equal item (car tree)) tree
(if (and (listp (car tree))
(equal item (caar tree)))
(car tree)
(if (cdr tree)
(f item (cdr tree)))))))
This function receives a tree and an item to look for in its immediate leaves. If item is the car of any sublist, then it will return that sublist. That is,
(f 'c '(a b c)) => (c)
(f 'b '(a b c)) => (b c)
(f 'a '((a 1 2) b c)) => (a 1 2)
I've recently been informed that (Emacs Lisp) doesn't do tail recursion optimization, so I've been advised to turn this into a while loop. All of my training in Lisp has been in avoidance of loops like this. (I maintain that they are un-functional, but that's borderline pedantic.) I've made the following attempt for more conformative style:
(defun f (item tree)
(let ((p tree))
(while p
(cond
((equal item (car p)) p)
((and (listp (car p))
(equal item (caar p)))
(car tree))
(t (f item (cdr p))))
(setq p (cdr p)))))
I've shortened the function name for brevity/clarity, but do have a look at where it is being used if you are a power-user of emacs.

Your "iterative" solution is still recursing. It's also not returning the values found in the cond expression.
The following version sets a variable to the found result. Then the loop ends if a result has been found, so it can be returned.
(defun f (item tree)
(let ((p tree)
(result nil))
(while (and p (null result))
(cond ((equal item (car p)) (setq result p))
((and (listp (car p))
(equal item (caar p)))
(setq result (car tree)))
(t (setq p (cdr p)))))
result))

Related

Maintaining list structure when duplicating

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

recursion over list of characters in scheme

I have found a recursive problem in one page that says the following:
If a person enter a string with two consecutive letters that are the same, it should put a 5 between them. For example if I enter "hello"
it should print "hel5lo"
I have done the following program in Scheme:
(define (function listT)
(if (empty? listT)
'()
(begin
(if (eq? (car listT) (car (cdr listT)))
(display 5)
(display (car listT))
)))
(function (cdr listT)))
and tested with:
(function'( 'h 'e 'l 'l 'o))
and the problem I got is
car: contract violation
expected: pair?
given: ()
I suppose that is because at one moment (car (cdr listT)) will face an empty list, have tried with a conditional before, but still with some issues.
Is it possible to do it only using recursion over the list of characters with cdr and car? I mean not with new variables, strings, using reverse or loops?
Any help?
Thanks
This happens when there is only one character left in the list; (cdr listT) will be the empty list '() and the car of the empty list is undefined.
So you either need to check that the cdr isn't empty, for example:
(define (f str)
(let loop ((lst (string->list str)) (res '()))
(if (null? lst)
(list->string (reverse res))
(let ((c (car lst)))
(loop (cdr lst)
(cons c
(if (and (not (null? res)) (char=? c (car res)))
(cons #\5 res)
res)))))))
or, instead of looking one character ahead, turn around your logic and keep track of the last character, which is initialised to some value that will be different in every case (not as elegant as the first solution though IMO):
(define (f str)
(list->string
(let loop ((prev #f) (lst (string->list str)))
(if (null? lst)
'()
(let ((c (car lst)))
(if (equal? c prev)
(cons #\5 (cons c (loop c (cdr lst))))
(cons c (loop c (cdr lst)))))))))
[EDIT alternatively, with an explicit inner procedure:
(define (f str)
(define (inner prev lst)
(if (null? lst)
'()
(let ((c (car lst)))
(if (equal? c prev)
(cons #\5 (cons c (inner c (cdr lst))))
(cons c (inner c (cdr lst)))))))
(list->string (inner #f (string->list str))))
]
Testing:
> (f "hello")
"hel5lo"
> (f "helo")
"helo"
> (f "heloo")
"helo5o"
Side note: don't double quote:
> '('h 'e 'l 'l 'o)
'('h 'e 'l 'l 'o)
> (car '('h 'e 'l 'l 'o))
''h
This is probably not what you expected. Instead:
> '(h e l l o)
'(h e l l o)
> (car '(h e l l o))
'h
or
> (list 'h 'e 'l 'l 'o)
'(h e l l o)
> (car (list 'h 'e 'l 'l 'o))
'h
Also note that these are symbols, whereas, since you start from a string, you want characters:
> (string->list "hello")
'(#\h #\e #\l #\l #\o)
EDIT 2
I see you are still struggling with my answer. Here's a solution that should be as minimal as you requested, I hope this is it:
(define (f lst (prev #f))
(unless (null? lst)
(when (equal? (car lst) prev) (display "5"))
(display (car lst))
(f (cdr lst) (car lst))))
or even
(define (f lst)
(unless (null? lst)
(display (car lst))
(when (and (not (null? (cdr lst))) (equal? (car lst) (cadr lst)))
(display "5"))
(f (cdr lst))))
Testing:
> (f '(h e l l o))
hel5lo
> (f '(h e l o))
helo
> (f '(h e l o o))
helo5o
I have found a solution:
(define (func lisT)
(if (empty? (cdr lisT))
(display (car lisT))
(begin
(if (eq? (car lisT) (car (cdr lisT)))
(begin
(display (car lisT))
(display 5)
)
(display (car lisT))
)
(func (cdr lisT))
)
))
Here's a solution including just one, top-level recursive function:
(define (insert list item)
(if (< (length list) 2) ;; not enough elements to compare?
list ;; then just return the input
(let ((first (car list)) ;; capture the first element,
(second (cadr list)) ;; the second element,
(rest (insert (cdr list) item))) ;; and the recursively processed tail
(cons first ;; construct a list with the first element
(if (eq? first second) ;; compare the first two and return either
(cons item rest) ;; the item before the rest
rest))))) ;; or just the rest
It takes as input a list and an item to be inserted between each two consecutive identical elements. It does not display anything, but rather returns another list with the result of the insertion. For example,
(insert '(1 2 2 3 3 3 2 2 1) 0)
results in
(1 2 0 2 3 0 3 0 3 2 0 2 1)
This hopefully solves your problem and seeds further experimentation.
Here is a straightforward function from a list to a list:
(define (add5s s)
(cond ((null? s) s)
((null? (cdr s)) s)
((equal? (car s) (cadr s)) (cons (car s) (cons 5 (add5s (cdr s)))))
(else (cons (car s) (add5s (cdr s))))
)
)
A list either:
is null
has one element
begins with two equal elements
begins with two unequal elements
A list with a 5 put between consecutive equal elements is respectively:
the list
the list
the first element followed by a 5 followed by the rest of it with a 5 put between consecutive equal elements
the first element followed by the rest of it with a 5 put between consecutive equal elements
A Scheme string is not a list of characters or a list of symbols. If you want to input and output strings then you should use the corresponding string operators. Or write a function that defines this one, calls it with string->list of an input string and outputs list->string of this one's result list. Or a function like this one but that branches on string->list of its input string and outputs list->string of what this one returns.
(It is really not clear what code is to be written. You say "enters a string", but your "tested" code is a function that takes a list as argument, rather than reading from a port. And you say "put a 5" but you print argument list elements or a 5 via display to a port, rather than returning a value of the type of the argument. And you give an example passing an argument that is a list of quoted symbols rather than just symbols let alone characters. (If you want to pass a list of symbols then use '(h e l l o) or (list 'h 'e 'l 'l 'o).) Say exactly what is to be produced, eg, a function with what arguments, return value and effect on ports.)

Scheme removing nested duplicates

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)

Deep-reverse for trees in Scheme (Lisp)

I have a deep reverse for a basic tree data structure in Scheme
(define (deep-reverse t)
(cond ((null? t) '())
((not (pair? t)) t)
(else (cons (deep-reverse (cdr t)) (deep-reverse (car t))))))
(define stree (cons (list 1 2) (list 3 4)))
1 ]=> (deep-reverse stree)
;Value: (((() . 4) . 3) (() . 2) . 1)
I feel like a cleaner, better result would be:
(4 3 (2 1))
Can anyone provide some guidance as to where I'm going wrong in my deep-reverse function? Thank you.
It's better to split the task into simple operations instead of trying to do all at once. What you want to achieve can be described like this: Reverse the current list itself, then deep-reverse all sublists in it (or the other way round, the order of the two steps doesn't really matter. I choose this order because it results in nicer formatting of the source code).
Now, there already is a function in the standard library for simply reversing a list, reverse. So all you need to do is to combine that with the recursion on those elements that are sublists:
(define (deep-reverse t)
(map (lambda (x)
(if (list? x)
(deep-reverse x)
x))
(reverse t)))
Try this:
(define (deep-reverse t)
(let loop ((t t)
(acc '()))
(cond ((null? t) acc)
((not (pair? t)) t)
(else (loop (cdr t)
(cons (loop (car t) '()) acc))))))
Call it like this:
(define stree (cons (list 1 2) (list 3 4)))
(deep-reverse stree)
> (4 3 (2 1))
For creating a reversed list, one technique is to accumulate the answer in a parameter (I usually call it acc). Since we're operating on a list of lists, the recursion has to be called on both the car and the cdr part of the list. Lastly, I'm using a named let as a shorthand for avoiding the creation of an extra function, but the same result could be obtained by defining a helper function with two parameters, the tree and the accumulator:
(define (deep-reverse t)
(aux t '()))
(define (aux t acc)
(cond ((null? t) acc)
((not (pair? t)) t)
(else (aux (cdr t)
(cons (aux (car t) '()) acc)))))
I think it better to reverse a list based on its element count:
an empty list is reverse, a single element list is also reverted, more than 1 element is concatenation of the reverse of tail and head.
(defun deep-reverse (tree)
(cond ((zerop (length tree)) nil)
((and (= 1 (length tree)) (atom (car tree))) tree)
((consp (car tree)) (append (deep-reverse (cdr tree))
(list (deep-reverse (car tree)))))
(t (append (deep-reverse (cdr tree)) (list (car tree))))))
The following worked for me:
(define (deep-reverse tree)
(define (deep-reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (deep-reverse-iter
(cdr items)
(cons (deep-reverse (car items)) acc)))))
(deep-reverse-iter tree ()))
(define x (list (list 1 2) (list 3 4 (list 5 6))))
(newline)
(display (deep-reverse x))
It prints (((6 5) 4 3) (2 1)) as expected and uses the minimum of standard library functions: pair? to check if the tree is a cons and null? to check for an empty tree/list.
This solution for trees is a generalization of the reverse function for lists:
(define (reverse items)
(define (reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (reverse-iter (cdr items) (cons (car items) acc)))))
(reverse-iter items ()))
the difference being that deep-reverse is also applied to car items

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