Is there a built-in procedure to check if a list is cyclic in Scheme (R5RS)? And when is a list cyclic (per definition)? I have tried to find some procedure that checks this, and how it is implemented, but I haven't been able to find one.
A list is circular per definition if the cdr of the tail (last element) points to the head of the list. However, you can also have a circular list where the cdr of the tail points to an arbitrary element in the list. A good algorithm to detect a circular list is the tortoise and hare algorithm. An example implementation is given at this page.
The code is as follows (credit to the author of the page linked above):
Edit: I modified the code because it contained an error pointed out by Sylwester.
(define (has-cycle-h slow-ls fast-ls)
(cond
((null? fast-ls) #f)
((null? (cdr fast-ls)) #f)
((eq? slow-ls fast-ls) #t)
(else (has-cycle-h (cdr slow-ls) (cddr fast-ls)))))
(define (has-cycle? ls)
(cond
((null? ls) #f)
(else (has-cycle-h ls (cdr ls)))))
;; Create cyclic list
(define l (cons 1 (cons 2 (cons 3 (cons 4 '())))))
(set-cdr! (cdr (cdr (cdr l))) l)
;; Results in:
;+---+ +---+ +---+ +---+
;| 1 +--->| 2 +-->| 3 +--->| 4 |
;+-+-+ +---+ +---+ +-+-+
; ^ |
; | |
; +-------------------------+
(has-cycle? l) ; Evaluates to #t
;; Create list
(define l (cons 1 (cons 2 (cons 3 (cons 4 '())))))
;; Make it circular by pointing the tail to the second element.
(set-cdr! (cdr (cdr (cdr l))) (cdr l))
;; Results in:
;+---+ +---+ +---+ +---+
;| 1 +--->| 2 +-->| 3 +--->| 4 |
;+---+ +-+-+ +---+ +-+-+
; ^ |
; | |
; +----------------+
(has-cycle? l) ; Evaluatores to #t
; Regular list
(has-cycle? '(1 1 1 1 1 1 1)) ; Evaluates to #f
There is no BIF for detecting a circular list.
There is circular-list? predicate in SRFI 1. The definition of circular list in SRFI 1 is: "A circular list is a value such that for every n>=0, cdr^n(x) is a pair." It means that there is no end of the list. The first pair of the circular list does not need to be part of a cycle. It is enough that one eventually by following the cdrs reaches a cycle.
SRFI 1 has this description on non-circular lists:
(not (circular-list? x)) = (or (proper-list? x) (dotted-list? x))
SRFI 1 is not in R5RS per se, but all implementations I know of come with srfi 1 included. Note that if srfi1 is implemented in the runtime, the circular-list? predicate from srfi 1 could be faster than a Scheme implementation of the tortoise-and-hare algorithm. Benchmark your implementation of choice to find out how your implementation behaves.
http://srfi.schemers.org/srfi-1/srfi-1.html#circular-list-p
Related
I have a circular list, eg: #0=(1 2 3 4 . #0#).
What I want to do is to insert a new element (x) into this list so that the outcome is #0=(x 1 2 3 4 . #0#). I have been trying using this code (x is the circular list):
(define (insert! elm)
(let ((temp x))
(set-car! x elm)
(set-cdr! x temp)))
However, I think that set-cdr! is not working like I want it to. What am I missing here? Maybe I am way off?
The easiest way to prepend an element to a list is to modify the car of the list, and set the cdr of the list to a new cons whose car is the original first element of the list and whose cdr is the original tail of the list:
(define (prepend! x list) ; list = (a . (b ...))
(set-cdr! list (cons (car list) (cdr list))) ; list = (a . (a . (b ...)))
(set-car! list x)) ; list = (x . (a . (b ...)))
(let ((l (list 1 2 3)))
(prepend! 'x l)
(display l))
;=> (x 1 2 3)
Now, that will still work with circular lists, because the cons cell (i.e., pair) that is the beginning of the list remains the same, so the "final" cdr will still point back to object that is the beginning. To test this, though, we need some functions to create and sample from circular lists, since they're not included in the language (as far as I know).
(define (make-circular list)
(let loop ((tail list))
(cond
((null? (cdr tail))
(set-cdr! tail list)
list)
(else
(loop (cdr tail))))))
(define (take n list)
(if (= n 0)
'()
(cons (car list)
(take (- n 1)
(cdr list)))))
(display (take 10 (make-circular (list 1 2 3))))
;=> (1 2 3 1 2 3 1 2 3 1)
Now we can check what happens if we prepend to a circular list:
(let ((l (make-circular (list 1 2 3))))
(prepend! 'x l)
(display (take 15 l)))
;=> (x 1 2 3 x 1 2 3 x 1 2 3 x 1 2)
Since you're trying to prepend an element to a circular list, you need to do two things:
Insert a new cons cell at the front of the list containing the additional element. This is easy because you can just perform a simple (cons elm x).
You also need to modify the recursive portion of the circular list to point at the newly created cons cell, otherwise the circular portion will only include the old parts of the list.
To perform the latter, you need a way to figure out where the "end" of the circular list is. This doesn't actually exist, since the list is, of course, circular, but it can be determined by performing an eq? check on each element of the list until it finds an element equal to the head of the list.
Creating a helper function to do this, a simple implementation of insert! would look like this:
(define (find-cdr v lst)
(if (eq? v (cdr lst)) lst
(find-cdr v (cdr lst))))
(define (insert! elm)
(set! x (cons elm x))
(set-cdr! (find-cdr (cdr x) (cdr x)) x))
I was wondering, if I was given a list such as:
(list 3 6 9 2 1 0 5 9)
and I wanted to produce only the first 5. i.e.: I want to produce:
(list 3 6 9 2 1)
How could I go about doing this. By the way, recursion is not allowed, and the language is intermediate student. Thanks :)
Actually a lis like (1 2 3 4) is a chain of pairs (1 . (2 . (3 . (4 . ())))). You cannot reuse the pairs since you need the 5th pair to point to () (null) instead of the rest of the pair chain. The only way to do this is to make a new pair for each element you'd like by using the same car elements in each.
(define (take lst cnt)
(if (zero? cnt) ; if you ask for zero element
'() ; then return empty list
(cons (car lst) ; else make a pair with first element
(take (cdr lst) ; and result from take with the rest of the list
(- cnt 1))))) ; with one less element than you originally asked for
If memory serves, in addition to car and cdr, Scheme supplies caar, caaar, caaaar and the equivalent repeated ds and the various combinations and permutations. So one solution would be:
(define x (list 3 6 9 2 1 0 5 9))
(list (car x) (cadr x) (caddr x) (cadddr x) (car (cddddr x)))
(and I'm sure that's why you were asked for the first five; there's no cdddddr — the teaching point was likely the permitted repetition of ds and as and the limit to which you can go with those)
I do not know why you would want to do this, but one way to avoid recursion is to unroll the loop:
(define (take1 xs) (cons (car xs) '()))
(define (take2 xs)
(cons (car xs) (take1 (cdr xs))))
(define (take3 xs)
(cons (car xs) (take2 (cdr xs))))
(define (take4 xs)
(cons (car xs) (take3 (cdr xs))))
(define (take5 xs)
(cons (car xs) (take4 (cdr xs))))
Greeting everyone. I'm trying to write an algorithm in Racket but I'm faced with a problem:
I'm studying way of generating different types of grids over surfaces, using a CAD software as a backend for Racket. Basically I have a function that generates a matrix of point coordinates (in the u and v domains) of a parametric surface and another one which connects those points with a line, in a certain order, to create the grid pattern. The problem is, to obtain more complex grids I need to be able to remove certain points from that matrix.
With that said, I have a list of data (points in my case) and I want to remove items from that list based on a true-false-false-true pattern. For example, given the list '(0 1 2 3 4 5 6 7 8 9 10) the algorithm would keep the first element, remove the next two, keep the third and then iterate the same patter for the rest of the list, returning as the final result the list '(0 3 4 7 8).
Any suggestions? Thank you.
Using Racket's for loops:
(define (pattern-filter pat lst)
(reverse
(for/fold ((res null)) ((p (in-cycle pat)) (e (in-list lst)))
(if p (cons e res) res))))
testing
> (pattern-filter '(#t #f #f #t) '(0 1 2 3 4 5 6 7 8 9 10))
'(0 3 4 7 8)
A solution using list functions in SRFI-1:
#!racket
(require srfi/1)
(define (pattern-filter pat lst)
(fold-right (λ (p e acc) (if p (cons e acc) acc))
'()
(apply circular-list pat)
lst))
(pattern-filter '(#t #f #f #t)
'(0 1 2 3 4 5 6 7 8 9 10)) ; ==> '(0 3 4 7 8)
There are other ways but it won't become easier to read.
In Racket I would probably use match to express the specific pattern you described:
#lang racket
(define (f xs)
(match xs
[(list* a _ _ d more) (list* a d (f more))]
[(cons a _) (list a)]
[_ (list)]))
(require rackunit)
;; Your example:
(check-equal? (f '(0 1 2 3 4 5 6 7 8 9 10)) '(0 3 4 7 8))
;; Other tests:
(check-equal? (f '()) '())
(check-equal? (f '(0)) '(0))
(check-equal? (f '(0 1)) '(0))
(check-equal? (f '(0 1 2)) '(0))
(check-equal? (f '(0 1 2 3)) '(0 3))
(check-equal? (f '(0 1 2 3 4)) '(0 3 4))
However I also like (and upvoted) both usepla's and Sylwester's answers because they generalize the pattern.
Update: My original example used (list a _ _ d more ...) and (list a _ ...) match patterns. But that's slow! Instead use (list* a _ _ d more) and (cons a _), respectively. That expands to the sort of fast code you'd write manually with cond and list primitives.
The question is tagged with both scheme and racket, so it's probably not a bad idea to have an implementation that works in Scheme in addition to the versions that work for Racket given in some of the other answers. This uses the same type of approach that's seen in some of those other answers: create an infinite repetition of your boolean pattern and iterate down it and the input list, keeping the elements where your pattern is true.
Here's a method that takes a list of elements and a list of #t and #f, and returns a list of the elements that were at the same position as #t in the pattern. It ends whenever elements or pattern has no more elements.
(define (keep elements pattern)
;; Simple implementation, non-tail recursive
(if (or (null? elements)
(null? pattern))
'()
(let ((tail (keep (cdr elements) (cdr pattern))))
(if (car pattern)
(cons (car elements) tail)
tail))))
(define (keep elements pattern)
;; Tail recursive version with accumulator and final reverse
(let keep ((elements elements)
(pattern pattern)
(result '()))
(if (or (null? elements)
(null? pattern))
(reverse result)
(keep (cdr elements)
(cdr pattern)
(if (car pattern)
(cons (car elements) result)
result)))))
To get an appropriate repeating pattern, we can create a circular list of the form (#t #f #f #t …) we can create a list (#t #f #f #t) and then destructively concatenate it with itself using nconc. (I called it nconc because I've got a Common Lisp background. In Scheme, it's probably more idiomatic to call it append!.)
(define (nconc x y)
(if (null? x) y
(let advance ((tail x))
(cond
((null? (cdr tail))
(set-cdr! tail y)
x)
(else
(advance (cdr tail)))))))
(let ((a (list 1 2 3)))
(nconc a a))
;=> #0=(1 2 3 . #0#)
Thus, we have a solution:
(let ((patt (list #t #f #f #t)))
(keep '(0 1 2 3 4 5 6 7 8 9 0) (nconc patt patt)))
;=> (0 3 4 7 8)
For my programming languages class I'm supposed to write a function in Scheme to reverse a list without using the pre-made reverse function. So far what I got was
(define (reverseList lst)
(COND
((NULL? lst) '())
(ELSE (CONS (reverseList(CDR lst)) (CAR lst)))
))
The problem I'm having is that if I input a list, lets say (a b c) it gives me (((() . c) . b) . a).
How am I supposed to get a clean list without multiple sets of parenthesis and the .'s?
The problem with your implementation is that cons isn't receiving a list as its second parameter, so the answer you're building isn't a proper list, remember: a proper list is constructed by consing an element with a list, and the last list is empty.
One possible workaround for this is to use a helper function that builds the answer in an accumulator parameter, consing the elements in reverse - incidentally, this solution is tail recursive:
(define (reverse lst)
(reverse-helper lst '()))
(define (reverse-helper lst acc)
(if (null? lst)
acc
(reverse-helper (cdr lst) (cons (car lst) acc))))
(reverse '(1 2 3 4 5))
=> '(5 4 3 2 1)
You are half way there. The order of the elements in your result is correct, only the structure needs fixing.
What you want is to perform this transformation:
(((() . c) . b) . a) ; input
--------------------
(((() . c) . b) . a) () ; trans-
((() . c) . b) (a) ; for-
(() . c) (b a) ; mation
() (c b a) ; steps
--------------------
(c b a) ; result
This is easy to code. The car and cdr of the interim value are immediately available to us. At each step, the next interim-result is constructed by (cons (cdr interim-value) interim-result), and interim-result starts up as an empty list, because this is what we construct here - a list:
(define (transform-rev input)
(let step ( (interim-value input) ; initial set-up of
(interim-result '() ) ) ; the two loop variables
(if (null? interim-value)
interim-result ; return it in the end, or else
(step (car interim-value) ; go on with the next interim value
(cons ; and the next interim result
(... what goes here? ...)
interim-result )))))
interim-result serves as an accumulator. This is what's known as "accumulator technique". step represents a loop's step coded with "named-let" syntax.
So overall reverse is
(define (my-reverse lst)
(transform-rev
(reverseList lst)))
Can you tweak transform-rev so that it is able to accept the original list as an input, and thus skip the reverseList call? You only need to change the data-access parts, i.e. how you get the next interim value, and what you add into the interim result.
(define (my-reverse L)
(fold cons '() L)) ;;left fold
Step through the list and keep appending the car of the list to the recursive call.
(define (reverseList lst)
(COND
((NULL? lst) '())
(ELSE (APPEND (reverseList(CDR lst)) (LIST (CAR lst))))
))
Instead of using cons, try append
(define (reverseList lst)
(if (null? lst)
'()
(append (reverseList (cdr lst)) (list (car lst)) )
)
)
a sample run would be:
1]=> (reverseList '(a b c 1 2 + -))
>>> (- + 2 1 c b a)
car will give you just one symbol but cdr a list
Always make sure that you provide append with two lists.
If you don't give two lists to the cons it will give you dotted pair (a . b) rather than a list.
See Pairs and Lists for more information.
I was wondering how to reverse a list using only basic operations such as cons, first, rest, empty?, etc.
No helper functions or accumulators allowed, and the function only takes one input - a list.
I was told it was possible, though I can't wrap my head around it.
This is what I have conceptualized so far. I don't know how to form the recursion for the rest of the list.
(defunc rev-list (x)
(if (or (equal (len x) 0) (equal (len x) 1))
x
(cons (first (rev-list (rest x)))
???)))
Apparently it is possible to do something similar with a function that swaps the first and last of a list, though I don't fully understand it either. Here is the code for it:
(define swap-ends (x)
(if (or (equal (len x) 0) (equal (len x) 1))
x
(cons (first (swap-ends (rest x)))
(swap-ends (cons (first x)
(rest (swap-ends (rest x))))))))
(note: the answer is at the bottom of this post) The 2nd function,
(define (swap-ends x) ; swap [] = []
(if (or (equal (length x) 0) (equal (length x) 1)) ; swap [x] = [x]
x ; swap (x:xs)
(cons (first (swap-ends (rest x))) ; | (a:b) <- swap xs
(swap-ends (cons (first x) ; = a : swap (x : b)
(rest (swap-ends (rest x))))))))
(with Haskell translation in the comments) what does it do, you ask? The data flow diagram for if's alternative clause is
/-> first ----------------------> cons
x --> first ------/-------------> cons --> swap --/
\-> rest -> swap ---> rest ---/
(follow the arrows from left to right). So,
[] -> []
[1] -> [1]
/-> 2 -----------------------> [2,1]
[1,2] --> 1 --------/------------> [1] --> [1] --/
\-> [2] -> [2] ---> [] ---/
/-> 3 -------------------------> [3,2,1]
[1,2,3] --> 1 ------------/----------> [1,2] --> [2,1] --/
\-> [2,3] -> [3,2] -> [2] --/
/-----> 4 ----------------------------> [4,2,3,1]
[1,2,3,4] --> 1 ------------/---------------> [1,3,2] -> [2,3,1] -/
\-> [2,3,4] -> [4,3,2] -> [3,2] -/
So far it indeed does swap the end elements of a list. Let's prove it by the natural induction,
true(N-1) => true(N):
/-> N --------------------------------------> [N,2..N-1,1]
[1..N] --> 1 ---------/-----------> [1,3..N-1,2] -> [2,3..N-1,1] -/
\-> [2..N] -> [N,3..N-1,2] /
-> [3..N-1,2] -/
So it is proven. Thus, we need to devise a data flow diagram which, under the supposition of reversing an (N-1)-length list, will reverse an N-length list:
[1..N] --> 1 ------------------------------------\
\-> [2..N] -> [N,N-1..2] -> N -------------\------------------\
\-> [N-1,N-2..2] -> [2..N-1] -> [1..N-1] -> rev -> cons
Which gives us the implementation
(define (rev ls) ; rev [] = []
(cond ; rev [x] = [x]
((null? ls) ls) ; rev (x:xs)
((null? (rest ls)) ls) ; | (a:b) <- rev xs
(else ; = a : rev (x : rev b)
(cons (first (rev (rest ls)))
(rev (cons (first ls)
(rev (rest (rev (rest ls))))))))))
(rev '(1 2 3 4 5)) ; testing
;Value 13: (5 4 3 2 1)
The Haskell translation in the comments follows the diagram quite naturally. It is actually readable: a is the last element, b is the reversed "core" (i.e. the input list without its first and last element), so we reverse the reversed core, prepend the first element to get the butlast part of the input list, then reverse it and prepend the last element. Simple. :)
2020 update: here's a Scheme version based on the code by #Rörd from the comments, such that it is similarly readable, with arguments destructuring in place of Haskell's pattern matching:
(define (bind lst fun)
(apply fun lst))
(define (rev lst)
(if (or (null? lst)
(null? (cdr lst)))
lst
(bind lst
(lambda (first . rest)
(bind (rev rest)
(lambda (last . revd-core)
(cons last (rev (cons first (rev revd-core))))))))))
(define (reverse x)
(let loop ((x x) (y '()))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x))))))
Really one of the few ways to do it efficiently. But still sort of a helper procedure.
Other way, but not tail-recursive, and if the append doesn't use a set-cdr! it's really unusable for large lists.
(define (reverse L)
(if (null? l)
'()
(append (reverse (cdr L)) (list (car L)))))
Do you have last and butlast in your environment? If so, the procedure can be defined like this (though as Oscar notes this isn't how you'd normally want to approach the problem):
(define (rev lst)
(if (null? lst)
'()
(cons (car (last lst))
(rev (butlast lst)))))
Here are definitions of last and butlast. It sounds like they won't do you any good for this assignment if they're not part of your default environment, but when you're starting out it's good to read through and think about lots of recursive procedures.
(define (butlast lst)
(if (or (null? lst) (null? (cdr lst)))
'()
(cons (car lst) (butlast (cdr lst)))))
(define (last lst)
(if (or (null? lst) (null? (cdr lst)))
lst
(last (cdr lst))))