Subversion Repositories programming

Rev

Rev 67 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 67 Rev 68
Line 1... Line 1...
1
;Written By: Ira Snyder
1
;Written By: Ira Snyder
2
;Due Date:   02-16-2005
2
;Due Date:   02-16-2005
3
;Homework #: hw08
3
;Homework #: hw08
4
 
4
 
-
 
5
;ASSUMPTIONS: I chose to use the print format specified in the table
-
 
6
;             on the document that was handed out in class for hw08.
-
 
7
;             The difference is in the spaces between the coefficient
-
 
8
;             and the "x" that is printed. In the table there is a space
-
 
9
;             between the coefficient and the "x", whereas in the example
-
 
10
;             runs on the bottom of the page, there is not a space.
-
 
11
;             The change to make it the same as the example runs is to delete
-
 
12
;             the space between "~A" and "x" in the format statements on
-
 
13
;             lines 111 and 112 (the last two lines in the cond of WRITE-NUM).
-
 
14
;
-
 
15
;             Also, I was forced to assume that the last printed line on the
-
 
16
;             the hw08 handout is incorrect, since the terms are unsorted
-
 
17
;             and have un-combined coefficients with the same exponent.
-
 
18
;             Mine is correct and combines terms with the same exponent
-
 
19
;             and sorts the list from highest to lowest exponent.
-
 
20
;
-
 
21
 
5
;;; Given a list in unsorted, unreduced Polynomial
22
;;; Given a list in unsorted, unreduced Polynomial
6
;;; Normal Form, and returns a list in perfect PNF
23
;;; Normal Form, and returns a list in perfect PNF
7
(defun PNF (L)
24
(defun PNF (L)
8
  (do ((L L (cdr L))
25
  (do ((L L (cdr L))
9
       (RET nil))
26
       (RET nil))
Line 18... Line 35...
18
;;; including combining coefficients
35
;;; including combining coefficients
19
(defun INSERT (PAIR LIST)
36
(defun INSERT (PAIR LIST)
20
  (cond
37
  (cond
21
    ((null LIST)                  (cons PAIR LIST))
38
    ((null LIST)                  (cons PAIR LIST))
22
    ((> (cadr PAIR) (cadar LIST)) (cons PAIR LIST))
39
    ((> (cadr PAIR) (cadar LIST)) (cons PAIR LIST))
-
 
40
    ((= (cadr PAIR) (cadar LIST)) (progn
23
    ((= (cadr PAIR) (cadar LIST)) (setf (caar LIST) (+ (car PAIR) (caar LIST))) LIST)
41
                                    (setf (caar LIST) (+ (car PAIR) (caar LIST)))
-
 
42
                                    LIST
-
 
43
                                  ))
24
    (t                            (cons (car LIST ) (INSERT PAIR (cdr LIST))))
44
    (t                            (cons (car LIST ) (INSERT PAIR (cdr LIST))))
25
  )
45
  )
26
)
46
)
27
 
47
 
28
;;; Deletes all of the pairs that have zero coefficients in
48
;;; Deletes all of the pairs that have zero coefficients in
Line 43... Line 63...
43
      ((zerop N) STR)
63
      ((zerop N) STR)
44
    (setf STR (concatenate 'string STR " "))
64
    (setf STR (concatenate 'string STR " "))
45
  )
65
  )
46
)
66
)
47
 
67
 
-
 
68
;;; This checks if nil was passed. If it was, print a blank line, then
-
 
69
;;; a "0" line. Else pass the list off to the WRITE-POLY1 function.
48
(defun WRITE-POLY (L)
70
(defun WRITE-POLY (L)
-
 
71
  (cond
-
 
72
    ((null L) (format t "~%0~%"))
-
 
73
    (t       (WRITE-POLY1 L))
-
 
74
  )
-
 
75
)
-
 
76
 
-
 
77
;;; Given a list in Polynomial Normal Form, this will print
-
 
78
;;; the human readable form of the list on two lines.
-
 
79
;;; Example:
-
 
80
;;;   INPUT:  ((1 1) (2 3) (-10 0) (3 2) (2 1))
-
 
81
;;;   OUTPUT:      3      2      
-
 
82
;;;   OUTPUT: + 2 x  + 3 x  + 3 x - 10
-
 
83
(defun WRITE-POLY1 (L)
49
  (do ((L (PNF L) (cdr L))
84
  (do ((L (PNF L) (cdr L))
50
       (EXP  (format nil ""))
85
       (EXP  (format nil ""))
51
       (COEF (format nil "")))
86
       (COEF (format nil "")))
52
      ((null L) (format t "~A~%~A~%" EXP COEF))
87
      ((null L) (format t "~A~%~A~%" EXP COEF))
53
    (setf COEF (concatenate 'string COEF (WRITE-NUM (caar L) (cadar L))))
88
    (setf COEF (concatenate 'string COEF (WRITE-NUM (caar L) (cadar L))))
Line 55... Line 90...
55
    (setf EXP  (concatenate 'string EXP  (WRITE-EXP (caar L) (cadar L))))
90
    (setf EXP  (concatenate 'string EXP  (WRITE-EXP (caar L) (cadar L))))
56
    (MAKE-EQUAL EXP COEF)
91
    (MAKE-EQUAL EXP COEF)
57
  )
92
  )
58
)
93
)
59
 
94
 
-
 
95
;;; Given a coefficient and an exponent, output the correct expression
-
 
96
;;; to represent it.
-
 
97
;;; Examples:
-
 
98
;;; INPUT:  3 4
-
 
99
;;; OUTPUT: + 3 x
-
 
100
;;;
-
 
101
;;; INPUT:  3 0
-
 
102
;;; OUTPUT: + 3
-
 
103
;;;
-
 
104
;;; INPUT:  -3 0
-
 
105
;;; OUTPUT: - 3
60
(defun WRITE-NUM (NUM EXP)
106
(defun WRITE-NUM (NUM EXP)
61
  (cond
107
  (cond
-
 
108
    ; don't output an x if we have a zero exponent
62
    ((zerop EXP) (if (plusp NUM) (format nil " + ~A" NUM) (format nil " - ~A" (abs NUM))))
109
    ((zerop EXP) (if (plusp NUM) (format nil " + ~A" NUM) 
-
 
110
                                 (format nil " - ~A" (abs NUM))))
63
    ((plusp NUM) (format nil " + ~A x" NUM))
111
    ((plusp NUM) (format nil " + ~A x" NUM))
64
    (t           (format nil " - ~A x" (abs NUM)))
112
    (t           (format nil " - ~A x" (abs NUM)))
65
  )
113
  )
66
)
114
)
67
 
115
 
-
 
116
;;; Given a coefficient and an exponent, output the exponent.
-
 
117
;;; NOTE: I chose to have the syntax of WRITE-EXP match the syntax of WRITE-NUM
-
 
118
;;;       even though I do not use the parameter NUM in the code. This was for
-
 
119
;;;       uniformity reasons.
68
(defun WRITE-EXP (NUM EXP)
120
(defun WRITE-EXP (NUM EXP)
69
  (cond
121
  (cond
70
    ((zerop EXP) nil)
122
    ((zerop EXP) nil)
71
    ((= EXP 1)   nil)
123
    ((= EXP 1)   nil)
72
    (t           (format nil "~A" EXP))
124
    (t           (format nil "~A" EXP))
73
  )
125
  )
74
)
126
)
75
 
127
 
76
;;; When called with two strings as arguments, this macro
128
;;; When called with two strings as arguments, this macro expands to
77
;;; expands to make them the same length.
129
;;; make them the same length, regardless of which is longer.
78
(defmacro MAKE-EQUAL (S1 S2)
130
(defmacro MAKE-EQUAL (S1 S2)
79
  `(cond
131
  `(cond
80
     ((> (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S1) (length ,S2))))
132
     ((> (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S1) (length ,S2))))
81
                                    (setf ,S2 (concatenate 'string ,S2 (SPACES DIFF)))))
133
                                    (setf ,S2 (concatenate 'string ,S2 (SPACES DIFF)))))
82
     ((< (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S2) (length ,S1))))
134
     ((< (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S2) (length ,S1))))
83
                                    (setf ,S1 (concatenate 'string ,S1 (SPACES DIFF)))))
135
                                    (setf ,S1 (concatenate 'string ,S1 (SPACES DIFF)))))
84
     (t                             nil)
136
     (t                             nil)
85
   )
137
   )
86
)
138
)
87
 
139
 
-
 
140