Permalink
Browse files

lists and trees

  • Loading branch information...
1 parent 6560ae9 commit 9a642ca0f162ce73f371099bedb2b8e03af109f1 @sarabander committed Aug 11, 2011
Showing with 403 additions and 0 deletions.
  1. +10 −0 2.2/2.17.scm
  2. +11 −0 2.2/2.18.scm
  3. +49 −0 2.2/2.19.scm
  4. +35 −0 2.2/2.20.scm
  5. +10 −0 2.2/2.21.scm
  6. +34 −0 2.2/2.22.scm
  7. +15 −0 2.2/2.23.scm
  8. +21 −0 2.2/2.24.scm
  9. +12 −0 2.2/2.25.scm
  10. +9 −0 2.2/2.26.scm
  11. +22 −0 2.2/2.27.scm
  12. +15 −0 2.2/2.28.scm
  13. +103 −0 2.2/2.29.scm
  14. +20 −0 2.2/2.30.scm
  15. +16 −0 2.2/2.31.scm
  16. +21 −0 2.2/2.32.scm
View
@@ -0,0 +1,10 @@
+
+(define (last-pair lst)
+ (let ((butfirst (cdr lst)))
+ (if (null? butfirst)
+ (list (car lst))
+ (last-pair butfirst))))
+
+(last-pair '(k l m n)) ; '(n)
+
+(last-pair '()) ; error
View
@@ -0,0 +1,11 @@
+
+;; Already defined in Racket
+(reverse '(1 2 3 4)) ; '(4 3 2 1)
+
+;; Define a new one
+(define (reverse-list lst)
+ (if (null? lst)
+ empty
+ (append (reverse-list (cdr lst)) (list (car lst)))))
+
+(reverse-list '(a b c d e)) ; '(e d c b a)
View
@@ -0,0 +1,49 @@
+
+;; From the book:
+
+(define us-coins (list 50 25 10 5 1))
+(define uk-coins (list 100 50 20 10 5 2 1 0.5))
+
+(define (cc amount coin-values)
+ (cond ((= amount 0) 1)
+ ((or (< amount 0) (no-more? coin-values)) 0)
+ (else
+ (+ (cc amount
+ (except-first-denomination coin-values))
+ (cc (- amount
+ (first-denomination coin-values))
+ coin-values)))))
+
+;; ---------------
+
+(define (no-more? lst)
+ (null? lst))
+
+(define (first-denomination coinlist)
+ (car coinlist))
+
+(define (except-first-denomination coinlist)
+ (cdr coinlist))
+
+(cc 100 us-coins) ; 292
+(cc 100 uk-coins) ; 104561
+
+;; We reverse the order of coin lists
+(define us-coins (reverse (list 50 25 10 5 1)))
+(define uk-coins (reverse (list 100 50 20 10 5 2 1 0.5)))
+
+(cc 100 us-coins) ; 292
+(cc 100 uk-coins) ; 104561
+
+;; Same results, but calculating with uk-coins takes considerably longer.
+
+;; We now randomly change the ordering
+(define us-coins (list 10 50 1 5 25))
+(define uk-coins (list 50 0.5 20 100 2 10 5 1))
+
+(cc 100 us-coins) ; 292
+(cc 100 uk-coins) ; 104561
+
+;; Doesn't affect the result because of commutativity of addition.
+;; In other words, when a node is the sum of its sub-branches, the ordering
+;; of the branches doesn't matter.
View
@@ -0,0 +1,35 @@
+
+;; Helper function
+(define (myfilter pred lst)
+ (if (null? lst)
+ empty
+ (append (if (pred (car lst))
+ (list (car lst))
+ empty)
+ (myfilter pred (cdr lst)))))
+
+;; Test
+(myfilter even? '(1 2 3 4 5 6)) ; '(2 4 6)
+
+;; First version
+(define (same-parity x . y)
+ (if (odd? x)
+ (cons x (myfilter odd? y))
+ (cons x (myfilter even? y))))
+
+;; Second version
+(define same-parity
+ (λ w
+ (if (null? w)
+ empty
+ (let ((first (car w))
+ (rest (cdr w)))
+ (if (odd? first)
+ (cons first (myfilter odd? rest))
+ (cons first (myfilter even? rest)))))))
+
+;; Test
+(same-parity 1 2 3 4 5 6 7) ; '(1 3 5 7)
+(same-parity 2 3 4 5 6 7) ; '(2 4 6)
+(same-parity 2) ; '(2)
+(same-parity) ; error with first, '() with second version
View
@@ -0,0 +1,10 @@
+
+(define (square-list items)
+ (if (null? items)
+ empty
+ (cons (sqr (car items)) (square-list (cdr items)) )))
+
+(define (square-list items)
+ (map sqr items))
+
+(square-list '(10 9 8 7 6))
View
@@ -0,0 +1,34 @@
+
+(define nil empty)
+
+(define square sqr)
+
+;; From the book
+(define (square-list items)
+ (define (iter things answer)
+ (if (null? things)
+ answer
+ (iter (cdr things)
+ (cons (square (car things))
+ answer))))
+ (iter items nil))
+
+(square-list '(1 2 3 4 5 6)) ; '(36 25 16 9 4 1)
+
+;; Order is reversed because cons grows the list from left.
+
+;; Fix attempt from the book
+(define (square-list items)
+ (define (iter things answer)
+ (if (null? things)
+ answer
+ (iter (cdr things)
+ (cons answer
+ (square (car things))))))
+ (iter items nil))
+
+(square-list '(1 2 3 4 5 6)) ; '((((((() . 1) . 4) . 9) . 16) . 25) . 36)
+
+;; The first time cons is called, answer is an empty list. Cons makes
+;; a pair from '() and 1 producing '(() . 1). This in turn will be the car
+;; of a new pair constructed during next iteration: '((() . 1) . 4), etc.
View
@@ -0,0 +1,15 @@
+
+;; From the book, modified
+(for-each (lambda (x) (display x) (newline))
+ (list 57 321 88))
+
+;; New implementation
+(define (my-for-each f lst)
+ (if (null? lst)
+ (void)
+ (begin
+ (f (car lst))
+ (my-for-each f (cdr lst)))))
+
+(my-for-each (lambda (x) (display x) (newline))
+ (list 57 321 88))
View
@@ -0,0 +1,21 @@
+
+(list 1 (list 2 (list 3 4))) ; '(1 (2 (3 4)))
+
+
+;; (1 (2 (3 4)))
+;; ╭───┬───╮ ╭───┬───╮ ╱╲
+;; ───>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │ ╱ ╲
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╱ ╲ (2 (3 4))
+;; │ │ 1 ╱╲
+;; ╭─┴─╮ ╭─┴─┬───╮ ╭───┬───╮ ╱ ╲
+;; │ 1 │ │ ∘ │ ∘─┼──>│ ∘ │ ╱ │ ╱ ╲ (3 4)
+;; ╰───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ 2 ╱╲
+;; │ │ ╱ ╲
+;; ╭─┴─╮ ╭─┴─┬───╮ ╭───┬───╮ ╱ ╲
+;; │ 2 │ │ ∘ │ ∘─┼──>│ ∘ │ ╱ │ 3 4
+;; ╰───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │
+;; ╭─┴─╮ ╭─┴─╮
+;; │ 3 │ │ 4 │
+;; ╰───╯ ╰───╯
+;;
View
@@ -0,0 +1,12 @@
+
+(car (cdr (car (cdr (cdr '(1 3 (5 7) 9)))))) ; 7
+
+(car (car '((7)))) ; 7
+
+(car (cdr
+ (car (cdr
+ (car (cdr
+ (car (cdr
+ (car (cdr
+ (car (cdr '(1 (2 (3 (4 (5 (6 7))))))))))))))))))
+; 7
View
@@ -0,0 +1,9 @@
+
+(define x (list 1 2 3))
+(define y (list 4 5 6))
+
+(append x y) ; '(1 2 3 4 5 6)
+
+(cons x y) ; '((1 2 3) 4 5 6)
+
+(list x y) ; '((1 2 3) (4 5 6))
View
@@ -0,0 +1,22 @@
+
+(define (reverse-list lst)
+ (if (null? lst)
+ empty
+ (append (reverse-list (cdr lst)) (list (car lst)))))
+
+(define (deep-reverse lst)
+ (cond ((null? lst) empty)
+ ((not (pair? lst)) lst)
+ (else (append (deep-reverse (cdr lst))
+ (list (deep-reverse (car lst)))))))
+
+(deep-reverse '(1 2 3 4)) ; '(4 3 2 1)
+
+(deep-reverse '(1 2 ((3) (4 5 6) 7 ) (8 (((9) 10) 11) 12 (13 14)) 15))
+; '(15 ((14 13) 12 (11 (10 (9))) 8) (7 (6 5 4) (3)) 2 1)
+
+(define x (list (list 1 2) (list 3 4)))
+
+(reverse-list x) ; '((3 4) (1 2))
+
+(deep-reverse x) ; '((4 3) (2 1))
View
@@ -0,0 +1,15 @@
+
+(define (fringe tree)
+ (cond ((null? tree) empty)
+ ((not (pair? tree)) (list tree))
+ (else (append (fringe (car tree))
+ (fringe (cdr tree))))))
+
+(fringe '((1 2 3) 4 ((5 6) 7 (8)) (9 (10 (11)))))
+; '(1 2 3 4 5 6 7 8 9 10 11)
+
+(define x (list (list 1 2) (list 3 4)))
+
+(fringe x) ; '(1 2 3 4)
+
+(fringe (list x x)) ; '(1 2 3 4 1 2 3 4)
View
@@ -0,0 +1,103 @@
+
+;; From the book
+(define (make-mobile left right)
+ (list left right))
+
+(define (make-branch length structure)
+ (list length structure))
+;; -------------
+
+;; a.
+
+(define (left-branch mobile)
+ (car mobile))
+
+(define (right-branch mobile)
+ (car (cdr mobile)))
+
+(define (branch-length branch)
+ (car branch))
+
+(define (branch-structure branch)
+ (car (cdr branch)))
+
+;; Tests
+(define mob1
+ (make-mobile (make-branch 3 6)
+ (make-branch 2 9)))
+
+(define mob2
+ (make-mobile (make-branch 6 4)
+ (make-branch 5 mob1)))
+
+(define mob3
+ (make-mobile (make-branch 15 3)
+ (make-branch 3 mob1)))
+
+(branch-structure (right-branch mob1))
+(branch-structure (right-branch mob2))
+
+;; b.
+
+(define (total-weight mobile)
+ (cond ((not (pair? mobile)) mobile)
+ (else (+ (total-weight (branch-structure (left-branch mobile)))
+ (total-weight (branch-structure (right-branch mobile)))))))
+
+(total-weight mob1) ; 15
+(total-weight mob2) ; 19
+(total-weight mob3) ; 18
+
+;; c.
+
+(define (balanced? mobile)
+ (let ((left (left-branch mobile))
+ (right (right-branch mobile))
+ (b-struct branch-structure)
+ (b-length branch-length))
+ (= (* (total-weight (b-struct left))
+ (b-length left))
+ (* (total-weight (b-struct right))
+ (b-length right)))))
+
+(define (balanced? mobile)
+ (if (number? mobile)
+ true
+ (let ((left (left-branch mobile))
+ (right (right-branch mobile))
+ (b-struct branch-structure)
+ (b-length branch-length))
+ (and (= (* (total-weight (b-struct left))
+ (b-length left))
+ (* (total-weight (b-struct right))
+ (b-length right)))
+ (balanced? (b-struct left))
+ (balanced? (b-struct right))))))
+
+(balanced? mob1) ; true
+(balanced? mob2) ; false
+(balanced? mob3) ; true
+
+;; d.
+
+;; Redefinitions from the book
+(define (make-mobile left right)
+ (cons left right))
+
+(define (make-branch length structure)
+ (cons length structure))
+;; -------------
+
+;; Only the selectors must be changed:
+
+(define (left-branch mobile)
+ (car mobile))
+
+(define (right-branch mobile)
+ (cdr mobile))
+
+(define (branch-length branch)
+ (car branch))
+
+(define (branch-structure branch)
+ (cdr branch))
View
@@ -0,0 +1,20 @@
+
+;; First version
+(define (square-tree tree)
+ (cond ((null? tree) empty)
+ ((not (pair? tree)) (sqr tree))
+ (else (cons (square-tree (car tree))
+ (square-tree (cdr tree))))))
+
+;; Second version with map
+(define (square-tree tree)
+ (map (λ (sub-tree)
+ (if (pair? sub-tree)
+ (square-tree sub-tree)
+ (sqr sub-tree)))
+ tree))
+
+(square-tree
+ (list 1
+ (list 2 (list 3 4) 5)
+ (list 6 7)))
View
@@ -0,0 +1,16 @@
+
+(define square sqr)
+
+(define (tree-map f tree)
+ (map (λ (sub-tree)
+ (if (pair? sub-tree)
+ (tree-map f sub-tree)
+ (f sub-tree)))
+ tree))
+
+(define (square-tree tree) (tree-map square tree))
+
+(square-tree
+ (list 1
+ (list 2 (list 3 4) 5)
+ (list 6 7)))
Oops, something went wrong.

0 comments on commit 9a642ca

Please sign in to comment.