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)