Converting a list to a circular list in Chicken scheme? - 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)

Related

scheme function to filter a list

Write a scheme function that returns a list containing all elements of a given
list that satisfy a given predicate eg. (lambda (x) (< x 5)) '(3 9 5 8 2 4 7) => '(3 2 4)
Any hints how to begin about this ?
Basically you are creating filter.
(define (filter included? lst)
...)
You need to check if the argument has elements and if the first element is to be included or not. Including would involve cons-ing the first element to the recursing with the cdr with the same predicate while not including would not include consing but the exact same thing as the tail in a conse situation.
(filter odd? '(3 4))
; ==> (cons 3 (filter odd? '(4)))
(filter odd? '(4))
; ==> (filter odd? '())
(filter odd? '())
; ==> '()
Putting them together shows that (filter odd? '(3 4)) should produce the result of (cons 3 '())
Here is a skeleton of what I would have done:
(define (filter included? lst)
(cond ((null? lst) <??>)
((included? (car lst)) <??>) ; since it is not null? it has to have at least one element
(else <??>))) ; neither null? nor included? => skip

How to find if a list consists of ordered perfect squares in 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.

Can't get the end list i want in swapping procedure

Ultimately, i shall be trying to reimplement sorting algorithms in scheme for linked lists. I have written a subprocedure that will help me along the way. The goal is to simply swap 2 elements, given as arguments "pair1 and pair2" and then return the list.
(define (cons-til lst until)
(cond
((or (null? lst) (eq? (car lst) until)) '())
(else (cons (car lst) (cons-til (cdr lst) until)))))
(define (swap lst pair1 pair2)
(cons (cons (append (cons-til lst (car pair1))
(car pair2)) (car pair1)) (cdr pair2)))
(define my-list '(1 2 3 4 5 6 7))
(swap my-list (cdr (cdr my-list)) (cdr (cdr (cdr my-list))))
When the code is executed, it returns:
(((1 2 . 4) . 3) 5 6 7)
How can i fix this in order to have a plain scheme list. The element seems to have swapped correctly.
Two suggestions:
Do you really want to write n cdr calls to index the nth element? I recommend strongly using integer indexes (if you need them, that is).
Referring to elements by index in a linked list (i. e. “random access”) is not very efficient most of the time, especially when done in loops. I strongly recommend using either vectors or a better suited algorithm that doesn't need random access, e. g. merge sort.
(define (swap2 lst pair1 pair2)
(append (append (append (cons-til lst (car pair1))
(list (car pair2)))
(list (car pair1))) (cdr pair2)))
This code seems to work. I'm not sure this is completely efficient or a smart solution to the problem. Looking forward to other suggestions. The value given back is '(1 2 4 3 5 6 7)

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)

delete-doubles function (scheme)

(define (delete-doubles lst)
(cond ((null? lst) '())
((null? (cdr lst)) (car lst))
((equal? (car lst) (cadr lst)) (delete-doubles (cdr lst)))
(else (cons (car lst) (delete-doubles (cdr lst))))))
This is the code I made. It is meant for deleting an element in a list when this element shows up two or more times after each other. The code works totally fine, apart from this:
> (delete-doubles '(1 2 2 3 4 5))
(1 2 3 4 . 5)
I'd like to remove the . , and I know it has something to do with the cons, but I don't know how to solve it.
Thanks in advance.
'(1 2 3) really means (cons 1 (cons 2 (cons 3 null)))
'(1 2 . 3) really means (cons 1 (cons 2 3)
A couple of good test cases should reveal the problem quickly. In general, you should start with the absolute smallest test case you can think of. Then the next smallest. Then go up from there. Don't jump straight to a big example.
when the cdr is null you are just returning the car, and in the else line you are doing cons on car and recursion on cdr. So that is where your pair is coming from. Does that help?
I ran your code unchanged and got this:
> (delete-doubles '(1))
1
The intended output is (1).
This implies that you are returning the wrong value in
the list-is-one-element-long-clause.
If the list has one element, then it is already without doubles.
That is, you must return lst and not (car lst) in this case.

Resources