Scheme function for adding elements in nested list [duplicate] - scheme

This question already has an answer here:
scheme recursion
(1 answer)
Closed 5 months ago.
I'm trying to create a scheme program that adds the elements of a given list (both simple and nested).
(define (adder a_list)
(cond
((null? a_list) 0)
((list? (car a_list))(adder (car a_list)))
(else (+ (car a_list) (adder (cdr a_list))))
)
)
(adder '(2 (5 4) 6))```
The problem I'm running into is that when I run this, it only adds (5+4) + 2, and then doesn't add the 6. So my output is 11 rather than 17. I know my null statement at the top is causing this issue, but when I take it out I get this error:
car: contract violation
expected: pair?
given: '()
Any tips would be greatly appreciated.

(define (adder a*)
(if (null? a*)
0
(+ (if (pair? (car a*))
(adder (car a*))
(car a*))
(adder (cdr a*)))))
And, shorter:
(define ++
(lambda (a*)
(fold-left (lambda (a x)
(+ a (if (pair? x) (++ x) x)))
0
a*)))
(written in mit/scheme)

Related

Why might the Scheme `filter` form not process list elements 'in order'?

(filter procedure list) applies procedure to each element of list
and returns a new list containing only the elements for which procedure
returns true.
(R. Kent Dybvig The Scheme Programming Language)
(online)
What may not be apparent from this description is that, while the elements in the returned
list occur in the same order as in list, the order of calls of procedure is not
specified in R6RS. (Racket, however, applies the procedure "to each element from first to last")
A recently active answer
mentions that it requires a filterfunc which works over its argument list
in order. How should one write this function?
An answer with my explanation of the issue is supplied.
What order might a Scheme implementation use, and why? Let's try it (all code run in Chez Scheme REPL):
Display order of applications
> (filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
452301(0 2 4)
>
Why this order?
R6RS implementations must check that list is a proper list
ends with the empty list:
> (filter (lambda (x) (display x) (even? x))
'(0 1 2 . 3)))
Exception in filter: (0 1 2 . 3) is not a proper list
>
no circularity:
> (define xs '(0 1 2 3))
> (set-cdr! (cdddr xs) (cdr xs))
> (filter (lambda (x) (display x) (even? x)) xs)
Exception in filter: (0 1 2 3 1 2 ...) is not a proper list
>
the implementation of filter in Chez Scheme which checks these requirements
while filtering, resulting in the "452301" order of predicate applications,
can be seen here
(lines 589-617: a version is included as a spoiler below as an alternative to scrolling through
the source on github)
What?
The Chez Scheme code uses a "tortoise and hare" algorithm
to detect cycles. Without error checks the code could be:
> (let ([filter
(lambda (pred? ls)
(let f ([fast ls])
(if (pair? fast)
(let ([rest (f (cdr fast))])
(if (pred? (car fast))
(cons (car fast) rest)
rest))
'())))])
(filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
543210(0 2 4)
>
(the identifier fast is used to match the Chez Scheme code: could be ls otherwise)
How can one change this to call pred? "from first to last"?
replace the rest variable with an accumulator (compare the following with 3 above;
the changes are small, but filtered elements are consed to acc,
so it has to be reversed to give the result):
> (let ([filter
(lambda (pred? ls)
(let f ([fast ls] [acc '()])
(if (pair? fast)
(f (cdr fast)
(if (pred? (car fast))
(cons (car fast) acc)
acc))
(reverse acc))))])
(filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
012345(0 2 4)
>
So 4 could be used as the required filterfunc. It would be an interesting exercise
to add error checks like the Chez Scheme implementation, which is effectively:
(define (filter pred? ls)
(unless (procedure? pred?)
(error #f "not a procedure" pred?))
(or (let f ((pred? pred?) (fast ls) (slow ls))
(if (pair? fast)
(let ((fast1 (cdr fast)))
(if (pair? fast1)
(and (not (eq? fast1 slow))
(let ((fast2 (cdr fast1)))
(let ((rest (f pred? fast2 (cdr slow))))
(and rest
(if (pred? (car fast))
(if (pred? (car fast1))
(if (eq? rest fast2)
fast
(list* (car fast)
(car fast1) rest))
(cons (car fast) rest))
(if (pred? (car fast1))
(if (eq? rest fast2)
fast1
(cons (car fast1) rest))
rest))))))
(and (null? fast1)
(if (pred? (car fast))
fast
'()))))
(and (null? fast) '())))
(error #f "circular/improper list" ls)))
It involves you should not use mutation of some external variable inside procedure and it supposes the implementation may apply parallelism, for example map-reduce.

How to find the mean of a list with mixed symbols (numbers and characters) in scheme?

Given a list of the type '('a 1 'b 2 'c 3) I want to calculate the mean of the numbers in the list.
This is what I have done so far: I have written 3 functions that work correctly, one to remove the characters, the other to calculate the sum of the numbers in a list, and the other to find the average. But I do not know how to put them together to solve my problem.
;remove all non numbers from a list:
(define (all-numbers x)
(cond ((null? x) null)
((integer? (car x)) (cons (car x) (all-numbers (cdr x))))
(else (all-numbers (cdr x)))))
;sum the elements of the list
(define (sumlist lst)
(cond ((null? lst) 0)
(( + (car lst) (sumlist (cdr lst))))))
; find the mean of the list
(define (a_mean lst)
(cond ((null? lst) 0)
((/ (sumlist lst) (length lst)))))
(a_mean '(1 2 3))
;find the mean of a mixed list
(define (m_mean lst)
(cond ((null? lst) 0)
((/ (sumlist ((all-numbers lst)) (length (all-numbers lst)))))))
(m_mean '('a 1 'b 2 'c 3))
I get an error in the above code for m_mean. Please help! Thanks.
The answer by Óscar López should fix your problems.
I will now provide a more concise way of solving the same problem:
(define (m-mean lst)
(define all-numbers (filter number? lst)) ; Filter out all the non-numbers.
(if (null? all-numbers)
0 ; The mean is 0 if there are no numbers.
(/ (apply + all-numbers) (length all-numbers)))) ; Calculate mean.
This way, you do not have to explicitly define the all-numbers and sumlist functions.
For starters, some of your cond expressions are missing the else keyword in the final condition - this is mandatory, as you did in all-numbers. Also, in m_mean there are a couple of incorrect brackets; this should fix the errors:
(define (m_mean lst)
(cond ((null? lst) 0)
(else (/ (sumlist (all-numbers lst))
(length (all-numbers lst))))))
Now it works as expected:
(m_mean '(a 1 b 2 c 3))
=> 2

Scheme, can someone explain how I'm using set-car! wrong?

I wanted to make a procedure that destructively increments the odd numbers of a list. I thought I'd recurse through it and just use 'set-car!' whenever 'odd?' was true.
Here is the code:
(define (test lst)
(cond ((null? lst) lst)
((odd? (car lst)) (set-car! lst (+ (car lst) 1))
(test (cdr lst)))
(else (test (cdr lst)))))
I'm not sure why it is not working, I guess I do not understand set-car! and set-cdr!
Could someone explain? Thank you.
The problem might be with your interpreter, or the language in which you're defining the procedure, or the way you're calling it. For instance, in DrRacket this works fine:
#lang r5rs
(define (test lst)
(cond ((null? lst) lst) ; this is the '() returned by the recursion
((odd? (car lst)) (set-car! lst (+ (car lst) 1))
(test (cdr lst)))
(else (test (cdr lst)))))
Bear in mind that your procedure will return an empty list, because that's the base case of the recursion and this is a tail-recursive procedure, which returns the value at the base case as its final result. But don't worry, the input list was modified in-place, you can check it after the procedure returns its value.
(define lst (list 1 2 3 4))
(display (test lst))
=> ()
(display lst)
=> (2 2 4 4)
See how mutability is confusing? a procedure is returning one value, but its input was modified and has a different value now. That's one of the reasons why functional programming (which favors immutable data) is cleaner and simpler to understand, and also demonstrates why is a bad idea to mutate input parameters inside a procedure ;)
If you absolutely want the procedure to return the mutated list, do as #sepp2k suggests, but remember - the input list was modified and in fact, is the same list that is returned as a result:
(define (test lst)
(cond ((null? lst) lst)
((odd? (car lst)) (set-car! lst (+ (car lst) 1))
(test (cdr lst))
lst) ; add this line
(else (test (cdr lst)))))
See for yourself:
(define lst (list 1 2 3 4))
(display (test lst))
=> (2 2 4 4)
(display lst)
=> (2 2 4 4)
was expecting the have the list containing (2 2 4 4) returned
The way you defined your function, it will return an empty list when called on the empty list and the result of the recursion in all other cases. So since the only base case is the empty list, you'll always return the empty list.
If you want to return the modified list, you'll need to do that after the recursion. That is after (test (cdr lst)), add lst to return the value of lst.
You are using set-car! correct. Here is how you tell it's working:
(define (test lst)
(cond ((null? lst) lst)
((odd? (car lst)) (set-car! lst (+ (car lst) 1))
(test (cdr lst)))
(else (test (cdr lst)))))
(define test-list (list 1 2 3 4))
(test test-list)
test-list ; ==> (2 2 4 4)
Your expectation that the function will return the modified list is wrong. To do that you need the first recursion step to return the argument. You need to wrap it:
(define (inc-odds lst)
(define (test lst)
(cond ((null? lst) lst)
((odd? (car lst)) (set-car! lst (+ (car lst) 1))
(test (cdr lst)))
(else (test (cdr lst)))))
(inc-odds lst) ; do the stuff
lst) ; return the list
(inc-odds (list 1 2 3 4)) ; ==> (2 2 4 4)
(inc-odds '(1 2 3 4)) ; ==> "pigs flying"
Notice the last one. In the RNRS upto R5RS passing a quoted literal to set-car! would produce an undefined behaviour which means anything is ok because technically the code isn't Scheme. In R6RS it's required to raise an exception.

Reversed output in tail recursion

(define (sqr-tail lst)
(define (helper lst res)
(if (null? lst)
res
(cond ((list? (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
result)))
(else (helper (cdr lst)
(cons (expt (car lst) 2) res))))))
(helper lst ()))
I have this tail recursion function in scheme which sqr every element in the list, but unfortunately the result is reversed to what I suppose to output.
for input :
> (sqr-tail (list 1 2 4 3 (list 1 2 (list 1)) 3 3))
the output :
< (9 9 ((1) 4 1) 9 16 4 1)
thanks.
This is something that is inherent in the way Lisp/Scheme lists work: because there are only really conses, the way to build up lists is backwards. So the common tail-recursive-loop-with-an-accumulator approach as you've used ends up building the result backwards. The simple answer to this is that you need to reverse the result when you return it, and in your case, since you are recursing (not tail-recursing) into nested lists as well you need to reverse them as well of course.
Here is a somewhat cleaned-up and error-protected version of your original function (note this was written in Racket -- it may not be quite legal Scheme, but it is close):
(define (square-nested-list/reversed l)
(define (snl-loop lt accum)
(cond [(null? lt)
accum]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
So to get the result forwards we need to reverse the accumulator when we return it. This is a very small change to the above function:
(define (square-nested-list/forward l)
(define (snl-loop lt accum)
(cond [(null? lt)
(reverse accum)]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
If you want to be annoyingly clever and purist you can now notice that the tail-recursive-loop-with-accumulator approach produces results in reverse, so the trivial case of it is, in fact, reverse:
(define (square-nested-list/forward/stupidly-purist l)
(define (rev l)
(define (rev-loop lt a)
(if (null? lt) a (rev-loop (cdr lt) (cons (car lt) a))))
(rev-loop l '()))
(define (snl-loop lt accum)
(cond [(null? lt)
(rev accum)]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
People who do this are generally just trying to score points on the internet though (there are even more stupidly pure approaches for which you get more points).
And here are the results of calling those three functions:
> (define test-data '((1 2 3) (4 5) 6))
> (displayln (square-nested-list/reversed test-data))
(36 (25 16) (9 4 1))
> (displayln (square-nested-list/forward test-data))
((1 4 9) (16 25) 36)
> (displayln (square-nested-list/forward/stupidly-purist test-data))
((1 4 9) (16 25) 36)
Some other approaches
One issue with this 'reverse the result' is that it involves walking the result to reverse it, and also making a copy of it. Once upon a time this was something that was a real problem, because machines had only a tiny amount of memory and were very slow. Indeed, if your lists are enormous it still is a problem. More commonly it is a problem which exists in the minds of people who either, like me, remember machines which were very slow and had only tiny memory, or whose minds have been damaged by languages which encourage you to behave as if you were using such machines ('C programmers know the cost of everything but the value of nothing').
One partial answer to this problem offered by older Lisps is a function which is like reverse but works destructively: it reverses a list in place, destroying the original structure. This function is called nreverse in Common Lisp. If it existed in Scheme it would be called reverse! I suppose.
A more complete answer is to build the list forwards in the first place. You do this by trickery involving keeping a reference to the final cons of the list, and repeatedly replacing its cdr with a new final cons whose car is the object you are collecting. If you want to do this without your code looking horrible you need to use a macro: the one I wrote (for Common Lisp, not Scheme) was called collecting as it collected lists forwards. There are many others. Note that this approach requires mutable conses and also is not clearly efficient in the presence of modern garbage collectors.
Macros like collecting still have their place I think: not because they make your code faster, but because they can make it clearer: if you want collect some results into a list, then do that, don't do this weird reversing thing.
You are almost there.
All you need to do is reverse the return value for each sublist:
(defun sqr-tail (lst)
(labels ((helper (lst res)
(cond ((null lst)
(reverse res))
((listp (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
res)))
(t (helper (cdr lst)
(cons (expt (car lst) 2) res))))))
(helper lst ())))
(sqr-tail (list 1 2 4 3 (list 1 2 (list 1)) 3 3))
==> (1 4 16 9 (1 4 (1)) 9 9)
or, in scheme:
(define (sqr-tail lst)
(define (helper lst res)
(cond ((null? lst)
(reverse res))
((list? (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
res)))
(else (helper (cdr lst)
(cons (expt (car lst) 2) res)))))
(helper 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

Resources