Implement up to 2.39

main
Felix Martin 2020-10-30 20:15:03 -04:00
parent 50cdf446fe
commit ae536c4be9
2 changed files with 119 additions and 3 deletions

View File

@ -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")

1
run
View File

@ -5,5 +5,6 @@ do
echo "run: $a"
echo
mit-scheme --quiet < $a
echo
done