Implement up to 2.39
parent
50cdf446fe
commit
ae536c4be9
121
ex-2_33-xx.scm
121
ex-2_33-xx.scm
|
@ -1,8 +1,123 @@
|
|||
(load "util.scm")
|
||||
|
||||
(display "\nex-2.33 - list operations in terms of accumulate\n")
|
||||
|
||||
(display "\nex-2.34\n")
|
||||
(define (accumulate op initial sequence)
|
||||
(if (null? sequence)
|
||||
initial
|
||||
(op (car sequence)
|
||||
(accumulate op initial (cdr sequence)))))
|
||||
|
||||
(display "\nex-2.35\n")
|
||||
(define (map-acc p sequence)
|
||||
(accumulate (lambda (x y) (cons (p x) y)) nil sequence))
|
||||
|
||||
(define (append-acc seq1 seq2)
|
||||
(accumulate cons seq2 seq1))
|
||||
|
||||
(define (length-acc sequence)
|
||||
(accumulate (lambda (x y) (+ 1 y)) 0 sequence))
|
||||
|
||||
(display (map-acc square (list 1 2 3))) (newline)
|
||||
(display (append-acc (list 1 2 3) (list 4 5 6))) (newline)
|
||||
(display (length-acc (list 1 2 3))) (newline)
|
||||
|
||||
(display "\nex-2.34 - Horner's rule\n")
|
||||
|
||||
(define (horner-eval x coefficient-sequence)
|
||||
(accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
|
||||
0
|
||||
coefficient-sequence))
|
||||
|
||||
(display (horner-eval 2 (list 1 3 0 5 0 1))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.35 - count-leaves via accumulate\n")
|
||||
|
||||
(define x (cons (list 1 2) (list 3 4)))
|
||||
|
||||
(define (count-leaves t)
|
||||
(define (count-leaves-sub t)
|
||||
(cond ((null? t) 0)
|
||||
((pair? t) (count-leaves t))
|
||||
(else 1)))
|
||||
(accumulate + 0 (map count-leaves-sub t)))
|
||||
|
||||
(display (count-leaves x)) (newline)
|
||||
|
||||
(display "\nex-2.36 - accumulate-n\n")
|
||||
|
||||
(define (accumulate-n op init seqs)
|
||||
(if (null? (car seqs))
|
||||
nil
|
||||
(cons (accumulate op init (map car seqs))
|
||||
(accumulate-n op init (map cdr seqs)))))
|
||||
|
||||
(display (accumulate-n +
|
||||
0
|
||||
(list (list 1 2) (list 3 4) (list 5 6))))
|
||||
(newline)
|
||||
; (9 12)
|
||||
|
||||
(display "\nex-2.37 - matrix operations\n")
|
||||
|
||||
(define (display-matrix m)
|
||||
(map (lambda (row) (display row) (newline)) m))
|
||||
|
||||
(define m (list (list 1 2 3)
|
||||
(list 4 5 6)
|
||||
(list 7 8 9)))
|
||||
(define v (list 3 2 1))
|
||||
|
||||
(define (dot-product v w)
|
||||
(accumulate + 0 (map * v w)))
|
||||
|
||||
(define (matrix-*-vector m v)
|
||||
(map (lambda (row-vector) (dot-product row-vector v)) m))
|
||||
|
||||
(define (transpose mat)
|
||||
(accumulate-n cons nil mat))
|
||||
|
||||
(define (matrix-*-matrix m n)
|
||||
(let ((cols (transpose n)))
|
||||
(map (lambda (r) (map (lambda (c) (dot-product r c)) cols)) m)))
|
||||
|
||||
(display (dot-product v v)) (newline)
|
||||
(display (matrix-*-vector m v)) (newline)
|
||||
(display-matrix (transpose m)) (newline)
|
||||
(display-matrix (matrix-*-matrix m m))
|
||||
|
||||
(display "\nex-2.38\n")
|
||||
|
||||
(define (fold-left op initial sequence)
|
||||
(define (iter result rest)
|
||||
(if (null? rest)
|
||||
result
|
||||
(iter (op result (car rest))
|
||||
(cdr rest))))
|
||||
(iter initial sequence))
|
||||
|
||||
(define (fold-right op initial sequence) ; same as accumulate
|
||||
(if (null? sequence)
|
||||
initial
|
||||
(op (car sequence)
|
||||
(accumulate op initial (cdr sequence)))))
|
||||
|
||||
(display (fold-right / 1 (list 1 2 3))) (newline) ; 3/2
|
||||
(display (fold-left / 1 (list 1 2 3))) (newline) ; 1/6
|
||||
(display (fold-right list nil (list 1 2 3))) (newline) ; (1 (2 (3 ())
|
||||
(display (fold-left list nil (list 1 2 3))) (newline) ; (() 1) 2) 3)
|
||||
|
||||
(display "\nex-2.39\n")
|
||||
|
||||
(define (reverse-l sequence)
|
||||
(fold-left (lambda (x y) (cons y x)) nil sequence))
|
||||
|
||||
(define (reverse-r sequence)
|
||||
(fold-right (lambda (x y) (append y (list x))) nil sequence))
|
||||
|
||||
|
||||
(display (reverse-r (list 1 2 3 4))) (newline)
|
||||
(display (reverse-l (list 1 2 3 4))) (newline)
|
||||
|
||||
(display "\nex-2.40\n")
|
||||
|
||||
(display "\nex-2.36\n")
|
||||
|
|
Loading…
Reference in New Issue