How to find if a list consists of ordered perfect squares in scheme? - scheme

I want to return true if the list is a square list, that is, true if the list is of the type '(0 1 4 9 16).
This is what I have (below) but it does check if the list is ordered. That is, my code will return true if a list is '(4 0 1 9 16). How can I modify my code?
(define (squares? lst)
(cond
((null? lst) #t)
((not( integer? (sqrt(car lst)))) #f)
(else (squares? (cdr lst)))))
for a list of the type '(4 0 1 9 16) I am going to obtain true with the above code, but the answer should be false, because my list is not '(0 1 4 9 16). Thanks in advance.

In the true spirit of functional programming, you should attempt to split the problem in smaller parts, and to reuse and combine existing procedures.
Assuming that the list doesn't need to be "complete", we just need to create and invoke one extra procedure that checks if the list is sorted:
(define (square? lst)
(and (all-squares? lst)
(sorted? lst)))
(define (all-squares? lst)
(cond
((null? lst) #t)
((not (integer? (sqrt (car lst)))) #f)
(else (all-squares? (cdr lst)))))
(define (sorted? lst)
(apply <= lst))
Just for fun, we can also rewrite all-squares? taking advantage of existing procedures:
(define (square? lst)
(and (andmap (compose integer? sqrt) lst)
(apply <= lst)))
Anyway, it'll work as expected with either implementation:
(square? '(0 1 4 9 16))
=> #t
(square? '(4 0 1 9 16))
=> #f

You could pass additionally last checked number
(define (squares? lst last-n)
and then check if (car lst) is bigger than last-n
((not (< last-n (car lst)) #f)
Oh, and also, don't forget to pass new last-n to squares?
(else (squares? (cdr lst) (car lst)))
You can define last-n as optional parameter, ie (define (squares? lst . last-n)) but then you have to access value by (car last-n), because all optional parameters are passed joined together as a list.

Related

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.

Sum of all numbers in a list at the top level

I'm new to Scheme and I've spent about a week on this.
Write a Lisp function sumlist which takes a list and returns the sum of all the numbers in the list, at the top level. Thus,
(sumlist '(1 2 (3) (4 a) nil b 5)) should return 1+2+5=8. The numbers 3 and 4 are not at the top level. Use number? to check if a thing is a number."
This is what I have so far. It can recognize whether something is a number or not, but I can't get it to only add up the numbers on the top level.
(define (sumlist lst)
(cond ((null? lst) 0)
((number? lst) lst)
((list? lst)
(+ (sumlist (car lst)) (sumlist (cdr lst))))
(#t 0)))
; no values returned
> (sumlist '(1 2 (3) (4 a) nil b 5))
15
Any help is appreciated.
EDIT: Both Jedi's and Daniel's answers work. Thank you both very much.
I think it can be a bit simpler:
(define (sumlist lst)
(cond
((null? lst) 0)
((number? (car lst)) (+ (car lst) (sumlist (cdr lst))))
(else (sumlist (cdr lst)))))
Since you only care if an element is a number or not, you only have 3 cases.
(define (sumlist lst)
(cond ((null? lst) 0) ;; list is empty, we're done ;;
((number? (car lst)) (+ (car lst) (sumlist (cdr lst)))) ;; the first item is a number, so we add it to the rest
(else (sumlist (cdr lst))) ;; the first item was not a number, we just check the rest of the list
))

Print adjacent duplicates of a list (scheme)

I'm trying to create a function that returns the adjacent duplicates of a list, for example (dups '(1 2 1 1 1 4 4) should return the list (1 4).
This is the code I came up with so far:
(define (dups lst)
(if (equal? (car lst)(car(cdr lst)))
(cons(cdr lst) '())
(dups(cdr lst))))
This function doesn't return all the adjacent duplicates, it only returns the first adjacent duplicates!
How can I fix it so that it returns all the adjacent duplicates of a list?
Thank you.
Once your code finds a duplicate, it stops processing the rest of the list: when the if test is true, it yields (cons (cdr lst) '()). Whether or not it finds a duplicate, it should still be calling dups to process the rest of the list.
Also: if your list has no duplicates, it it going to run into trouble.
Here's a simpler solution than the others posted:
(define (dups lst)
(if (< (length lst) 2)
; No room for duplicates
'()
; Check for duplicate at start
(if (equal? (car lst) (cadr lst))
; Starts w/ a duplicate
(if (or (null? (cddr lst)) ; end of list
(not (equal? (car lst) (caddr lst)))) ; non-matching symbol next
; End of run of duplicates; add to front of what we find next
(cons (car lst) (dups (cdr lst)))
; Othersise keep looking
(dups (cdr lst)))
; No duplicate at start; keep looking
(dups (cdr lst)))))
Basically this boils down to only keeping the elements which are the same as the previous one, but different from the next.
Here's an example implementation using a named let.
(define (adj-dups lst)
(let loop ((lst (reverse (cons (gensym) lst)))
(e-2 (gensym))
(e-1 (gensym))
(acc '()))
(if (null? lst)
acc
(let ((e-0 (car lst)))
(loop (cdr lst)
e-1
e-0
(if (and (eqv? e-2 e-1) (not (eqv? e-1 e-0)))
(cons e-1 acc)
acc))))))
(gensym) comes in handy here because it's a convenient way to initialise the working variables with something that's different from everything else, and filling up the initial list with a dummy element that needs to be added so that we don't miss the last element.
Testing:
> (adj-dups '())
'()
> (adj-dups '(1 1 4 4 1 1))
'(1 4 1)
> (adj-dups '(1 1 1 1 1))
'(1)
> (adj-dups '(1 2 1 1 1 4 4))
'(1 4)
> (adj-dups '(2 3 3 4 4 4 5))
'(3 4)
The most straightforward way I can think of to tackle this is with an internal procedure with an extra variable to keep track what the prior element was and a boolean to track if the element was repeated. You can then do a mutual recurstion between the helper and main function to build the answer one duplicate element at a time.
(define (dups lst)
(define (dups-helper x repeat? L)
(cond ((null? L)
(if repeat?
(list x)
'()))
((equal? x (car L))
(dups-helper x #t (cdr L)))
(else
(if repeat?
(cons x (dups L))
(dups L)))))
(if (null? lst)
'()
(dups-helper (car lst) #f (cdr lst))))
(dups (list 1 1 4 4 5 6 3 3 1))
;Value 43: (1 4 3)

Converting a list to a circular list in Chicken scheme?

In trying to find how to convert such a list, I came across
Scheme streams and circular lists. However, that answer requires features in Racket not available in Chicken scheme. Can Anyone point Me in the direction of how to do this in Chicken scheme instead? Or in a scheme-variant-neutral fashion?
If you can mutate the list, here's a standard way:
(define (make-circular lst)
; helper for finding the last pair in a list
(define (last-pair lst)
(if (null? (cdr lst))
lst
(last-pair (cdr lst))))
; special case: if the list is empty
(cond ((null? lst) '())
(else
; set the last pair to point to the head of the list
(set-cdr! (last-pair lst) lst)
lst)))
Be aware that the above will modify the input list. Other than that, it works as expected:
(make-circular '(1 2 3 4 5))
=> #0=(1 2 3 4 5 . #0#)
(car (cdr (cdr (cdr (cdr (cdr (make-circular '(1 2 3 4 5))))))))
=> 1
It is pretty simple when you use SRFIs:
(use srfi-1)
(define l '(1 2 3 4))
(apply circular-list l)

Resources