Subversion Repositories programming

irasnyd@duallie lisp $ cat hw08.lisp
;Written By: Ira Snyder
;Due Date:   02-16-2005
;Homework #: hw08

;ASSUMPTIONS: I chose to use the print format specified in the table
;             on the document that was handed out in class for hw08.
;             The difference is in the spaces between the coefficient
;             and the "x" that is printed. In the table there is a space
;             between the coefficient and the "x", whereas in the example
;             runs on the bottom of the page, there is not a space.
;             The change to make it the same as the example runs is to delete
;             the space between "~A" and "x" in the format statements on
;             lines 111 and 112 (the last two lines in the cond of WRITE-NUM).
;
;             Also, I was forced to assume that the last printed line on the
;             the hw08 handout is incorrect, since the terms are unsorted
;             and have un-combined coefficients with the same exponent.
;             Mine is correct and combines terms with the same exponent
;             and sorts the list from highest to lowest exponent.
;

;;; Given a list in unsorted, unreduced Polynomial
;;; Normal Form, and returns a list in perfect PNF
(defun PNF (L)
  (do ((L L (cdr L))
       (RET nil))
      ((null L) RET)
    (setf RET (INSERT (car L) RET))
    (setf RET (DEL-ZERO-COEF RET))
  )
)

;;; Given a pair of numbers (in a list) and a list of pairs
;;; this inserts the pair into the list in it's correct place
;;; including combining coefficients
(defun INSERT (PAIR LIST)
  (cond
    ((null LIST)                  (cons PAIR LIST))
    ((> (cadr PAIR) (cadar LIST)) (cons PAIR LIST))
    ((= (cadr PAIR) (cadar LIST)) (progn
                                    (setf (caar LIST) (+ (car PAIR) (caar LIST)))
                                    LIST
                                  ))
    (t                            (cons (car LIST ) (INSERT PAIR (cdr LIST))))
  )
)

;;; Deletes all of the pairs that have zero coefficients in
;;; a PNF list
(defun DEL-ZERO-COEF (L)
  (cond
    ((null L) nil)
    ((= 0 (caar L)) (DEL-ZERO-COEF (cdr L)))
    (t              (cons (car L) (DEL-ZERO-COEF (cdr L))))
  )
)

;;; This takes a non-negative integer, and returns a string
;;; containing the number of spaces specified by the integer
(defun SPACES (N)
  (do ((N N (1- N))
       (STR (format nil "")))
      ((zerop N) STR)
    (setf STR (concatenate 'string STR " "))
  )
)

;;; This checks if nil was passed. If it was, print a blank line, then
;;; a "0" line. Else pass the list off to the WRITE-POLY1 function.
(defun WRITE-POLY (L)
  (cond
    ((null L) (format t "~%0~%"))
    (t       (WRITE-POLY1 L))
  )
)

;;; Given a list in Polynomial Normal Form, this will print
;;; the human readable form of the list on two lines.
;;; Example:
;;;   INPUT:  ((1 1) (2 3) (-10 0) (3 2) (2 1))
;;;   OUTPUT:      3      2      
;;;   OUTPUT: + 2 x  + 3 x  + 3 x - 10
(defun WRITE-POLY1 (L)
  (do ((L (PNF L) (cdr L))
       (EXP  (format nil ""))
       (COEF (format nil "")))
      ((null L) (format t "~A~%~A~%" EXP COEF))
    (setf COEF (concatenate 'string COEF (WRITE-NUM (caar L) (cadar L))))
    (MAKE-EQUAL EXP COEF)
    (setf EXP  (concatenate 'string EXP  (WRITE-EXP (caar L) (cadar L))))
    (MAKE-EQUAL EXP COEF)
  )
)

;;; Given a coefficient and an exponent, output the correct expression
;;; to represent it.
;;; Examples:
;;; INPUT:  3 4
;;; OUTPUT: + 3 x
;;;
;;; INPUT:  3 0
;;; OUTPUT: + 3
;;;
;;; INPUT:  -3 0
;;; OUTPUT: - 3
(defun WRITE-NUM (NUM EXP)
  (cond
    ; don't output an x if we have a zero exponent
    ((zerop EXP) (if (plusp NUM) (format nil " + ~A" NUM) 
                                 (format nil " - ~A" (abs NUM))))
    ((plusp NUM) (format nil " + ~A x" NUM))
    (t           (format nil " - ~A x" (abs NUM)))
  )
)

;;; Given a coefficient and an exponent, output the exponent.
;;; NOTE: I chose to have the syntax of WRITE-EXP match the syntax of WRITE-NUM
;;;       even though I do not use the parameter NUM in the code. This was for
;;;       uniformity reasons.
(defun WRITE-EXP (NUM EXP)
  (cond
    ((zerop EXP) nil)
    ((= EXP 1)   nil)
    (t           (format nil "~A" EXP))
  )
)

;;; When called with two strings as arguments, this macro expands to
;;; make them the same length, regardless of which is longer.
(defmacro MAKE-EQUAL (S1 S2)
  `(cond
     ((> (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S1) (length ,S2))))
                                    (setf ,S2 (concatenate 'string ,S2 (SPACES DIFF)))))
     ((< (length ,S1) (length ,S2)) (let ((DIFF (- (length ,S2) (length ,S1))))
                                    (setf ,S1 (concatenate 'string ,S1 (SPACES DIFF)))))
     (t                             nil)
   )
)


irasnyd@duallie lisp $ cat hw08test.lisp
; Tests CS 352, Winter 2005, Homework 8.

(defun TEST nil
  (TEST1 nil)
  (TEST1 '((2 1)(1 0)))
  (TEST1 '((3 2)(-1 0)))
  (TEST1 '((5 2)(-4 1)(1 0)))
  (TEST1 '((7 14)(11 13)(-3 2)(7 1)(-5 0)))
  (TEST1 '((1 0)(2 1)(-5 3)(-3 1)(7 0)))
)

(defun TEST1 (P)
  (format t "~s~%" P)
  (WRITE-POLY P)
  (format t "~%")
)

irasnyd@duallie lisp $ clisp -q 

[1]> (load 'hw08.lisp)
;; Loading file hw08.lisp ...
;; Loaded file hw08.lisp
T
[2]> (load 'hw08test.lisp)
;; Loading file hw08test.lisp ...
;; Loaded file hw08test.lisp
T
[3]> (test)
NIL

0

((2 1) (1 0))
          
 + 2 x + 1

((3 2) (-1 0))
      2    
 + 3 x  - 1

((5 2) (-4 1) (1 0))
      2          
 + 5 x  - 4 x + 1

((7 14) (11 13) (-3 2) (7 1) (-5 0))
      14       13      2          
 + 7 x   + 11 x   - 3 x  + 7 x - 5

((1 0) (2 1) (-5 3) (-3 1) (7 0))
      3          
 - 5 x  - 1 x + 8

NIL
[4]> (bye)
irasnyd@duallie lisp $