1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname |27.5|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 12687dd9 2023-08-04 jrmu ;subtract : (listof numbers) (listof numbers) -> (listof numbers)
5 12687dd9 2023-08-04 jrmu ;Given list1 and list2, subtract a multiple of list1 so that the first column of list2 is 0. Return the remainder of the list (that is, leave out the leading zero).
6 12687dd9 2023-08-04 jrmu ;ASSUMPTION : list1 must be the same length as list2
10 12687dd9 2023-08-04 jrmu ;(subtract '(5 6 7)
12 12687dd9 2023-08-04 jrmu ;should give
15 12687dd9 2023-08-04 jrmu ;subtract-lists : (listof numbers) (listof numbers) -> (listof numbers)
16 12687dd9 2023-08-04 jrmu ;Given list1 and list2, subtract list1 from list2.
18 12687dd9 2023-08-04 jrmu ;multiply-row : number (listof numbers) -> (listof numbers)
19 12687dd9 2023-08-04 jrmu ;Given factor, multiply alon by factor.
21 12687dd9 2023-08-04 jrmu (define (subtract list1 list2)
22 12687dd9 2023-08-04 jrmu (local ((define multiplied-list1
23 12687dd9 2023-08-04 jrmu (multiply-row (/ (first list2) (first list1)) list1)))
25 12687dd9 2023-08-04 jrmu [(not (= (length list1) (length list2)))
26 12687dd9 2023-08-04 jrmu (error 'subtract "unequal list lengths")]
27 12687dd9 2023-08-04 jrmu [(empty? list1) empty]
28 12687dd9 2023-08-04 jrmu [(not (= (first list1) (first list2)))
29 12687dd9 2023-08-04 jrmu (rest (subtract-lists multiplied-list1
31 12687dd9 2023-08-04 jrmu [else (rest (subtract-lists list1 list2))])))
33 12687dd9 2023-08-04 jrmu (define (subtract-lists list1 list2)
35 12687dd9 2023-08-04 jrmu [(not (= (length list1) (length list2)))
36 12687dd9 2023-08-04 jrmu (error 'subtract "unequal list lengths")]
37 12687dd9 2023-08-04 jrmu [(empty? list1) empty]
38 12687dd9 2023-08-04 jrmu [else (cons (- (first list2)
39 12687dd9 2023-08-04 jrmu (first list1))
40 12687dd9 2023-08-04 jrmu (subtract-lists (rest list1) (rest list2)))]))
42 12687dd9 2023-08-04 jrmu (define (multiply-row factor alon)
43 12687dd9 2023-08-04 jrmu (map (lambda (x) (* factor x)) alon))
45 12687dd9 2023-08-04 jrmu ;triangulate : (listof (listof numbers)) -> (listof (listof numbers))
46 12687dd9 2023-08-04 jrmu ;Given a-matrix, return the triangularized matrix obtained by following Gaussian elimination. (generative recursion involved) We keep the first row and append this to the remaining rows, all of which have been subtracted by the first row, which has been multiplied by a factor such that all the remaining rows have the first column zeroed out (and then dropped). We then take the matrix, excluding the first row, and repeat the process until we hit the last row.
47 12687dd9 2023-08-04 jrmu ;Termination Argument: each generative recursion involves a matrix with one less row and one less column. Ultimately, we hit the last row, and we simply return the last row. Hence, triangulate must necessarily terminate.
50 12687dd9 2023-08-04 jrmu (define (triangulate a-matrix)
52 12687dd9 2023-08-04 jrmu [(or (empty? a-matrix)
53 12687dd9 2023-08-04 jrmu (not (cons? (first a-matrix))))
54 12687dd9 2023-08-04 jrmu (error 'triangulate "expected arg: non-empty (listof (listof numbers))")]
55 12687dd9 2023-08-04 jrmu [(= (length a-matrix) 1) a-matrix]
56 12687dd9 2023-08-04 jrmu [(column-zeros? a-matrix) (error 'triangulate "cannot triangulate matrix")]
57 12687dd9 2023-08-04 jrmu [(zero? (first (first a-matrix))) (triangulate (switch-row a-matrix))]
58 12687dd9 2023-08-04 jrmu [else (cons (first a-matrix)
59 12687dd9 2023-08-04 jrmu (triangulate (map (lambda (x) (subtract (first a-matrix) x))
60 12687dd9 2023-08-04 jrmu (rest a-matrix))))]))
62 12687dd9 2023-08-04 jrmu ;switch-row : (listof (listof numbers)) -> (listof (listof numbers))
63 12687dd9 2023-08-04 jrmu ;Given a-matrix, find the first-nonzero row in a-matrix and move it to the top of the matrix while replacing that first-nonzero-row with the first row. If there are no nonzero rows for the first column, return a-matrix.
65 12687dd9 2023-08-04 jrmu (define (switch-row a-matrix)
67 12687dd9 2023-08-04 jrmu [(empty? a-matrix) empty]
68 12687dd9 2023-08-04 jrmu ;[(empty? (first a-matrix)) empty]
69 12687dd9 2023-08-04 jrmu [(and (zero? (first (first a-matrix)))
70 12687dd9 2023-08-04 jrmu (cons? (first-nonzero-row a-matrix)))
71 12687dd9 2023-08-04 jrmu (cons (first-nonzero-row a-matrix)
72 12687dd9 2023-08-04 jrmu (remove (first-nonzero-row a-matrix) a-matrix))]
73 12687dd9 2023-08-04 jrmu [else a-matrix]))
75 12687dd9 2023-08-04 jrmu ;first-nonzero-row : (listof (listof numbers)) -> (listof numbers)
76 12687dd9 2023-08-04 jrmu ;Given a-matrix, return the first-nonzero-row.
78 12687dd9 2023-08-04 jrmu (define (first-nonzero-row a-matrix)
80 12687dd9 2023-08-04 jrmu [(empty? a-matrix) empty]
81 12687dd9 2023-08-04 jrmu [(not (zero? (first (first a-matrix)))) (first a-matrix)]
82 12687dd9 2023-08-04 jrmu [else (first-nonzero-row (rest a-matrix))]))
84 12687dd9 2023-08-04 jrmu ;remove : X (listof X) -> (listof X)
85 12687dd9 2023-08-04 jrmu ;Given x and alox, removes the first instance of x in alox and returns the remaining list. If x is not present in alox, simply returns alox.
87 12687dd9 2023-08-04 jrmu (define (remove x alox)
89 12687dd9 2023-08-04 jrmu [(empty? alox) empty]
90 12687dd9 2023-08-04 jrmu [(equal? x (first alox)) (rest alox)]
91 12687dd9 2023-08-04 jrmu [else (cons (first alox)
92 12687dd9 2023-08-04 jrmu (remove x (rest alox)))]))
94 12687dd9 2023-08-04 jrmu ;column-zeros? : (listof (listof numbers)) -> boolean
95 12687dd9 2023-08-04 jrmu ;Determines if the entire first column of a-matrix consists of nothing but zeros.
97 12687dd9 2023-08-04 jrmu (define (column-zeros? a-matrix)
99 12687dd9 2023-08-04 jrmu [(empty? a-matrix) true]
100 12687dd9 2023-08-04 jrmu [(not (zero? (first (first a-matrix)))) false]
101 12687dd9 2023-08-04 jrmu [else (column-zeros? (rest a-matrix))]))
103 12687dd9 2023-08-04 jrmu ;evaluate : (listof numbers) (listof numbers) -> number
104 12687dd9 2023-08-04 jrmu ;Given eqn and var, substitute the corresponding value of the variables in var into eqn and subtract the value of the right-hand side of eqn from the left-hand side of eqn.
106 12687dd9 2023-08-04 jrmu ;For example, (evaluate '(9 21) '(2)) represents 9y and 21 and y=2. We plug y=2 into 9*y - 21 to obtain -3.
108 12687dd9 2023-08-04 jrmu (define (evaluate eqn var)
110 12687dd9 2023-08-04 jrmu [(and (empty? var)
111 12687dd9 2023-08-04 jrmu (cons? eqn)) (* -1 (first eqn))]
112 12687dd9 2023-08-04 jrmu [(and (cons? eqn)
113 12687dd9 2023-08-04 jrmu (cons? var)) (+ (* (first eqn) (first var))
114 12687dd9 2023-08-04 jrmu (evaluate (rest eqn) (rest var)))]
115 12687dd9 2023-08-04 jrmu [else (error 'evaluate "unexpected error")]))
117 12687dd9 2023-08-04 jrmu ;solve : (listof (listof numbers)) -> (listof numbers)
118 12687dd9 2023-08-04 jrmu ;solve consumes a (listof (listof numbers)) representing a triangular matrix and returns the solutions, a (listof numbers).
119 12687dd9 2023-08-04 jrmu ;ASSUMPTION: A "perfect" matrix is provided
121 12687dd9 2023-08-04 jrmu (define (solve a-matrix)
123 12687dd9 2023-08-04 jrmu [(empty? a-matrix) empty]
124 12687dd9 2023-08-04 jrmu [(empty? (rest a-matrix)) (cons (/ (second (first a-matrix))
125 12687dd9 2023-08-04 jrmu (first (first a-matrix)))
127 12687dd9 2023-08-04 jrmu [(cons? a-matrix) (cons (/ (* -1 (evaluate (rest (first a-matrix))
128 12687dd9 2023-08-04 jrmu (solve (rest a-matrix))))
129 12687dd9 2023-08-04 jrmu (first (first a-matrix)))
130 12687dd9 2023-08-04 jrmu (solve (rest a-matrix)))]))
133 12687dd9 2023-08-04 jrmu (= (evaluate '(9 21) '(2)) -3)
134 12687dd9 2023-08-04 jrmu (= (evaluate '(3 9 37) '(4 2)) -7)
139 12687dd9 2023-08-04 jrmu (define a-matrix '((2 3 3 8)
141 12687dd9 2023-08-04 jrmu (4 -2 2 4)))
142 12687dd9 2023-08-04 jrmu (define b-matrix '((2 2 3 10)
143 12687dd9 2023-08-04 jrmu (2 5 12 31)
144 12687dd9 2023-08-04 jrmu (4 1 -2 1)))
147 12687dd9 2023-08-04 jrmu (define c-matrix '((2 2 2 6)
149 12687dd9 2023-08-04 jrmu (2 2 1 2)))
152 12687dd9 2023-08-04 jrmu ;(triangulate a-matrix)
153 12687dd9 2023-08-04 jrmu ;(triangulate b-matrix)
154 12687dd9 2023-08-04 jrmu ;(triangulate c-matrix)
155 12687dd9 2023-08-04 jrmu (triangulate a-matrix)
156 12687dd9 2023-08-04 jrmu (solve (triangulate a-matrix))
157 12687dd9 2023-08-04 jrmu (solve (triangulate b-matrix))
158 12687dd9 2023-08-04 jrmu (define d-matrix '((5 6 9 7 1 9)
159 12687dd9 2023-08-04 jrmu (5 0 3 1 1 8)
160 12687dd9 2023-08-04 jrmu (7 8 3 9 4 3)
161 12687dd9 2023-08-04 jrmu (5 4 5 6 7 5)
162 12687dd9 2023-08-04 jrmu (8 1 2 0 9 1)))
163 12687dd9 2023-08-04 jrmu (solve (triangulate d-matrix))
