Guest User

Untitled

a guest
May 17th, 2018
148
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 7.29 KB | None | 0 0
  1. (defun p+ (p1 p2)
  2.   "Adds the two given polynomials together."
  3.     (evaluate-polynomial (concatenate 'list p1 p2)))  
  4.     ; simply concatenates first given polynomial onto the second, and evaluates  
  5.  
  6. (defun p- (p1 p2)
  7.   "Negates the second given polynomial from the first."
  8.     (p+ p1 (p* '((-1)) p2)))
  9.            ; multiples all terms in p2 by -1, and then adds these terms to p1
  10.            
  11. (defun p* (p1 p2 &optional output)
  12.   (if (null p1)
  13.     (return-from p* (evaluate-polynomial output))) ; p1 is exhausted, return output
  14.   (return-from p* (p* (cdr p1) p2 (concatenate 'list output (mapcar #'(lambda (x)
  15.        (cons (* (simplify-coefficient (cons 1 x)) (simplify-coefficient (cons 1 (car p1))))
  16.               ; cons the product of the two polynomial term coefficients and...
  17.               (concatenate 'list (remove-coefficients x) (remove-coefficients (car p1))))  
  18.               ; ...the variables (coupled with their exponents) of the respective polynomial terms                                                              
  19.    ) p2)))))
  20.  
  21. (defun p= (p1 p2)
  22.   "Returns true if the two provided polynomials are equal, NIL otherwise."
  23.   (if (not (eq (list-length (evaluate-polynomial p1)) (list-length (evaluate-polynomial p2))))
  24.     (return-from p= NIL)) ; if evaluated polynomial's lengths are not equal, they themselves cannot be equal
  25.   (check-intersection (evaluate-polynomial p1) (evaluate-polynomial p2)))
  26.    ; checks whether all elements of p1 are contained in p2
  27.  
  28. (defun check-intersection (p1 p2)
  29.   "Recursively checks whether the first element of p1 is contained within p2."
  30.   (if (null p1)
  31.     (return-from check-intersection t))
  32.     ; all elements of p1 must have been found in p2, so polynomials are not equal
  33.   (mapcar #'(lambda (x)
  34.      (if (and (eq (list-length x) (list-length (car p1)))
  35.               (eq (list-length x) (list-length (intersection (car p1) x :test 'equal))))
  36.         (return-from check-intersection (check-intersection (cdr p1) p2)))
  37.         ; if p1 term length = p2 term length = intersection of p1 and p2 terms,
  38.         ; then recurse on cdr of p1
  39.     ) p2)
  40.   (return-from check-intersection NIL))
  41.    ; if first element of p1 is not found anywhere within p2, p1 cannot be equal to p2
  42.  
  43. (defun merge-variables (input &optional output)
  44.   "Recursively collects terms given the original input."
  45.   (if (null input)
  46.     (return-from merge-variables output)) ; input is exhausted, so return output
  47.   (merge-variables
  48.         (remove-nils (mapcar #'(lambda (x)
  49.            (if (not (eq (caar input) (car x)))
  50.              (list x))) input))
  51.         #| new input list will consist of any variables that are not the same as
  52.          the current variable |#
  53.         (check-for-zero-exponential (list (caar input)
  54.           (add-function (remove-nils (mapcar #'(lambda (x)                                  
  55.             (if (eq (caar input) (car x))
  56.              (if (null (cdr x))
  57.                (list 1) ; assume exponent is 1 if none is provided
  58.                (cdr x)))
  59.            ) input)))) output)))
  60.         #| the current variable along with its accumulated exponents of alike variables will
  61.          be concatenated to the output list, given this exponent is non-zero |#
  62.  
  63. (defun remove-nils (input &optional output)
  64.   "Mapcar recurseively maps a function across all elements of a list. If criteria are not fulfilled for a given
  65.  element, it will map to NIL. This function removes NIL from such lists garnered from mapcar."
  66.   (if (null input)
  67.     (return-from remove-nils (reverse output))) ; input exhausted, so return output
  68.   (if (not (null (car input)))
  69.     (return-from remove-nils (remove-nils (cdr input) (concatenate 'list (car input) output)))
  70.     (return-from remove-nils (remove-nils (cdr input) output)))
  71.   )
  72.  
  73. (defun add-function (p &optional result)
  74.   "Summates all numbers in given list p recursively."
  75.   (if (null p)
  76.     (return-from add-function result)) ; input term exhausted, return result
  77.   (if (null result)
  78.     (return-from add-function (add-function (cdr p) (+ (car p) 0)))
  79.     ; cannot add number to NIL, so make result 0
  80.     (return-from add-function (add-function (cdr p) (+ (car p) result)))))
  81.     ; summates all numbers in list recursively
  82.  
  83. (defun check-for-zero-exponential (variable-with-expo output)
  84.   "If exponent is non-zero, append to output. Otherwise, returns the output."
  85.   (if (eq 0 (cadr variable-with-expo))
  86.     (return-from check-for-zero-exponential output)
  87.     ; just return the output list as it was originally provided, if the exponent of the variable is 0
  88.     (return-from check-for-zero-exponential (concatenate 'list output (list variable-with-expo)))))
  89.     ; return the original output list concatenated with the variable-exponent pair
  90.    
  91. (defun group-terms (input &optional output)
  92.   "Groups terms of a polynomial by summing coefficients of terms containing the same variable-exponent pairs."
  93.   (if (null input)
  94.     (return-from group-terms output) ; input exhausted, so return output
  95.     (return-from group-terms (group-terms
  96.         (remove-nils (mapcar #'(lambda (x)  
  97.           (if (not (and (eq (list-length (cdar input)) (list-length (cdr x)))
  98.                         (eq (list-length (cdar input)) (list-length (intersection (cdar input) (cdr x) :test 'equal)))))
  99.             (list x))
  100.             #| if (length term 1 = length term 2 = length of intersection of term 1 and term 2) is NOT true, then        
  101.              term 2 will not group with the current term (term 1).
  102.              this input list will therefore contain all terms that do not group with the current term |#    
  103.         ) input))
  104.         (check-for-zero-coefficient
  105.           (cons (add-function (remove-nils (mapcar #'(lambda (y)
  106.           (if (and (eq (list-length (cdar input)) (list-length (cdr y)))
  107.                    (eq (list-length (cdar input)) (list-length (intersection (cdar input) (cdr y) :test 'equal))))
  108.             (list (car y)))
  109.             ; the summatation coefficients of all terms with matching variable-exponent pairs will be appended to
  110.             ; the current output          
  111.           ) input))) (cdar input)) output)))))
  112.  
  113. (defun check-for-zero-coefficient (term output)
  114.   "Checks whether the coefficient for a term is 0."
  115.   (if (eq 0 (car term))
  116.     (return-from check-for-zero-coefficient output)
  117.     ; do not concatenate term to output if its coefficient is 0
  118.     (return-from check-for-zero-coefficient (concatenate 'list output (list term)))))
  119.     ; concatenate term to output if its coefficient is non-zero
  120.  
  121. (defun simplify-coefficient (term)
  122.   "Returns the product of all coefficients in a given term."  
  123.   (apply #'* (remove-nils (mapcar #'(lambda (x)
  124.         (if (numberp x) ; if only a number, must be a coefficient and not a variable
  125.           (list x))) term))))
  126.  
  127. (defun remove-coefficients (term)
  128.   "Removes all coefficients from a term, leaving only the variables and their exponents, and returns."
  129.   (remove-nils (mapcar #'(lambda (x)
  130.         (if (listp x) ; if element is a list, it must be a variable-exponent pair
  131.           (list x))) term)))
  132.  
  133. (defun evaluate-polynomial (p)
  134.   "Simplifies all coefficients/variables within all polynomial terms, and then groups these terms."
  135.   (group-terms (mapcar #'(lambda (x)
  136.        (cons (simplify-coefficient (cons 1 x)) (merge-variables (remove-coefficients x)))
  137.        ; cons coefficient onto simplified list of variables for that term
  138.    ) p)))
Add Comment
Please, Sign In to add comment