Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun p+ (p1 p2)
- "Adds the two given polynomials together."
- (evaluate-polynomial (concatenate 'list p1 p2)))
- ; simply concatenates first given polynomial onto the second, and evaluates
- (defun p- (p1 p2)
- "Negates the second given polynomial from the first."
- (p+ p1 (p* '((-1)) p2)))
- ; multiples all terms in p2 by -1, and then adds these terms to p1
- (defun p* (p1 p2 &optional output)
- (if (null p1)
- (return-from p* (evaluate-polynomial output))) ; p1 is exhausted, return output
- (return-from p* (p* (cdr p1) p2 (concatenate 'list output (mapcar #'(lambda (x)
- (cons (* (simplify-coefficient (cons 1 x)) (simplify-coefficient (cons 1 (car p1))))
- ; cons the product of the two polynomial term coefficients and...
- (concatenate 'list (remove-coefficients x) (remove-coefficients (car p1))))
- ; ...the variables (coupled with their exponents) of the respective polynomial terms
- ) p2)))))
- (defun p= (p1 p2)
- "Returns true if the two provided polynomials are equal, NIL otherwise."
- (if (not (eq (list-length (evaluate-polynomial p1)) (list-length (evaluate-polynomial p2))))
- (return-from p= NIL)) ; if evaluated polynomial's lengths are not equal, they themselves cannot be equal
- (check-intersection (evaluate-polynomial p1) (evaluate-polynomial p2)))
- ; checks whether all elements of p1 are contained in p2
- (defun check-intersection (p1 p2)
- "Recursively checks whether the first element of p1 is contained within p2."
- (if (null p1)
- (return-from check-intersection t))
- ; all elements of p1 must have been found in p2, so polynomials are not equal
- (mapcar #'(lambda (x)
- (if (and (eq (list-length x) (list-length (car p1)))
- (eq (list-length x) (list-length (intersection (car p1) x :test 'equal))))
- (return-from check-intersection (check-intersection (cdr p1) p2)))
- ; if p1 term length = p2 term length = intersection of p1 and p2 terms,
- ; then recurse on cdr of p1
- ) p2)
- (return-from check-intersection NIL))
- ; if first element of p1 is not found anywhere within p2, p1 cannot be equal to p2
- (defun merge-variables (input &optional output)
- "Recursively collects terms given the original input."
- (if (null input)
- (return-from merge-variables output)) ; input is exhausted, so return output
- (merge-variables
- (remove-nils (mapcar #'(lambda (x)
- (if (not (eq (caar input) (car x)))
- (list x))) input))
- #| new input list will consist of any variables that are not the same as
- the current variable |#
- (check-for-zero-exponential (list (caar input)
- (add-function (remove-nils (mapcar #'(lambda (x)
- (if (eq (caar input) (car x))
- (if (null (cdr x))
- (list 1) ; assume exponent is 1 if none is provided
- (cdr x)))
- ) input)))) output)))
- #| the current variable along with its accumulated exponents of alike variables will
- be concatenated to the output list, given this exponent is non-zero |#
- (defun remove-nils (input &optional output)
- "Mapcar recurseively maps a function across all elements of a list. If criteria are not fulfilled for a given
- element, it will map to NIL. This function removes NIL from such lists garnered from mapcar."
- (if (null input)
- (return-from remove-nils (reverse output))) ; input exhausted, so return output
- (if (not (null (car input)))
- (return-from remove-nils (remove-nils (cdr input) (concatenate 'list (car input) output)))
- (return-from remove-nils (remove-nils (cdr input) output)))
- )
- (defun add-function (p &optional result)
- "Summates all numbers in given list p recursively."
- (if (null p)
- (return-from add-function result)) ; input term exhausted, return result
- (if (null result)
- (return-from add-function (add-function (cdr p) (+ (car p) 0)))
- ; cannot add number to NIL, so make result 0
- (return-from add-function (add-function (cdr p) (+ (car p) result)))))
- ; summates all numbers in list recursively
- (defun check-for-zero-exponential (variable-with-expo output)
- "If exponent is non-zero, append to output. Otherwise, returns the output."
- (if (eq 0 (cadr variable-with-expo))
- (return-from check-for-zero-exponential output)
- ; just return the output list as it was originally provided, if the exponent of the variable is 0
- (return-from check-for-zero-exponential (concatenate 'list output (list variable-with-expo)))))
- ; return the original output list concatenated with the variable-exponent pair
- (defun group-terms (input &optional output)
- "Groups terms of a polynomial by summing coefficients of terms containing the same variable-exponent pairs."
- (if (null input)
- (return-from group-terms output) ; input exhausted, so return output
- (return-from group-terms (group-terms
- (remove-nils (mapcar #'(lambda (x)
- (if (not (and (eq (list-length (cdar input)) (list-length (cdr x)))
- (eq (list-length (cdar input)) (list-length (intersection (cdar input) (cdr x) :test 'equal)))))
- (list x))
- #| if (length term 1 = length term 2 = length of intersection of term 1 and term 2) is NOT true, then
- term 2 will not group with the current term (term 1).
- this input list will therefore contain all terms that do not group with the current term |#
- ) input))
- (check-for-zero-coefficient
- (cons (add-function (remove-nils (mapcar #'(lambda (y)
- (if (and (eq (list-length (cdar input)) (list-length (cdr y)))
- (eq (list-length (cdar input)) (list-length (intersection (cdar input) (cdr y) :test 'equal))))
- (list (car y)))
- ; the summatation coefficients of all terms with matching variable-exponent pairs will be appended to
- ; the current output
- ) input))) (cdar input)) output)))))
- (defun check-for-zero-coefficient (term output)
- "Checks whether the coefficient for a term is 0."
- (if (eq 0 (car term))
- (return-from check-for-zero-coefficient output)
- ; do not concatenate term to output if its coefficient is 0
- (return-from check-for-zero-coefficient (concatenate 'list output (list term)))))
- ; concatenate term to output if its coefficient is non-zero
- (defun simplify-coefficient (term)
- "Returns the product of all coefficients in a given term."
- (apply #'* (remove-nils (mapcar #'(lambda (x)
- (if (numberp x) ; if only a number, must be a coefficient and not a variable
- (list x))) term))))
- (defun remove-coefficients (term)
- "Removes all coefficients from a term, leaving only the variables and their exponents, and returns."
- (remove-nils (mapcar #'(lambda (x)
- (if (listp x) ; if element is a list, it must be a variable-exponent pair
- (list x))) term)))
- (defun evaluate-polynomial (p)
- "Simplifies all coefficients/variables within all polynomial terms, and then groups these terms."
- (group-terms (mapcar #'(lambda (x)
- (cons (simplify-coefficient (cons 1 x)) (merge-variables (remove-coefficients x)))
- ; cons coefficient onto simplified list of variables for that term
- ) p)))
Add Comment
Please, Sign In to add comment