-
Notifications
You must be signed in to change notification settings - Fork 17
/
deep_lists.scm
43 lines (32 loc) · 1.22 KB
/
deep_lists.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(define dl '((1 (2)) (((3) 4) (5 (6)) () (7)) 8))
(define (snoc x l) (append l (list x)))
(define (atom? x) (and (not (pair? x)) (not (null? x))))
(define (foldr op nv l)
(if (null? l) nv
(op (car l) (foldr op nv (cdr l)))))
(define (deep-foldr nv term op dl)
(cond ((null? dl) nv)
((atom? dl) (term dl))
(else (op (deep-foldr nv term op (car dl))
(deep-foldr nv term op (cdr dl))))))
(define (deep-foldr nv term op dl)
(foldr op nv
(map (lambda (x) (if (atom? x)
(term x)
(deep-foldr nv term op x)))
dl)))
(define (count-atoms dl)
(cond ((null? dl) 0)
((atom? dl) 1)
(else (+ (count-atoms (car dl)) (count-atoms (cdr dl))))))
(define (count-atoms dl) (deep-foldr 0 (lambda (x) 1) + dl))
(define (flatten dl)
(cond ((null? dl) dl)
((atom? dl) (list dl))
(else (append (flatten (car dl)) (flatten (cdr dl))))))
(define (flatten dl) (deep-foldr '() list append dl))
(define (deep-reverse dl)
(cond ((null? dl) dl)
((atom? dl) dl)
(else (snoc (deep-reverse (car dl)) (deep-reverse (cdr dl))))))
(define (deep-reverse dl) (deep-foldr '() (lambda (x) x) snoc dl))