1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #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 ;subtract : (listof numbers) (listof numbers) -> (listof numbers)
5 ;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 ;ASSUMPTION : list1 must be the same length as list2
7 ;
8 ;Examples:
9 ;
10 ;(subtract '(5 6 7)
11 ;          '(3 4 5))
12 ;should give
13 ;'(2/5 4/5)
14 
15 ;subtract-lists : (listof numbers) (listof numbers) -> (listof numbers)
16 ;Given list1 and list2, subtract list1 from list2.
17 
18 ;multiply-row : number (listof numbers) -> (listof numbers)
19 ;Given factor, multiply alon by factor.
20 
21 (define (subtract list1 list2)
22   (local ((define multiplied-list1
23             (multiply-row (/ (first list2) (first list1)) list1)))
24     (cond
25       [(not (= (length list1) (length list2)))
26        (error 'subtract "unequal list lengths")]
27       [(empty? list1) empty]
28       [(not (= (first list1) (first list2)))
29        (rest (subtract-lists multiplied-list1
30                              list2))]
31       [else (rest (subtract-lists list1 list2))])))
32 
33 (define (subtract-lists list1 list2)
34   (cond
35     [(not (= (length list1) (length list2)))
36      (error 'subtract "unequal list lengths")]
37     [(empty? list1) empty]    
38     [else (cons (- (first list2)
39                    (first list1))
40                 (subtract-lists (rest list1) (rest list2)))]))
41 
42 (define (multiply-row factor alon)
43   (map (lambda (x) (* factor x)) alon))
44 
45 ;triangulate : (listof (listof numbers)) -> (listof (listof numbers))
46 ;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 ;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.
48 
49 
50 (define (triangulate a-matrix)
51   (cond
52     [(or (empty? a-matrix)
53          (not (cons? (first a-matrix))))
54      (error 'triangulate "expected arg: non-empty (listof (listof numbers))")]
55     [(= (length a-matrix) 1) a-matrix]
56     [(column-zeros? a-matrix) (error 'triangulate "cannot triangulate matrix")]
57     [(zero? (first (first a-matrix))) (triangulate (switch-row a-matrix))]
58     [else (cons (first a-matrix)
59                 (triangulate (map (lambda (x) (subtract (first a-matrix) x))
60                                   (rest a-matrix))))]))
61 
62 ;switch-row : (listof (listof numbers)) -> (listof (listof numbers))
63 ;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.
64 
65 (define (switch-row a-matrix)
66   (cond
67     [(empty? a-matrix) empty]
68     ;[(empty? (first a-matrix)) empty]
69     [(and (zero? (first (first a-matrix)))
70           (cons? (first-nonzero-row a-matrix)))
71      (cons (first-nonzero-row a-matrix)
72            (remove (first-nonzero-row a-matrix) a-matrix))]
73     [else a-matrix]))
74 
75 ;first-nonzero-row : (listof (listof numbers)) -> (listof numbers)
76 ;Given a-matrix, return the first-nonzero-row.
77 
78 (define (first-nonzero-row a-matrix)
79   (cond
80     [(empty? a-matrix) empty]
81     [(not (zero? (first (first a-matrix)))) (first a-matrix)]
82     [else (first-nonzero-row (rest a-matrix))]))
83 
84 ;remove : X (listof X) -> (listof X)
85 ;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.
86 
87 (define (remove x alox)
88   (cond
89     [(empty? alox) empty]
90     [(equal? x (first alox)) (rest alox)]
91     [else (cons (first alox)
92                 (remove x (rest alox)))]))
93 
94 ;column-zeros? : (listof (listof numbers)) -> boolean
95 ;Determines if the entire first column of a-matrix consists of nothing but zeros.
96 
97 (define (column-zeros? a-matrix)
98   (cond
99     [(empty? a-matrix) true]
100     [(not (zero? (first (first a-matrix)))) false]
101     [else (column-zeros? (rest a-matrix))]))
102 
103 ;evaluate : (listof numbers) (listof numbers) -> number
104 ;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.
105 ;
106 ;For example, (evaluate '(9 21) '(2)) represents 9y and 21 and y=2.  We plug y=2 into 9*y - 21 to obtain -3.
107 
108 (define (evaluate eqn var)
109   (cond
110     [(and (empty? var)
111           (cons? eqn)) (* -1 (first eqn))]
112     [(and (cons? eqn)
113           (cons? var)) (+ (* (first eqn) (first var))
114                           (evaluate (rest eqn) (rest var)))]
115     [else (error 'evaluate "unexpected error")]))
116 
117 ;solve : (listof (listof numbers)) -> (listof numbers)
118 ;solve consumes a (listof (listof numbers)) representing a triangular matrix and returns the solutions, a (listof numbers).
119 ;ASSUMPTION: A "perfect" matrix is provided
120 
121 (define (solve a-matrix)
122   (cond
123     [(empty? a-matrix) empty]
124     [(empty? (rest a-matrix)) (cons (/ (second (first a-matrix))
125                                        (first (first a-matrix)))
126                                     empty)]
127     [(cons? a-matrix) (cons (/ (* -1 (evaluate (rest (first a-matrix))
128                                                (solve (rest a-matrix))))
129                                (first (first a-matrix)))
130                             (solve (rest a-matrix)))]))
131 
132 #|
133 (= (evaluate '(9 21) '(2)) -3)
134 (= (evaluate '(3 9 37) '(4 2)) -7)
135 |#
136 
137 ;Tests
138 
139 (define a-matrix '((2 3 3 8)
140                    (2 3 -2 3)
141                    (4 -2 2 4)))
142 (define b-matrix '((2 2 3 10)
143                    (2 5 12 31)
144                    (4 1 -2 1)))
145 
146 #|
147 (define c-matrix '((2 2 2 6)
148                    (2 2 4 8)
149                    (2 2 1 2)))
150 
151 |#
152 ;(triangulate a-matrix)
153 ;(triangulate b-matrix)
154 ;(triangulate c-matrix)
155 (triangulate a-matrix)
156 (solve (triangulate a-matrix))
157 (solve (triangulate b-matrix))
158 (define d-matrix '((5 6 9 7 1 9)
159                    (5 0 3 1 1 8)
160                    (7 8 3 9 4 3)
161                    (5 4 5 6 7 5)
162                    (8 1 2 0 9 1)))
163 (solve (triangulate d-matrix))