(defun p*aux (p q) ;this auxilary function does the actual multiplication
(cond
((equal 0 (coef p)) ;we may cancel if either coef is zero
(cons result ()))
((equal 0 (coef q))
(cons result ()))
((equal (var p) (var q)) ;standard multiply if we are working in the same variable
(cons result
((* (coef p) (coef q)) (var p) ((+ (pow p) (pow q))))
)) ;standard multiplication in one variable
(t ;this will only execute if we are working in different variables
(cons result
(cons (* (coef p) (coef q))
(cons (cons (var p)
(var q)
)
(cons (pow p)
(pow q)
)
)
) ;multiply as normal, careful with separate powers
)
)
)
)
(defun p* (p q) ;this is the function that will be called
(progn
(setq result '()) ;we create an empty list to hold the results in
(collect (p*auxplus (p q))) ;notice we collect afterwards to make sure we have no repeated terms
)
)
(defun p*auxplus (p q) ;extra auxilary function to run p*aux on every pair of elements
(if ((equal p '()) or (equal q '())) ; we want to stop if we run out of terms to multiply
()
(progn
(p*aux (car p) (car q)) ;multiply the first two terms together
(p*auxplus ((cdr p) q)) ;these steps ensure
(p*auxplus (p (cdr q))) ;we have properly cross-multiplied
)
)
)
(defun p+ (p q)
(collect (append p q)) ;collect adds like terms together, so we may simply append q to p
)
(defun p- (p q)
(p+ (p (negate q))) ;a-b=a+(-b), so we use an existing function to add, and use an aux function to find (-b)
)
(defun negate (p)
(if (equal p ()) ;stop when our list empties
()
(cons (cons (- 0 (coef (car p))) ;take the negative of the coef of car p
(var (car p)) ;affix it to the var
(pow (car p)) ;and the pow
)
(negate (cdr p)) ;now affix this (now negative) term to the rest of the terms
)
)
)
(defun collectaux (p q) ;this auxilary function runs through all terms of q to compare p with, adds the first term that will add to p, and keeps the rest in nonadder
(if (equal q '())
() ;loop terminates here
(if ((var (coef p) (var (car q))) and (equal (pow p) (pow (car q)))) ;if so, we can add them together
(progn
(cons (+ (coef p) (coef (car q))) ;add the coefficients
(cons (var p) ;and append them with the var
(pow p)
) ;and the pow
)
(cons nonadder
(cdr q)
) ;loop ends so we need to keep the terms we haven't added
)
(progn
(cons nonadder
(car q)
) ;car q won't add to p, so put it here
(collectaux (cdr q)) ;check through the rest of q
)
)
)
)
(defun collectauxplus (p) ;this auxilary function runs collaux on our list until all terms have been added
(progn
(if (equal p '())
()
(setq nonadder ()) ;we keep the values that won't collect in here
(setq collaux (collectaux ((car p) (cdr p)))) ;we will use this value more than once, so store it
(if (equal collaux '())
(cons (car p)
(collectauxplus (nonadder)))
(cons collaux
(collectauxplus (nonadder)))
)
)
)
)
(defun collect (p) ;this runs collectauxplus again and again until we see no changes- i.e. we have fully collected our terms.
(progn
(setq cap (collectauxplus (p))) ;load this value once as we use it twice
(if (equal p cap)
p
(collect cap)
)
)
)
(defun psortaux (p) ;standard bubblesort algorithm
(progn
(collect p) ;make sure our terms are collected first
(if (>= (pow (car p)) (pow (cadr p))) ;compare the powers
(cons (car p) (psort (cdr p))) ;don't swap if they're in the right order
(cons (cdr p) (psort (cons (car p) (cddr p)))) ;do swap if they aren't
)
)
)
(defun psort (p) ;this runs psortaux again and again until we see no changes- i.e. we have fully sorted our terms.
(progn
(setq pso (psortaux (p)))
(if (equal p pso)
p
(psort pso)
)
)
)
(defun p= (p q)
(progn
(setq p1 (psort (collect p))) ;sort and collect both
(setq q1 (psort (collect q))) ;polynomials, this makes things easier
(if (equal (leng p1) (leng p2)) ;if they're not the same length, they're not the same polynomial
(p=aux (p1 q1)) ;refer to an aux function
()
)
)
)
(defun p=aux (p q)
(cond ((equal (p) '()) ;if we have found no nonequal terms
t) ;they are the same
((equal (car p) (car q)) ;if two terms are the same
(peq (cdr p) (cdr q))) ;check the next term
(t ;in any other case
()) ;the polynomials are nonequal
)
)
(defun pd (p wrt) ;derivative function taking a polynomial, and a variable to differentiate With Respect To
(if (equal p '())
()
(if (equal (var (car p)) wrt) ;if it's a term we want to differentiate
(cons (cons (* (pow p) (coef p))
(cons (wrt)
(- (pow p) 1) ;differentiate it!
)
)
(pd (cdr p) wrt)
)
(cons nil (pd (cdr p) wrt)) ;otherwise, it goes to zero
)
) ;note that after each term, we differentiate the next
) ;until we hit nil, at which point we stop
(defun leng (p) ;simple algorithm to find the length of a list
(if (equal p ()) ;useful for comparing polynomials in p=
0
(+ 1 (leng (cdr p)))
)
)