(defun coef (t)
(if (equal t ())
()
(car t)
)
)
(defun var (t)
(if (atom t)
()
(car (cdr t))
)
)
(defun pow (t)
(if (atom t)
(progn (print "t is an atom")
())
(if (atom (cdr t))
(progn (print "cdr t is an atom")
()
(car (cdr (cdr t))))
)
)
)
(defun p*aux (p q p1 q1) ;this auxilary function does the actual multiplication
(progn
(print "paux loaded")
(cond
((equal 0 (coef p)) ;we may cancel if either coef is zero
())
((equal 0 (coef q))
())
((equal (var p) (var q)) ;standard multiply if we are working in the same variable
(progn
(print "samevariablefun")
(cons (cons (cons (* (coef p) (coef q))
(var p)
)
(+ (pow p) (pow q))
)
(p*auxplus p1 (cdr q1))
)
)
) ;standard multiplication in one variable
(t ;this will only execute if we are working in different variables
(progn
(print "diffvar")
(cons (cons (* (coef p) (coef q))
(append (cons (var p)
(var q)
)
(cons (pow p)
(pow q)
)
)
);multiply as normal, careful with separate powers
(p*auxplus p1 (cdr q1))
)
)
)
)
)
)
(defun p* (p q) ;this is the function that will be called
(progn
(print "start")
(setq result '()) ;we create an empty list to hold the results in
(print "result has been set")
(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
(progn
(print "pauxplus")
(if (equal p '())
()
(if (equal q '()) ; we want to stop if we run out of terms to multiply
()
(progn
(print "multiplyingthingys")
(cons (p*aux (car p) (car q) p q) ;multiply the first two terms together
(p*auxplus (cdr p) q) ;this step ensures 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
(cons (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 coef (t)
(car t))
(defun var (t)
(car (cdr t)))
(defun pow (t)
(car (cdr (cdr t))))
(defun collectaux (p q) ;collects first "collecting" term of q with p
(if (equal q '())
() ;loop terminates here
(if (and (equal (var p) (var (car q))) (equal (pow p) (pow (car q)))) ;if so, we can add them together
(progn
(setq nonadder (cons nonadder
(cdr q)
)
);loop ends so we need to keep the terms we haven't added
(cons (+ (coef p) (coef (car q))) ;add the coefficients
(cons (var p) ;and append them with the var
(pow p) ;and the pow
)
)
)
(progn
(setq nonadder (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
(if (equal p '())
()
(progn
(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)))
)
)