CSE 341 -- Assignment 3 solution



;;; print-polynomial
;;; ----------------
;;; take a lisp expression in a single variable and print
;;; it in polynomial form. first we normalize it, then symplify it,
;;; and then print the resulting terms.

(defun print-polynomial (exp sym) 
   (print-terms (simplify (normalize exp sym)) sym))




;;; -------------
;;; -------------
;;; NORMALIZATION
;;; -------------
;;; -------------


;;; coef expo
;;; ---- ----
;;; accessors for a term.  they return the coefficient and the exponet
;;; respectively for a given term.

(defun coef (term) (first term))
(defun expo (term) (second term))


;;; normalize
;;; ---------
;;; The idea behind normalization is to recursively turn a mathematical
;;; expression in lisp form to a list of terms where terms are of the 
;;; form (coefficient exponent)

(defun normalize (e sym)
   (cond ((numberp e) (list (list e 0))) ;n normalizes to (n 0)
         ((equal e sym) (list (list 1 1))) ;sym normalizes to (1 1)
         ((atom e) (error "undefined atom")) ;any other atom is undefined
         ((equal (first e) '+) (plus-normalize (rest e) sym)) ;normalize for +
         ((equal (first e) '-) (minus-normalize (rest e) sym));normalize for -
         ((equal (first e) '*) (mult-normalize (rest e) sym)) ;normalize for *
         ((equal (first e) 'expt) (expt-normalize (rest e) sym)) ;normalize for expt
         (t (error "bad input")))) ;anything else is bad input
   
;;; plus-normalize
;;; --------------
;;; takes a list of arguments, normalizes each argument, and
;;; appends the results together.
          
(defun plus-normalize (args sym) 
   (cond ((null args) (list (list 0 0)))
         (t (append (normalize (first args) sym) 
                  (plus-normalize (rest args) sym)))))

;;; minus-normalize
;;; ---------------
;;; takes a list of arguments to minus and normalizes each argument then 
;;; appends the results of normalizing each argument into one list of
;;; terms.  when there is one argument to - we must negate each term in
;;; the normalized argument.  when there is more than one term we don't
;;; negate the first argument's terms but normalize all the rest and then
;;; negate them appending the results together.          

(defun minus-normalize (args sym) 
   (cond ((null args) (error "no arguments to -"))
         ((null (rest args)) (negate (normalize (first args) sym)))
         (t (append (normalize (first args) sym) 
                    (negate (plus-normalize (rest args) sym))))))

;;; negate
;;; ------
;;; takes a normalized expression (a list of terms) and negates each term
;;; a term is negated by negating the coefficient i.e. (first pair)

(defun negate (s) 
   (mapcar #'(lambda (pair) (list (- (coef pair)) (expo pair))) s))


;;; mult-normalize
;;; -------------- 
;;; the first argument to mult normalize should be normalized  
;;; to a list of terms. Then we must multiply this list of terms
;;; by the list of terms which is the result of mult-normalizing the 
;;; rest of the arguments.  The multiplicitively normalized form of 
;;; no arguments is one: (1 0)

(defun mult-normalize (args sym)
   (cond ((null args) (list (list 1 0)))
         (t (mult-lists (normalize (first args) sym) 
                        (mult-normalize (rest args) sym)))))

;;; mult-lists
;;; ----------
;;; two multiply two lists of terms we need to multiply each term
;;; in the first list by the second list and create a new list
;;; of these terms.

(defun mult-lists (s1 s2) 
   (cond ((null s1) nil)
         (t (append (mult-term-list (first s1) s2)
                    (mult-lists (rest s1) s2)))))


;;; mult-term-list
;;; --------------
;;; two multiply a term by a list we must make a list of
;;; the results of multiplying the term by every term in the
;;; list          

(defun mult-term-list (term s) 
   (cond ((null s) nil)
         ((cons (mult-terms term (first s))
                (mult-term-list term (rest s))))))

;;; mult-terms
;;; ----------
;;; to multiply two terms we make a new term by multiplying
;;; coeffiecients and adding exponents
               
(defun mult-terms (term1 term2)
   (list (* (coef term1) (coef term2)) 
         (+ (expo term1) (expo term2))))


;;; expt-normalize
;;; --------------
;;; normalize the expression and call a helper function

(defun expt-normalize (args sym) 
   (cond ((null args) (error "expt: no args"))
         ((null (rest args)) (error "expt: only one arg"))
         ((not (null (rest (rest args)))) (error "expt: too many args"))
         (t (let ((p (second args)) ;grab the exponent
                  (e (first args))) ;grab the expression
               (if (or (not (integerp p)) (< p 0)) ;make sure the exponent is in
                                                   ;the legal range
                  (error "expt: bad exponent")
                  (expt-multiply (normalize e sym) p))))))

;;; expt-multiply
;;; -------------
;;; if the exponent is zero then we return (1 0)
;;; otherwise we multiply the normalized term list by itself p times.

(defun expt-multiply (terms p)
   (cond ((zerop p) (list (list 1 0)))
         (t (mult-lists terms (expt-multiply terms (- p 1))))))



;;; --------------
;;; --------------
;;; SIMPLIFICATION
;;; --------------
;;; --------------



;;; simplify
;;; --------
;;; takes a list of terms and returns a simplified list of terms
;;; removes all the terms with zero coefficients, collects and adds like
;;; terms and then sorts them in descending order. Use 
;;; collect-terms2 for a recursive implementation
;;; use collect-terms for an applicative implementation

(defun simplify (terms) 
   (sort-terms (remove-zeros (collect-terms terms))))
                             

;;; collect-terms
;;; -------------
;;; takes a list of terms, groups the terms by exponent and then reduces
;;; each term-list to a single term by adding.

(defun collect-terms (terms)
   (mapcar #'(lambda (term-list) (add-like-terms term-list)) 
      (group-terms terms)))


;;; remove-zeros
;;; ------------
;;; returns a list of terms with all zero coef terms removed                    

(defun remove-zeros (terms)
   (remove-if #'(lambda (x) (zerop (coef x))) terms))


;;; sort-terms
;;; ----------
;;; sorts all the terms in descending order of exponent

(defun sort-terms (terms) 
   (stable-sort terms #'(lambda (t1 t2) (> (expo t1) (expo t2)))))
   

;;; group-terms 
;;; ---------------
;;; takes a list of terms and groups those terms by exponent into lists
;;; (group-terms '((1 2) (3 4) (8 2) (4 5) (1 2))) ==>
;;;               (((1 2) (8 2) (1 2)) ((3 4)) ((4 5)))
;;; makes a partition and then cons the first element of the partition
;;; onto the result of calling group-terms on the rest of the terms 

(defun group-terms (terms)
   (cond ((null terms) nil)
         (t (let ((part (make-partition terms)))
               (cons (first part) (group-terms (rest part))))))) 
 

;;; add-like-terms
;;; --------------
;;; takes a list of terms which it assumes have the same exponent and
;;; reduces that to a term which has the original exponent and a coef
;;; equal to the sum of the coefficients of the terms.                  

(defun add-like-terms (terms)
   (reduce #'(lambda (term1 term2) 
                     (list (+ (coef term1) (coef term2)) (expo term1)))
      terms))


;;; make-partition
;;; --------------
;;; takes a list of terms and creates a partition in the following manner
;;; the partitions first element is a list of all the terms with the 
;;; the same exponent as the first term in the original list. 
;;; the rest of the elements in the partition did not have the same 
;;; exponent as the first term in the original list.
;;; (make-partition '((1 2) (3 4) (8 2) (4 5) (1 2))) ==>
;;;                  (((1 2) (8 2) (1 2)) (3 4) (4 5)) 
;;; this function is not as efficient as it could be but I wanted to
;;; throw in some applicative programming.
 
(defun make-partition (terms)
   (let ((expo-test #'(lambda (term) 
                         (equal (expo (first terms)) (expo term)))))
      (cons (remove-if-not expo-test terms) ;the terms with the expo
            (remove-if expo-test terms)))) ;the terms without the expo


;;; collect-terms
;;; -------------
;;; takes a list of terms and adds up the coefficients
;;; of all the terms with common exponents to make a simplified
;;; list of terms where no two terms have the same exponent

(defun collect-terms2 (terms)
   (if (null terms) nil
      (cons (collect-first-term terms)
         (collect-terms2 (remove-if #'(lambda (term) 
             (equal (expo term) (expo (first terms)))) terms)))))


;;; collect-first-term 
;;; ------------------
;;; returns a term which has the sum of all the coefficients of terms
;;; with the first term's exponent, as its coefficient and the first 
;;; first term's exponent as its exponent.

(defun collect-first-term (terms) 
   (list (add-term (expo (first terms)) terms)
         (expo (first terms))))


;;; add-term
;;; --------
;;; returns the sum of all the coefficients of the terms whose exponent
;;; matches ex

(defun add-term (ex terms)
   (cond ((null terms) 0)
         ((equal (expo (first terms)) ex) 
          (+ (first (first terms)) 
             (add-term ex (rest terms))))
         (t (add-term ex (rest terms)))))



;;; --------
;;; --------
;;; PRINTING
;;; --------
;;; --------



;;; print-terms
;;; -----------
;;; we only want to print the first sign if it is negative
;;; print the first term and then use print-help to print the rest
;;; also takes into account the special case where the answer is 
;;; zero                    

(defun print-terms (terms sym)
   (format t "~&") ;start a fresh line
   (cond ((null terms) (print 0)) ;print the first term
         ((< (coef (first terms)) 0)
          (print-sign (first terms))
          (print-term (first terms) sym)
          (print-help (rest terms) sym))
         (t (print-term (first terms) sym)
            (print-help (rest terms) sym))))


;;; print-help
;;; ----------
;;; takes a list of terms and a symbol and prints all the terms
;;; preceeded by the appropriate sign

(defun print-help (terms sym)
   (cond ((null terms) nil)
         (t (print-sign (first terms))
            (print-term (first terms) sym)
            (print-help (rest terms) sym))))

               
;;; print-term
;;; ----------
;;; we print the coefficient if it is not 1 or -1, or if
;;; the exponent is zero, otherwise we leave it out 
;;; we print the multiplication sign only if the exponent is
;;; not zero and we have printed the coef.
;;; we print the symbol if the exponent is not zero.
;;; we print the exponent if it is not one or zero. 
      
(defun print-term (term sym)
   (cond ((or (not (equal (abs (coef term)) 1)) 
              (equal (expo term) 0)) 
          
          ;;this is the case where we want to print the coefficient.
          (if (< (coef term) 0)
             
             ;;if the coefficient is negative then the
             ;;minus should be there already
             (format t "~A" (abs (coef term)))
             (format t "~A" (coef term)))
          
          ;;now we want to print the '*' sign if the exponent is not
          ;;zero
          (if (not (zerop (expo term))) 
             (format t "*"))))
          
   ;;now print the symbol and its exponent.
   (cond ((not (zerop (expo term)))      
          (format t "~A" sym) 
          
          ;;if the exponent is not one then print the exponent
          (if (not (equal (expo term) 1)) 
             (format t "**~A" (expo term))))))


;;; print-sign
;;; ----------
;;; prints the appropriate sign based on the sign of the coefficient

(defun print-sign (term)
   (if (< (coef term) 0)
      (format t " - ")
      (format t " + ")))


;;; some samples to try

(print-polynomial '(expt (+ x 1) 2) 'x)
(print-polynomial '(* ( + x 1 3) (* 3 x x)) 'x)
(print-polynomial '(* (+ x 1) (- x 1)) 'x)
(print-polynomial '(+ (* (+ x x) 0) 4) 'x)
(print-polynomial '(+ x 3 -3) 'x)
(print-polynomial '(* (- x 2) (+ 3 x) (expt (+ x 1 2 3) 2) (- x 2 3 x x)) 'x)