How to determine if a list has an even or odd number of atoms - scheme

tScheme novice question:
I need to determine if a list contains an even or odd amount of atoms using recursion. I know the easy way is to get list length and determine if it is even or odd, but I would like to see hows it's done using recursion.
(oddatom
(LIST 'x 'y 'v 'd 'r 'h 'y))
should return #t, while
(oddatom
'((n m) (f p) l (u k p)))
should return #f
appreciate the help.

Here's my version of the solution:
(define (oddatom? lst)
(let recur ((odd #f)
(x lst))
(cond ((null? x) odd)
((pair? x) (recur (recur odd (car x)) (cdr x)))
(else (not odd)))))

I like Chris Jester-Young's answer, but I think it's worth providing a tail-recursive version that maintains its own stack as well. Note that this is an exercise in converting non-tail recursion into tail recursion, which is an imporant technique for some algorithms in Scheme. In this case, though, it's probably not all that important, and the code in Chris Jester-Young's answer does feel much more natural. So take this as an exercise, not necessarily a significant improvement.
The idea here is that the inner function, odd?, takes a list of things, and a value indicating whether an odd number of atoms (other than the empty list) have been seen so far.
(define (oddatom? thing)
(let odd? ((things (list thing))
(result #f))
(cond
;; We're out of things to see. Did we see an odd number of things?
((null? things)
result)
;; Our list of things has the form ((x . y) …), so we recurse on
;; (x y …), with the *same* value for result, since we haven't
;; "seen" x or y yet, we've just "unwrapped" them.
((pair? (car things))
(odd? (cons (caar things) (cons (cdar things) (cdr things))) result))
;; Our list of things has the form (() …), so we recurse on
;; (…), with the *same* value for result, since we haven't "seen" any
;; additional atoms.
((null? (car things))
(odd? (cdr things) result))
;; Our list of things has the form (<atom> …), so we recurse on (…),
;; but with a flipped value for result, since we've seen one more atom.
(else
(odd? (cdr things) (not result))))))
The last two cases could be combined, making the second recursive argument based on the value of (null? (car things)) as:
(define (oddatom? thing)
(let odd? ((things (list thing))
(result #f))
(cond
((null? things)
result)
((pair? (car things))
(odd? (cons (caar things) (cons (cdar things) (cdr things))) result))
(else
(odd? (cdr things) (if (null? (car things))
result
(not result)))))))

I'd go for this:
(define (oddatom lst)
(cond
((null? lst) #f)
((not (pair? lst)) #t)
(else (not (eq? (oddatom (car lst)) (oddatom (cdr lst)))))))
which means:
the empty list is not odd (#f)
an atom is odd (#t)
otherwise, one and only one of the car or the cdr of the list may be odd (exclusive or).
Test cases (in Racket), including improper lists:
(require rackunit)
(check-equal? (oddatom (list 'x 'y 'v 'd 'r 'h 'y)) #t)
(check-equal? (oddatom '((n m) (f p) l (u k p))) #f)
(check-equal? (oddatom '(a (b) c)) #t)
(check-equal? (oddatom (cons 1 2)) #f)
(check-equal? (oddatom 1) #t)
(check-equal? (oddatom '(1 (2 . 3))) #t)

Here is one:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(let ((this? (odd-atom? (car obj)))
(rest? (odd-atom? (cdr obj))))
(or (and (not this?) rest?)
(and (not rest?) this?))))))
or, learning from #uselpa to simplify the 'or this? rest?' logic above, another one:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(not (eq? (odd-atom? (car obj))
(odd-atom? (cdr obj)))))))

If '() is an atom (like it is in CommonLisp where '() is also T), it should be (odd-atom? '(() () ())) is #t:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(let ((this? (or (null? (car obj))
(odd-atom? (car obj))))
(rest? (odd-atom? (cdr obj))))
(not (eq? this? rest?))))))
> (odd-atom? '())
#f
> (odd-atom? '(()))
#t
> (odd-atom? '(() () ()))
#t
> (odd-atom? '(() ()))
#f
> (odd-atom? '(() (a)))
#f
> (odd-atom? '(() (a b)))
#t
> (odd-atom? '((a) (a b)))
#t
> (odd-atom? '((a b) (a b)))
#f
>

Related

Scheme with postfix

Does anyone can help me to deal with the problem?
I tried for many times, but it still has the error information.
This is my code(scheme)
Thanks!!!
(define (postfix l s)
(cond(
((null? l)(car s))
(else (postfix (cdr l) update-s((car s)))))))
(define (update-s x s)
(cond(((number? x) (cons x s))
(else (cons (eval '(x (car s) (cadr s))) (scheme-report-environment 5) (cdr(cdr s)))))))
And this is the error inform:
else: not allowed as an expression in: (else (postfix (cdr l) update-s ((car s) s)))
Next time, don't forget to add a description of your problem (what should this code do?), expected inputs and outputs, and a version of Scheme you use.
You should also use better names for variables (no l, s, x) and describe their meaning and expected type in your question.
If I understand correctly, you were trying to create a calculator which uses reverse Polish/ postfix notation, where:
l is a list of numbers or symbols
s is a stack with results, represented as a list of numbers
x can be a number or symbol representing some function
From (scheme-report-environment 5) I guess you use r5rs Scheme.
Now some of your errors:
you should define update-s before function postfix
your cond has some additional parentheses
if cond has only two branches, you should use if instead
this part (postfix (cdr l) update-s((car s))) should be (postfix (cdr l) (update-s (car l) s)
(cdr(cdr s)) should be (cddr s)
as for eval, I understand why it's here, you were trying to get a function from the symbol, but you should be always careful, as it can also evaluate code provided by user. Consider this example: (postfix '(1 2 (begin (write "foo") +)) '()). Maybe it could be better to don't expect this input: '(1 2 +), but this: (list 1 2 +) and get rid of eval.
The whole code:
(define (update-s object stack)
(if (number? object)
(cons object stack)
(cons ((eval object (scheme-report-environment 5))
(car stack) (cadr stack))
(cddr stack))))
(define (postfix lst stack)
(if (null? lst)
(car stack)
(postfix (cdr lst)
(update-s (car lst) stack))))
Example:
> (postfix '(1 2 +) '())
3
Solution without eval with different input:
(define (update-s object stack)
(if (number? object)
(cons object stack)
(cons (object (car stack) (cadr stack))
(cddr stack))))
(define (postfix lst stack)
(if (null? lst)
(car stack)
(postfix (cdr lst)
(update-s (car lst) stack))))
Example:
> (postfix (list 1 2 +) '())
3

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

Terminate program early and return list

I have a recursive code and need to terminate it when condition is fullfilled. I am capable of display the list when the condition, but then there are another calls on stack that I don't need to process that doesn't let me to return the list.
A variation of Sylwester's solution:
(define (example n)
(call-with-current-continuation
(lambda (return)
(let loop ([n 0])
(if (= n 5) ; done
(return 'the-result)
(loop (+ n 1)))))))
(example 10)
Using the continuation in this way allows one to use an escape continuation instead of a full continuation with call/ec (if your implementation has escape continuations).
The best way to do it is by using an accumulator. Aborting is then just not recursing.
(define (copy-unless-contains-5 lst)
(define (helper lst acc)
(cond
((null? lst) (reverse acc))
((equal? (car lst) 5) #f)
(else (helper (cdr lst) (cons (car lst) acc)))))
(helper lst '()))
If you are recursing with a continuation and that is the optimum way of doing it, then call-with-current-continuation can give you a way to abort waiting continuations and choose what to return.
(define (copy-unless-contains-5 lst)
(call-with-current-continuation
(lambda (abort)
(define (helper lst)
(cond
((null? lst) '())
((equal? (car lst) 5) (abort #f))
(else (cons (car lst) (helper (cdr lst))))))
(helper lst))))
Needless to say this last version is overly complicated. Both work the same:
(copy-unless-contains-5 '(1 2 3 4)) ; ==> (1 2 3 4)
(copy-unless-contains-5 '(1 2 5 3 4)) ; ==> #f

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

Scheme function to remove atoms?

If I have a list like (e q(r))
How would I remove all the atoms and just return (()) ?
Hey, a technique known as tree-recursion is useful for this type of problem.
I agree with the general structure of the Greg's answer, but I think we need to explicitly filter atomic (non-list) values from nested lists.
(define (rem-atoms lst)
(cond
((not (list? lst)) lst)
((null? lst) (list))
(else
(filter
(lambda (a) (list? a))
(cons (rem-atoms (car lst))
(rem-atoms (cdr lst)))))))
(rem-atoms '(f (x y) z () (k ()))) ; --> (() () (()))
(rem-atoms '(f x (y))) ; --> (())
Upon further inspection, a tiny amendment to Greg's good solution also now provides the correct results. Specifically: (not (list? xx)) rather than (not (pair? xx)).
(define (rem-atoms lat)
(cond
((null? lat) lat)
((not (list? (car lat))) (rem-atoms (cdr lat)))
(else
(cons (rem-atoms (car lat))
(rem-atoms (cdr lat)))))))
(rem-atoms '(f (x y) z () (k ()))) ; --> (() () (()))
(rem-atoms '(f x (y))) ; --> (())
Hmm. I think I like this second version the best!
Note, I'm brand new here, but I hope this helps.
(define rem-atoms
(lambda (lat)
(cond
((null? lat) lat)
((not (pair? (car lat))) (rem-atoms (cdr lat)))
(else
(cons (rem-atoms (car lat)) (rem-atoms (cdr lat)))))))
If the list is empty, return the empty list. If it's an atom (or rather, not a list), just eliminate it. If it's a list, call the function recursively on both the car and the cdr of the list.

Resources