62 lines
1.3 KiB
Racket
62 lines
1.3 KiB
Racket
;;#lang planet neil/sicp
|
|
#lang sicp
|
|
(#%require racket/trace)
|
|
|
|
(define (last-pair x)
|
|
(if (null? (cdr x))
|
|
x
|
|
(last-pair (cdr x))))
|
|
|
|
(define (count-pairs x)
|
|
(if (not (pair? x))
|
|
0
|
|
(+ (count-pairs (car x))
|
|
(count-pairs (cdr x))
|
|
1)))
|
|
|
|
(define (count-unique-pairs l)
|
|
(trace-define (count l seen-pairs)
|
|
(cond ((not (pair? l)) 0)
|
|
((memq l seen-pairs) 0)
|
|
(else
|
|
(+ (count (car l)
|
|
(cons l seen-pairs))
|
|
(count (cdr l)
|
|
(cons l
|
|
(cons (car l)
|
|
seen-pairs)))
|
|
1))))
|
|
(count l '()))
|
|
|
|
(define (has-cycle? l)
|
|
(define (cycle-iter l seen-pairs)
|
|
(cond ((not (pair? l)) #f)
|
|
((memq (cdr l) seen-pairs) #t)
|
|
(else
|
|
(cycle-iter (cdr l)
|
|
(cons l seen-pairs)))))
|
|
(cycle-iter l '()))
|
|
|
|
|
|
;; Both give 3
|
|
(define l1 '(a b c))
|
|
|
|
;; count-pairs never stops
|
|
(define l2 '(a b c))
|
|
(set-cdr! (last-pair l2) l2)
|
|
|
|
;; count-pairs returns 4
|
|
(define a '(a b))
|
|
(define l3 (cons (last-pair a) a))
|
|
|
|
(define l4-3 (cons 'a '()))
|
|
(define l4-2 (cons l4-3 l4-3))
|
|
(define l4-1 (cons l4-2 '()))
|
|
(define l4 l4-1)
|
|
|
|
|
|
(define l5-3 (cons 'a '()))
|
|
(define l5-2 (cons l5-3 l5-3))
|
|
(define l5-1 (cons l5-2 l5-2))
|
|
(define l5 l5-1)
|