Subversion Repositories programming

;Written By: Ira Snyder
;Due Date:   02-16-2005
;Homework #: hw08

;;; 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)) (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 " "))
  )
)

(defun WRITE-POLY (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)
  )
)

(defun WRITE-NUM (NUM EXP)
  (cond
    ((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)))
  )
)

(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.
(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)
   )
)