It's a bold move to do what this does, building a Computer Algebra System from scratch, but I'm doing it anyway. I've chosen to do this because I wanted to understand how most CASs work, and that can be accomplished by either reading thhe source code for one, or by building one. While there are several very good CASs, the majority of them are non-free, and thus I'm not able to learn how exactly they work. Those that are free software are either not complete, or are too complex to be able to learn from easily.
This is my Computer Algebra System, and it contains the following components:
Common Functionality
Expression Typing
Algebraic Manipulation
Symbolic Differentiation
Symbolic To Typeset Form
Library Assembly
CLOSED: [2016-06-09 Thu 12:48]
The CAS contained in this is called LARCS, or the Lisp Automated Rewrite and Calculation System. This describes the system as follows:
The CAS is written in Lisp. This is not novel, as other CAS have been written in Lisp before (Macsyma/Maxima), but it is unusual in that most new ones have been written in other languages.
The CAS will perform rewrites and calculations automatically.
The system is built on the concept of a rewrite system. This workse because to perform many actions in the algebra, you rewrite an equation in one way or another.
The ability to go from a symbolic equation, something like $33 + x^2 + 10x - 3$ (+ (* 3 (expt x 3)) (expt x 2) (* 10 x) -3)~), to the result where $xgets 4$ 45).
A complete library and application for symbolic algebra.
[3/3]
There are several bits of common functions or variables that are required for use. This primarily includes functions that some of the macros rely on, or things that are required for use in other parts of the system, but don't present as specific functionality.
CLOSED: [2016-07-30 Sat 16:08]
For some macros, an arguments list must be generated. This is done by generating a list of variables starting with the word expression-
followed by a letter from the alphabet, in turn.
(defun gen-args-list (count) (let ((letters '(a b c d e f g h i j k l m n o p q r s t u v w x y z))) (let ((variables-list '())) (dotimes (i count) (pushnew (symbolicate 'expression- (nth i letters)) variables-list)) (reverse variables-list))))
CLOSED: [2016-08-05 Fri 21:32]
This is a mapping between the names of constants and the way that they are correctly displayed in TeX. Besides defining the mapping, which is in the form of an alist, it also collects the names of all of the constants, and exports the names themselves.
(defvar *special-symbols-to-sequences* '((alpha . "\\alpha") (beta . "\\beta") (gamma . "\\gamma") (delta . "\\delta") (epsilon . "\\epsilon") (varepsilon . "\\varepsilon") (zeta . "\\zeta") (eta . "\\eta") (theta . "\\theta") (vartheta . "\\vartheta") (gamma . "\\gamma") (kappa . "\\kappa") (lambda . "\\lambda") (mu . "\\mu") (nu . "\\nu") (xi . "\\xi") (omicron . "\\o") (pi . "\\pi") (varpi . "\\varpi") (rho . "\\rho") (varrho . "\\varrho") (sigma . "\\sigma") (varsigm . "\\varsigm") (tau . "\\tau") (upsilon . "\\upsilon") (phi . "\\phi") (varphi . "\\varphi") (chi . "\\chi") (psi . "\\psi") (omega . "\\omega") (big-gamma . "\\Gamma") (big-delta . "\\Delta") (big-theta . "\\Theta") (big-lambda . "\\Lambda") (big-xi . "\\Xi") (big-pi . "\\Pi") (big-sigma . "\\Sigma") (big-upsilon . "\\Upsilon") (big-phi . "\\Phi") (big-psi . "\\Psi") (big-omega . "\\Omega"))) (defvar *constant-names* (mapcar #'car *special-symbols-to-sequences*)) (mapcar #'export *constant-names*)
CLOSED: [2016-07-30 Sat 15:43]
This is where the common functions and constants are assembled into their own package. Almost all of the functions and variables are exported and available for everything else.
(in-package #:larcs.common) <<common-generate-an-args-list>> <<constants-and-greeks>>
[8/8]
To be able to provide various forms of matching and manipulation, the type of an expression must be determined. This is done by analyzing the contents of the expression. To accomplish this, there must be a way to define a classifier, store all possible classifiers, check a classifier and produce a classification. To provide more flexibility in programming, there is also a special version of case, called classification-case
and a when-pattern macro called when-classified-as
.
CLOSED: [2016-06-14 Tue 23:00]
Classifications are defined as define-classification
. This macro takes a name
, which is the name of the classification, and a body, which is classified within a function. Inside the function, the following are bound: expression
, the expression to be classified; and, length
, which is the length of the expression if it's a list, otherwise, 0 if it's atomic. A cons cell containing the name of the classification and the name of the classifier is pushed onto classification storage, and the classifier name is exported.
(defmacro define-classification (name &body body) (check-type name symbol) (let ((classifier-name (symbolicate name '-classifier))) `(progn (defun ,classifier-name (expression &aux (length (if (listp expression) (length expression) 0))) (declare (ignorable length)) ,@body) (pushnew '(,name . ,classifier-name) *classifications*) (export ',name) ',name)))
CLOSED: [2016-06-14 Tue 23:10]
To classify an expression, the expression and name of the possible classification is passed in. If the given name of the classification is *
, then t
is returned, as this is a catch all; otherwise the classification is retrieved by name, and the expression is passed to the classifier, which will return either t
or nil
.
(defun classified-as-p (expression classification) (if (eq '* classification) t (funcall (cdr (assoc classification *classifications*)) expression)))
CLOSED: [2016-06-14 Tue 23:23]
While being able to check if an expression is given a specific classification is vital, for some things, being able to see what all possible classifications for an expression are can be quite useful. To do this, an expression is passed in, and for each possible classification in the classification storage, it is checked to see whether or not the classification is possible. If it is, the classification is pushed on to a list of valid classifications. When the possible classifications are exhausted, the list of valid classifications is reversed and returned.
(defun classify (expression) (let ((classifications '())) (dolist (possible ,*classifications* (reverse classifications)) (let ((name (car possible)) (checker (cdr possible))) (when (funcall checker expression) (push name classifications))))))
CLOSED: [2016-06-14 Tue 23:34]
Because case is such a useful tool, and because it provides a way to ensure that an expression doesn't fall through when acting on it, I've written the classification-case
macro. It takes an expression, named var
and a list of cases, in the form of (classification body-form-1 body-form-2 body-form-n)
. It transforms the cases, converting them to the form ((classified-as-p expression 'type) body-form-1 body-form-2 body-form-n)
. It finally expands to a cond
in which the-classification
is bound to the full and complete classification of the passed expression.
(defmacro classification-case (var &rest cases) (let ((conditions (map 'list #'(lambda (case) (destructuring-bind (type &body body) case (if (eq type 't) `((classified-as-p ,var '*) ,@body) `((classified-as-p ,var ',type) ,@body)))) cases))) `(let ((the-classification (classify ,var))) (declare (ignorable the-classification)) (cond ,@conditions))))
CLOSED: [2016-06-14 Tue 23:44]
Another utility macro is when-classified-as
, which takes a classification
, an expressiond named variable
and a body. It expands fairly simply to a when
form, with the predicate taking the following form (classified-as-p variable 'classification)
, wrapping around the passed in body.
(defmacro when-classified-as (classification variable &body body) `(when (classified-as-p ,variable ',classification) ,@body))
[13/13]
I define the following classifications:
All numbers
Any symbols
Anything that isn't simply a number or a variable
Expressions that are adding multiple terms
Expressions subtracting multiple terms
Expressions of the form $x$,here $xis a variable, and $nis a numeric.
Expressions of the form $x$ $e$,here $xand $yare generic expressions, and $eis Euler's constant.
Expressions of the form of $\ x$ $\g_b x$,here $xand $bare generic expressions.
Expressions of the form $\ac{f(x)}{g(x)}$.
Any integers, multiplicatives of the form $nm$ powers of the form $x$,here $xis a variable and $nand $mare numerics.
Additives or Subtractives consisting solely of Polynomial Terms.
The trig functions: $\n$,cos$,tan$,csc$,sec$ d $\t$.
<<et-classify-numbers>> <<et-classify-variables>> <<et-classify-non-atomics>> <<et-classify-additives>> <<et-classify-subtractives>> <<et-classify-powers>> <<et-classify-exponentials>> <<et-classify-multiplicatives>> <<et-classify-logarithmics>> <<et-classify-rationals>> <<et-classify-polynomial-term>> <<et-classify-polynomials>> <<et-classify-trigonometrics>>
CLOSED: [2016-06-14 Tue 23:58]
A number is defined as anything that satisfies the built-in numberp
. This includes integers, rationals, floats and complex numbers.
(define-classification numeric (numberp expression))
CLOSED: [2016-06-15 Wed 00:00]
Variables are defined as anything that satisfies the Common Lisp predicate, symbolp
.
(define-classification variable (symbolp expression))
CLOSED: [2016-06-15 Wed 00:02]
Non-atomic is a classification for anything other than numerics and variables. It is defined as anything that satisfies the predicate listp
.
(define-classification non-atomic (listp expression))
CLOSED: [2016-06-15 Wed 00:03]
When an expression is non-atomic, and the first element is the symbol +
, it is classified as an additive expression.
(define-classification additive (when-classified-as non-atomic expression (eq '+ (first expression))))
CLOSED: [2016-06-15 Wed 00:06]
A non-atomic expression for which the first element is the symbol -
is a subtractive expression.
(define-classification subtractive (when-classified-as non-atomic expression (eq '- (first expression))))
CLOSED: [2016-06-15 Wed 00:07]
A power is any expression that is non-atomic, the first element is the symbol expt
, the second is a variable and the third is a numeric.
(define-classification power (when-classified-as non-atomic expression (and (eq 'expt (first expression)) (classified-as-p (second expression) 'variable) (classified-as-p (third expression) 'numeric))))
CLOSED: [2016-06-15 Wed 00:11]
There are two types of exponentials, natural and non-natural. Natural exponentials are defined as being non-atomic, two elements long, and the first element being exp
. Non-natural exponentials are defined similarly, but are three elements long, and the first of which is the symbol expt
.
(define-classification natural-exponential (when-classified-as non-atomic expression (and (= 2 length) (eq 'exp (first expression))))) (define-classification exponential (when-classified-as non-atomic expression (and (= 3 length) (eq 'expt (first expression)))))
CLOSED: [2016-06-15 Wed 00:12]
A multiplicative expression is non-atomic, of any length, and the first element is the symbol *
.
(define-classification multiplicative (when-classified-as non-atomic expression (eq '* (first expression))))
CLOSED: [2016-06-15 Wed 00:14]
There are two types of logarithmic classifications, natural and non-natural. Natural logarithmics are non-atomic, two elements long, and the first element is the symbol log
. Natural logarithmics are also non-atomic, but they are three elements long, starting with the symbol log
.
(define-classification natural-logarithmic (when-classified-as non-atomic expression (and (= 2 length) (eq 'log (first expression))))) (define-classification logarithmic (when-classified-as non-atomic expression (and (= 3 length) (eq 'log (first expression)))))
CLOSED: [2016-06-15 Wed 00:15]
Rationals are non-atomic, three elements long, and the first element is the symbol /
.
(define-classification rational (when-classified-as non-atomic expression (and (= 3 length) (eq '/ (first expression)))))
CLOSED: [2016-06-15 Wed 00:17]
Polynomials are a compound classification:
Numerics
Variables
Powers
Multiplicatives that are a numeric and a variable
Multiplicatives that are a numeric and a power
(define-classification polynomial-term (or (classified-as-p expression 'numeric) (classified-as-p expression 'variable) (classified-as-p expression 'power) (and (classified-as-p expression 'multiplicative) (= (length (rest expression)) 2) (or (and (classified-as-p (second expression) 'numeric) (or (classified-as-p (third expression) 'power) (classified-as-p (third expression) 'variable))) (and (classified-as-p (third expression) 'numeric) (or (classified-as-p (second expression) 'power) (classified-as-p (second expression) 'variable)))))))
CLOSED: [2016-06-15 Wed 00:19]
Polynomials are compound classifications that are defined as expressions which are either additive or subtrative, for which each term is a polynomial term.
(define-classification polynomial (when-classified-as non-atomic expression (and (or (eq '- (first expression)) (eq '+ (first expression))) (reduce #'(lambda (a b) (and a b)) (map 'list #'(lambda (the-expression) (classified-as-p the-expression 'polynomial-term)) (rest expression))))))
CLOSED: [2016-06-15 Wed 00:22]
Trigonometrics are defined as non atomic expressions that are two elements long, for which the first element of the expression is either sin
, cos
, tan
, csc
, sec
, or cot
. For each of these there is a classification seperate from the generic trigonometric
classification.
(define-classification trigonometric (when-classified-as non-atomic expression (member (first expression) '(sin cos tan csc sec cot)))) (define-classification sin (when-classified-as non-atomic expression (eq 'sin (first expression)))) (define-classification cos (when-classified-as non-atomic expression (eq 'cos (first expression)))) (define-classification tan (when-classified-as non-atomic expression (eq 'tan (first expression)))) (define-classification csc (when-classified-as non-atomic expression (eq 'csc (first expression)))) (define-classification sec (when-classified-as non-atomic expression (eq 'sec (first expression)))) (define-classification cot (when (classified-as-p expression 'non-atomic) (eq 'cot (first expression))))
CLOSED: [2016-06-14 Tue 23:48]
Classifications are stored in an alist, with the key being the name of the classification, and the value being the classifier itself. These cons cells are stored in the *classifications*
variable.
(defvar *classifications* '())
CLOSED: [2016-06-15 Wed 00:26]
This assembles the classification library, which in the #:larcs.classify
package. It correctly resolves the order of the code, taking it from simple blocks to a complete file.
(in-package #:larcs.classify) <<et-classification-storage>> <<et-define-classification>> <<et-check-classification>> <<et-classify-expression>> <<et-classification-case>> <<et-when-classified>> <<et-possible-classifications>>
[3/10]
Polynomials, and polynomial terms, are a somewhat common occurence. Because of this, it is important to provide a set of functions that manipulate these structures. These functions include a coefficient retriever, a variable retriever, a power retriever and a couple of order comparators.
CLOSED: [2016-06-21 Tue 22:10]
The task of collecting all variables in a given expression is fairly important to the task of algebraic manipulation. This is accomplished using a fairly simple recursive algorithm, collecting the elements that are classified as variables.
An expression is passed in, and if a variable, it is collected, if non-atomic, all but the first element are passed again to collect-variables
, and it happens all over again, this time, with those variables being added to the list, and when all is said and done, a list of all variables in a given expression is returned. See figure fig:variable-collection for a graphical representation.
digraph { start [label = "Start"]; stop [label = "Stop"]; collect [label = "Collect"]; if_var [label = "If Variable", shape = rectangle]; recurse_collect [label = "Iterate, Recurse and Collect Results"]; start -> if_var; if_var -> collect [label = "True"]; collect -> stop; if_var -> recurse_collect [label = "Non-atomic"]; recurse_collect -> start; }
(defun collect-variables (expression) (let ((variables '())) (flet ((merge-variables (variable) (pushnew variable variables))) (classification-case expression (variable (merge-variables expression)) (non-atomic (map 'list #'(lambda (expr) (dolist (variable (collect-variables expr)) (merge-variables variable))) (rest expression))))) (reverse variables)))
CLOSED: [2016-06-26 Sun 19:50]
To get the coefficient of a polynomial term there are three possibilities
The term itself
The second element in the term
1
(defun coefficient (term) (when (classified-as-p term 'polynomial-term) (classification-case term (numeric term) (multiplicative (second term)) (* 1))))
CLOSED: [2016-06-27 Mon 18:40]
The ability to retrieve tha variable in a polynomial term is important. This is accomplished by collecting the variables in the term and returning the first. If this is simply a numeric expression, nil
is returned as there are no variables.
(defun term-variable (term) (when (classified-as-p term 'polynomial-term) (first (collect-variables term))))
(defun get-power (term) (classification-case term (numeric 0) (variable 1) (power (third term)) (multiplicative (if (listp (third term)) (third (third term)) 1)) (* 0)))
(defun term-order-< (a b) (< (get-power a) (get-power b)))
(defun term-order-= (term-a term-b) (= (get-power term-a) (get-power term-b)))
(defun term-order-> (a b) (> (get-power a) (get-power b)))
(defun same-variable-p (term-a term-b) (eq (term-variable term-a) (term-variable term-b)))
(defun single-term-combinable-p (term-a term-b) (and (term-order-= term-a term-b) (same-variable-p term-a term-b)))
(in-package #:larcs.polynomials) <<poly-collect-variables>> <<poly-get-coefficient>> <<poly-get-term-variable>> <<poly-get-power>> <<poly-term-order-less-than>> <<poly-same-order>> <<poly-term-order-greater-than>> <<poly-same-variable>> <<poly-is-combinable>>
[2/4]
One of the most important parts of this system is the "algebraic manipulator", a sub-system that provides utilities for symbolic arithmetic, that is to say addition, subtraction, multiplication and division, along with trigonometric functions and exponential/logarithmic functions. These function, as many other portions of this system, using rewrite rules, implementing a form of specialized generic programming.
CLOSED: [2016-06-24 Fri 20:57]
To aid in the design and implementation of various sub-systems, from simplification to the basics of algebraic manipulators, the ability to collect terms is extremely important. It is accomplished as follows:
Lists for each of the types are initialized as empty.
For each term in the given expression, put it into the given list.
Return an alist containing the names of the types and the given lists, with the conses removed if the CDR is null.
(defun collect-terms (expression &aux (terms (rest expression))) (let ((numerics '()) (variables '()) (additives '()) (subtractives '()) (multiplicatives '()) (polynomial-terms '()) (rationals '()) (powers '()) (natural-exponentials '()) (exponentials '()) (natural-logarithmics '()) (trigonometrics '())) (dolist (term terms) (classification-case term (numeric (pushnew term numerics)) (variable (pushnew term variables)) (power (pushnew term powers)) (additive (pushnew term additives)) (subtractive (pushnew term subtractives)) (polynomial-term (pushnew term polynomial-terms)) (multiplicative (pushnew term multiplicatives)) (rational (pushnew term rationals)) (power (pushnew term powers)) (natural-exponential (pushnew term natural-exponentials)) (exponential (pushnew term exponentials)) (natural-logarithmic (pushnew term natural-logarithmics)) (trigonometric (pushnew term trigonometrics)))) (remove-if #'(lambda (expr) (null (cdr expr))) (list (cons :numerics numerics) (cons :variables variables) (cons :powers powers) (cons :additives additives) (cons :subtractives subtractives) (cons :multiplicatives multiplicatives) (cons :polynomial-terms polynomial-terms) (cons :rationals rationals) (cons :powers powers) (cons :natural-exponentials natural-exponentials) (cons :exponentials exponentials) (cons :natural-logarithmics natural-logarithmics) (cons :trigonometrics trigonometrics)))))
(defvar *manipulator-map* '()) (defmacro define-operation (name arity short) (check-type name symbol) (check-type arity (integer 1 26)) (check-type short symbol) (let* ((args (gen-args-list arity)) (expression-types (map 'list #'(lambda (x) (symbolicate x '-type)) args)) (rules-name (symbolicate '*manipulators- name '*)) (base-manipulator-name (symbolicate name '-manipulator-)) (manipulator-define-name (symbolicate 'define- name '-manipulator)) (is-applicable-name (symbolicate name '-is-applicable-p)) (get-operations-name (symbolicate 'get- name '-manipulators)) (type-check-list (let ((i 0)) (loop for arg in args collect (prog1 `(classified-as-p ,arg (nth ,i types)) (incf i)))))) `(progn (push '(,short . ,name) *manipulator-map*) (defvar ,rules-name '()) (defun ,is-applicable-name (types ,@args) (and ,@type-check-list)) (defun ,get-operations-name (,@args) (remove-if #'null (map 'list #'(lambda (option) (let ((types (car option)) (name (cdr option))) (if (,is-applicable-name types ,@args) name))) ,rules-name))) (defun ,name (,@args) (funcall (first (,get-operations-name ,@args)) ,@args)) (defmacro ,manipulator-define-name ((,@expression-types) &body body) (let ((manipulator-name (symbolicate ',base-manipulator-name ,@expression-types))) `(progn (setf ,',rules-name (append ,',rules-name '(((,,@expression-types) . ,manipulator-name)))) (defun ,manipulator-name ,',args ,@body)))))))
(ql:quickload :larcs-lib :silent t) (in-package #:larcs.manipulate) (format t "#+Caption: Expression Manipulator Expansion~%#+Name: am-ex-manip-expansion~%#+BEGIN_SRC lisp :exports code~%~a~%#+END_SRC" (macroexpand-1 '(define-operation frobnicate 2 frob)))
(PROGN (PUSH '(FROB . FROBNICATE) *MANIPULATOR-MAP*) (DEFVAR *MANIPULATORS-FROBNICATE* 'NIL) (DEFUN FROBNICATE-IS-APPLICABLE-P (TYPES EXPRESSION-A EXPRESSION-B) (AND (CLASSIFIED-AS-P EXPRESSION-A (NTH 0 TYPES)) (CLASSIFIED-AS-P EXPRESSION-B (NTH 1 TYPES)))) (DEFUN GET-FROBNICATE-MANIPULATORS (EXPRESSION-A EXPRESSION-B) (REMOVE-IF #'NULL (MAP 'LIST #'(LAMBDA (OPTION) (LET ((TYPES (CAR OPTION)) (NAME (CDR OPTION))) (IF (FROBNICATE-IS-APPLICABLE-P TYPES EXPRESSION-A EXPRESSION-B) NAME))) *MANIPULATORS-FROBNICATE*))) (DEFUN FROBNICATE (EXPRESSION-A EXPRESSION-B) (FUNCALL (FIRST (GET-FROBNICATE-MANIPULATORS EXPRESSION-A EXPRESSION-B)) EXPRESSION-A EXPRESSION-B)) (DEFMACRO DEFINE-FROBNICATE-MANIPULATOR ((EXPRESSION-A-TYPE EXPRESSION-B-TYPE) &BODY BODY) (LET ((MANIPULATOR-NAME (SYMBOLICATE 'FROBNICATE-MANIPULATOR- EXPRESSION-A-TYPE EXPRESSION-B-TYPE))) `(PROGN (SETF ,'*MANIPULATORS-FROBNICATE* (APPEND ,'*MANIPULATORS-FROBNICATE* '(((,EXPRESSION-A-TYPE ,EXPRESSION-B-TYPE) ,@MANIPULATOR-NAME)))) (DEFUN ,MANIPULATOR-NAME ,'(EXPRESSION-A EXPRESSION-B) ,@BODY)))))
The Expression Manipulators should not be touched outside of this package, as they are not designed to be used outside of it. Instead, they should be used through this simple function. It takes an action and a list of expressions. The function used to perform the action correctly is determined, and used to reduce the expressions.
(defun manipulate (action &rest expressions) (let ((the-manipulator (cdr (assoc action *manipulator-map*)))) (reduce the-manipulator expressions)))
CLOSED: [2016-06-18 Sat 13:38]
This is the assembly of the #:larcs.manipulate
package. It includes, in correct order, all bits of functionality. It places all of this in the larcs-manipulation.lisp
file.
(in-package #:larcs.manipulate) <<am-determine-expression-type>> <<am-collect-variables>> <<am-collect-terms>> <<am-define-expression-manipulator>> <<am-external-manipulator>>
[0/1]
To accomplish the goal of providing a system that can manipulate any and all proper algebraic expressions, one of the most basic operations of such is addition. This provides a set of manipulators acting upon proper additive expressions. It declares itself to be a part of the #:larcs.manipulate
package; defines an operation for addition, called add
, taking 2 arguments with a short-name of +
. It then includes the various manipulators that are defined for addition.
(in-package #:larcs.manipulate) (define-operation add 2 +) <<addition-manipulators-for-numerics>>
Find Outer Otter
(define-add-manipulator (numeric numeric) (+ expression-a expression-b)) (define-add-manipulator (numeric additive) (let ((total expression-a) (remainder (rest expression-b)) (non-numeric '())) (dolist (element remainder) (if (classified-as-p element 'numeric) (incf total element) (push element non-numeric))) (cond ((null non-numeric) total) ((= 0 total) `(+ ,@non-numeric)) (t `(+ ,total ,@non-numeric))))) (define-add-manipulator (additive additive) (let ((total 0) (elements (append (rest expression-a) (rest expression-b))) (non-numeric '())) (dolist (element elements) (if (classified-as-p element 'numeric) (incf total element) (push element non-numeric))) (cond ((null non-numeric) total) ((= 0 total) `(+ ,@non-numeric)) (t `(+ ,total ,@non-numeric))))) (define-add-manipulator (numeric subtractive) (let ((total expression-a) (the-other (rest expression-b)) (non-numeric '())) (dolist (element the-other) (if (classified-as-p element 'numeric) (decf total element) (push element non-numeric))) (cond ((null non-numeric) total) ((= 0 total) `(+ ,@non-numeric)) (t `(+ ,total (-,@non-numeric)))))) (define-add-manipulator (numeric polynomial-term) `(+ ,expression-a ,expression-b)) (define-add-manipulator (polynomial-term polynomial-term) (if (single-term-combinable-p expression-a expression-b) (let ((new-coefficient (+ (coefficient expression-a) (coefficient expression-b))) (variable (term-variable expression-a)) (power (get-power expression-a))) `(* ,new-coefficient (expt ,variable ,power))) `(+ ,expression-a ,expression-b))) (define-add-manipulator (* numeric) (add expression-b expression-a))
Bifurcate All Rectangles
(in-package #:larcs.manipulate) (define-operation subtract 2 -) (define-subtract-manipulator (numeric numeric) (- expression-a expression-b)) (define-subtract-manipulator (numeric subtractive) (let ((total expression-a) (elements (rest expression-b)) (non-numeric '())) (dolist (element elements) (if (classified-as-p element 'numeric) (decf total element) (push element non-numeric))) (cond ((null non-numeric) total) ((= 0 total) `(- ,@(reverse non-numeric))) (t `(- ,total ,@(reverse non-numeric)))))) (define-subtract-manipulator (* numeric) (subtract expression-b expression-a))
Quickly Automate Zoos
(in-package #:larcs.manipulate) (define-operation multiply 2 *) (define-multiply-manipulator (numeric numeric) (* expression-a expression-b)) (define-multiply-manipulator (numeric polynomial-term) (let ((new-coefficient (* expression-a (coefficient expression-b))) (variable (term-variable expression-b)) (power (get-power expression-b))) (if (= 1 power) `(* ,new-coefficient ,variable) `(* ,new-coefficient (expt ,variable ,power))))) (define-multiply-manipulator (polynomial-term polynomial-term) (let ((new-coefficient (* (coefficient expression-a) (coefficient expression-b))) (variable (term-variable expression-b)) (power (+ (get-power expression-a) (get-power expression-b)))) `(* ,new-coefficient (expt ,variable ,power))))
Quietly Usurp X-Rays
(in-package #:larcs.manipulate) (define-operation division 2 /) (define-division-manipulator (numeric numeric) (/ expression-a expression-b)) (define-division-manipulator (polynomial-term polynomial-term) (let ((new-coefficient (/ (coefficient expression-a) (coefficient expression-b))) (variable (term-variable expression-b)) (power (- (get-power expression-a) (get-power expression-b)))) `(* ,new-coefficient (expt ,variable ,power))))
[0/6]
Foo
(in-package #:larcs.manipulate) <<am-sine-manipulators>> <<am-cosine-manipulators>> <<am-tangent-manipulators>> <<am-cosecant-manipulators>> <<am-secant-manipulators>> <<am-cotangent-manipulators>>
Foo
(define-operation sine 1 sin) (define-sine-manipulator (numeric) (sin expression-a))
Foo
(define-operation cosine 1 cos) (define-cosine-manipulator (numeric) (cosine expression-a))
Foo
(define-operation tangent 1 tan) (define-tangent-manipulator (numeric) (tan expression-a))
Foo
(define-operation cosecant 1 csc)
Foo
(define-operation secant 1 sec)
Foo
(define-operation cotangent 1 cot)
[4/4]
While this isn't exactly algebra, differentiation is important mathematically. This is done rather simply using rules to rewrite an initial expression forming the derivative.
[3/3]
CLOSED: [2016-08-16 Tue 22:10]
Rule definition is how this system works. This is done rather simply, and is comprised of definition, retrieval and storage portions.
CLOSED: [2016-07-19 Tue 20:48]
Rules are defined using the define-derivative
macro, which takes an expression type, an arguments list, and a body. If the expression type is not already in the expansions map, it pushes the expression type and expansion name onto the the mapping. Following that, it defines a function for the expansion, using the given arguments list as the lambda-list and the given body for the body for the function.
(defmacro define-derivative (expression-type (&rest arguments-list) &body body) (let ((expansion-name (symbolicate expression-type '-expansion))) `(progn (when (not (member ',expression-type (mapcar #'car *rules*))) (setq *rules* (append *rules* '((,expression-type . ,expansion-name))))) (defun ,expansion-name (,@arguments-list) ,@body))))
CLOSED: [2016-08-16 Tue 22:00]
Rule retrieval works by matching a rewrite rule to an expression by classification. This is done by iterating through the possible classification-rewrite rule pairs, and if the expression matches the classification, returing the rewrite rule to be used.
(defun get-rule (expression) (cdr (first (remove-if #'(lambda (pair) (let ((type (first pair))) (not (classified-as-p expression type)))) ,*rules*))))
CLOSED: [2016-08-16 Tue 22:05]
Rules are stored rather simply, in a list of cons cells, with the CAR
being the classification, and the CDR
being the actualy rewrite function. They are found in the variable *rules*
.
(defvar *rules* '())
[9/9]
The process of symbolic derivation is carried out through rules. These are defined in the following sections, taking apart the equations and putting them back together again as their derivatives.
<<sd-numbers>> <<sd-variables>> <<sd-polynomial-terms>> <<sd-multiplicatives>> <<sd-rationals>> <<sd-additives>> <<sd-subtractives>> <<sd-exponentials-and-logarithmics>>
CLOSED: [2016-08-19 Fri 17:07]
Numbers are perhaps one of the simplest rules to define, ignore everything and simply return 0, which is, by definition, the derivative of any bare number.
(define-derivative numeric (&rest junk) (declare (ignorable junk)) 0)
CLOSED: [2016-08-19 Fri 17:19]
As with Numbers, Variables are just as simple, if something is simply a bare variable, the derivative of such is 1.
(define-derivative variable (&rest junk) (declare (ignorable junk)) 1)
CLOSED: [2016-08-19 Fri 17:31]
A Polynomial Term is a bit more complex than the previous two, the rewrite rule has to be able to get the variable, coefficient and current power of the polynomial term. Given this information, there are three possible cases:
The coefficient is returned.
The coefficient times the variable (in symbolic form) is returned.
This comes in the form of $()x^{(n-1)}$.
(define-derivative polynomial-term (&rest term) (let* ((coefficient (coefficient term)) (variable (term-variable term)) (power (get-power term))) (cond ((= 1 power) coefficient) ((= 2 power) `(* ,(* coefficient power) ,variable)) (t `(* ,(* coefficient power) (expt ,variable ,(1- power)))))))
CLOSED: [2016-08-19 Fri 20:21]
Differentiation of Multiplicative equations are performed by the product rule. This is defined as $\ac{\mathrm{d}}{\mathrm{d}x} f(x) ⋅ g(x) = f(x) ⋅ g′(x) + f′(x) ⋅ g(x)$.There are some minor exceptions, if $f)$ d $g)$ e numeric, then the result is the product of the two; if either $f)$ $g)$ numeric and the other is not, then the numeric is placed in front of the other derivative of the remainder.
(define-derivative multiplicative (function first &rest rest) (declare (ignore function)) (if (= 1 (length rest)) (let ((second (first rest))) (cond ((and (classified-as-p first 'numeric) (classified-as-p second 'numeric)) (* first second)) ((classified-as-p first 'numeric) `(* ,first ,(differentiate second))) ((classified-as-p second 'numeric) `(* ,second ,(differentiate first))) (t `(+ (* ,first ,(differentiate second)) (* ,second ,(differentiate first)))))) (differentiate `(* ,first (* ,@rest)))))
CLOSED: [2016-08-20 Sat 13:28]
This follows the quotient rule, which is defined as $\ac{\mathrm{d}}{\mathrm{d}x} \frac{f(x)}{g(x)} = \frac{f′(x)g(x) - f(x)g′(x)}{g(x)^2}$.
(define-derivative rational (function numerator denominator) (declare (ignore function)) `(/ (- (* ,numerator ,(differentiate denominator)) (* ,denominator ,(differentiate numerator))) (expt ,denominator 2)))
CLOSED: [2016-08-20 Sat 11:20]
This is quite simple, differentiate each term and add them together. This is accomplished using map
.
(define-derivative additive (function &rest terms) (declare (ignore function)) `(+ ,@(map 'list #'(lambda (term) (differentiate term)) terms)))
CLOSED: [2016-08-20 Sat 13:13]
Following the same pattern as for additives, subtractives map over, deriving each term and prepending the -
symbol to render the derivative of the originally passed subtractive equation.
(define-derivative subtractive (function &rest terms) (declare (ignore function)) `(- ,@(map 'list #'(lambda (term) (differentiate term)) terms)))
CLOSED: [2016-08-20 Sat 13:39]
There are four types of functions that are supported:
Effectively this returns itself.
The original function multiplied by the log of the base.
The derivative of the function being passed to $\$ er the same function.
The derivative of the natural log of the expression over the log of the base times the expression.
(define-derivative natural-exponential (function expression) (declare (ignore function)) `(exp ,expression)) (define-derivative exponential (function base power) (declare (ignore function)) (if (numberp power) (if (listp base) `(* ,power (expt ,base ,(1- power)) ,(differentiate base)) `(* ,power (expt ,base ,(1- power)))) `(* (expt ,base ,power) (log ,base)))) (define-derivative natural-logarithmic (function expression) (declare (ignore function)) `(/ ,(differentiate expression) ,expression)) (define-derivative logarithmic (function number base) (declare (ignore function)) `(/ ,(differentiate (cons 'log number)) (* (log ,base) ,number)))
CLOSED: [2016-08-19 Fri 20:36]
The following trig functions are supported:
$f′}(x) ⋅ cos(f(x))$
$^f′(x) ⋅ -sin(f(x))$
$f′}(x) ⋅ {sec(f(x))}^2$
$f′}(x) ⋅ ≤ft( csc(f(x)) - cot(f(x)) \right)$
$f′}(x) ⋅ -{csc(f(x))}^2$
(define-derivative sin (function expression) (declare (ignore function)) `(* ,(differentiate expression) (cos ,expression))) (define-derivative cos (function expression) (declare (ignore function)) `(* ,(differentiate expression) (- (sin ,expression)))) (define-derivative tan (function expression) (declare (ignore function)) `(* ,(differentiate expression) (expt (sec ,expression) 2))) (define-derivative csc (function expression) (declare (ignore function)) `(* ,(differentiate expression) (- (csc ,expression)) (cot ,expression))) (define-derivative cot (function expression) (declare (ignore function)) `(* ,(differentiate expression) (- (expt (csc ,expression) 2))))
CLOSED: [2016-07-18 Mon 18:31]
This is the derivative driver, differentiate
, which in the end is called recursively. It takes an expression (called function), finds a rule using the get-rule
function, and applies the rule to the function, ensuring that the function is passed as a list.
(defun differentiate (function) (let ((rule (get-rule function))) (when rule (apply rule (ensure-list function)))))
CLOSED: [2016-07-19 Tue 20:36]
This assembles the package, placing the contents in the correct order and puts them in the file larcs-differentiate.lisp
.
(in-package #:larcs.differentiate) <<sd-rule-storage>> <<sd-rule-definition>> <<sd-rule-retrieval>> <<sd-rules>> <<sd-derivative-driver>>
[3/5]
One of the less important parts of this system is the format converter, which converts between the internal symbolic form and a format that is capable of being typeset using TeX. This is done using a variant of the common rewrite system, but instead of going between variants of the symbolic format, it converts from a symbolic format to string-based format.
[2/2]
To accomplish the task of conversion from symbolic form to typeset form, rules are necessary. It is done using three main things, rule definition, rule retrieval and rule storage.
CLOSED: [2016-06-24 Fri 22:28]
Rule definitions are built using the define-converter
macro, which takes an expression type, a lambda list and a body. It creates a function using the body and the given arguments list, and if it hasn't been pushed onto the storage system, the converter function is pushed into storage.
(defvar *rules* '()) (defmacro define-converter (expression-type (&rest arguments-list) &body body) (let ((expansion-name (symbolicate expression-type '-conversion))) `(progn (when (not (member ',expression-type (mapcar #'car *rules*))) (setq *rules* (append *rules* '((,expression-type . ,expansion-name))))) (defun ,expansion-name (,@arguments-list) ,@body))))
CLOSED: [2016-06-24 Fri 22:36]
Rule retrieval is done by taking an expression, comparing it against given classifications, and from the first classification, returning the second element of the (classification . converter)
pair.
(defun get-rule (expression) (cdr (first (remove-if #'(lambda (pair) (let ((type (first pair))) (not (classified-as-p expression type)))) ,*rules*))))
[2/9]
The following contains all of the defined rules, which are as follows:
Numerics
Variables
Polynomial Terms
Multiplicatives
Rationals
Additives
Subtractives
Trigonometrics
Exponentials & Logarithmics
<<stf-numerics>> <<stf-variables>> <<stf-polynomial-terms>> <<stf-multiplicatives>> <<stf-rationals>> <<stf-additives>> <<stf-subtractives>> <<stf-trigonometrics>> <<stf-exponentials-logarithmics>>
CLOSED: [2016-08-02 Tue 22:09]
Numbers are formatted fairly simply, as they are simply surrounded by curly braces, and formatted as to be normal read syntax, which is generally correct.
(define-converter numeric (number) (with-tex-output (format nil "{~A}" number)))
CLOSED: [2016-08-02 Tue 22:20]
As with numbers, variables are a relatively simple thing to format. If the variable passed is in the *constant-names*
list, then it must be a formattable constant for which there is a known TeX command. If there is, it is looked up in the *special-symbols-to-sequences*
alist, otherwise, the given variable is downcased and output as a string. Either way, they are surrounded by, as usual, curly braces.
(define-converter variable (var) (if (member var *constant-names*) (with-tex-output (format nil "{~A}" (cdr (assoc var *special-symbols-to-sequences*)))) (with-tex-output (format nil "{~A}" (string-downcase var)))))
(define-converter polynomial-term (&rest term) (let ((variable (term-variable term)) (coefficient (coefficient term)) (power (get-power term))) (cond ((= 1 power) (with-tex-output (format nil "{~A}{~A}" (convert-for-display coefficient) (convert-for-display power)))) ((= 0 coefficient) (with-tex-output (format nil "{~A}^{~A}" (convert-for-display variable) (convert-for-display power)))) (t (with-tex-output (format nil "{~A}{~A}^{~A}" (convert-for-display coefficient) (convert-for-display variable) (convert-for-display power)))))))
(define-converter multiplicative (op &rest elements) (declare (ignore op)) (with-tex-output (format nil "{~{~A~^ \\cdot ~}}" (mapcar #'convert-for-display elements))))
(define-converter rational (op numerator denominator) (declare (ignore op)) (with-tex-output (format nil "{\\frac{~A}{~A}}" (convert-for-display numerator) (convert-for-display denominator))))
(define-converter additive (op &rest terms) (declare (ignore op)) (with-tex-output (format nil "{~{~A~^ + ~}}" (mapcar #'convert-for-display terms))))
(define-converter subtractive (op &rest terms) (declare (ignore op)) (with-tex-output (format nil "{~{~A~^ - ~}}" (mapcar #'convert-for-display terms))))
(define-converter sin (op term) (declare (ignore op)) (with-tex-output (format nil "{\\sin {~A}}" (convert-for-display term)))) (define-converter cos (op term) (declare (ignore op)) (with-tex-output (format nil "{\\cos {~A}}" (convert-for-display term)))) (define-converter tan (op term) (declare (ignore op)) (with-tex-output (format nil "{\\tan {~A}}" (convert-for-display term)))) (define-converter csc (op term) (declare (ignore op)) (with-tex-output (format nil "{\\csc {~A}}" (convert-for-display term)))) (define-converter sec (op term) (declare (ignore op)) (with-tex-output (format nil "{\\sec {~A}}" (convert-for-display term)))) (define-converter cot (op term) (declare (ignore op)) (with-tex-output (format nil "{\\cot {~A}}" (convert-for-display term))))
(define-converter natural-exponential (op term) (declare (ignore op)) (with-tex-output (format nil "{e^~A}" (convert-for-display term)))) (define-converter exponential (op base power) (declare (ignore op)) (with-tex-output (format nil "{~A^~A}" (convert-for-display base) (convert-for-display power)))) (define-converter natural-logarithmic (op term) (declare (ignore op)) (with-tex-output (format nil "{\\ln ~A}" (convert-for-display term)))) (define-converter logarithmic (op term base) (declare (ignore op)) (with-tex-output (format nil "{\\log_~a ~a}" (convert-for-display base) (convert-for-display term))))
[0/7]
(defun convert-for-display (function) (if (and (listp function) (member (first function) '(and or not = sum integrate parens))) (let ((operator (first function))) (cond ((eq operator 'and) <<stf-and-operator>> ) ((eq operator 'or) <<stf-or-operator>> ) ((eq operator 'not) <<stf-not-operator>> ) ((eq operator '=) <<stf-equality-operator>> ) ((eq operator 'sum) <<stf-summation>> ) ((eq operator 'integrate) <<stf-integration>> ) ((eq operator 'parens) <<stf-parenthesis>> ))) (let ((rule (get-rule function))) (when rule (apply rule (ensure-list function))))))
Foo
(destructuring-bind (op &rest terms) function (declare (ignore op)) (with-tex-output (format nil "{~{~A~^ \\wedge ~}}" (mapcar #'convert-for-display terms))))
Foo
(destructuring-bind (op &rest terms) function (declare (ignore op)) (with-tex-output (format nil "{~{~A~^ \\vee ~}}" (mapcar #'convert-for-display terms))))
Foo
(destructuring-bind (op term) function (with-tex-output (format nil "{\\not ~A}" (convert-for-display term))))
Foo
(destructuring-bind (op lhs rhs) function (declare (ignore op)) (format nil "{~A = ~A}" (convert-for-display lhs) (convert-for-display rhs)))
(destructuring-bind (op start stop expression) function (declare (ignore op)) (format nil "{\sum_~A^~A ~A}" (convert-for-display start) (convert-for-display stop) (convert-for-display expression)))
(destructuring-bind (op from to expression wrt) function (declare (ignore op)) (with-tex-output (format nil "{\\int_~A^~A ~A\\,\\mathrm{d}~A}" (convert-for-display from) (convert-for-display to) (convert-for-display expression) (convert-for-display wrt))))
(destructuring-bind (op type expression) function (declare (ignore op)) (let* ((types '((square . ("[" . "]")) (curly . ("{" . "}")) (smooth . ("(" . ")")))) (left (cadr (assoc type types))) (right (cddr (assoc type types)))) (with-tex-output (format nil "{\\left~a {~a} \\right~a}" left (convert-for-display expression) right))))
CLOSED: [2016-06-25 Sat 16:27]
There is one specialty macro, with-tex-output
, which is used to ensure that an expression is wrapped to be a part of correct (La)TeX output. It works by checking to see whether or not the variable *tex-outputp*
is true, if so, it simply pass through the given body, and if not, it binds the variable to t
, and makes sure that the given body is wrapped in $
, allowing the expression to be typeset correctly.
(defvar *tex-outputp* nil) (declaim (special *tex-outputp*)) (defmacro with-tex-output (&body body) `(if *tex-outputp* (progn ,@body) (let ((*tex-outputp* t)) (format nil "$~a$" (progn ,@body)))))
CLOSED: [2016-06-24 Fri 21:34]
The final assembly of this portion of the system is as simple as the rest, resolving dependencies and placing everything in a single file. As normal, this is done using NoWeb syntax, with everything tangled to the file larcs-typeset.lisp
.
(in-package #:larcs.typeset) <<stf-special-macros>> <<stf-rule-retrieval>> <<stf-define-rule>> <<stf-conversion-driver>> <<stf-rules>>
[2/2]
LARCS is primarily a library, and as such, the formal interface for the library, and a way to load it must be provided. This is done here by defining packages centrally and defining an ASDF system to load the library quickly and easily.
[6/6]
As all of the packages are defined centrally, this makes resolving inter-package dependencies much easier and convenient.
<<common-package-def>> <<classification-package-def>> <<polynomial-package-def>> <<manipulation-package-def>> <<differentiation-package-def>> <<typesetting-package-def>>
CLOSED: [2016-08-21 Sun 11:53]
This defines the common package, which keeps a few macros and variables that are used by all other packages. It exports a function to generate arguments lists, a list of special symbols to TeX sequences and a list of constant names.
(defpackage #:larcs.common (:use #:cl) (:import-from #:alexandria #:symbolicate) (:export #:gen-args-list #:*special-symbols-to-sequences* #:*constant-names*) (:nicknames #:common))
CLOSED: [2016-08-21 Sun 12:03]
Classification is another system that is used by just as many packages as the common packages. In this case, it exports two functions (one to get classification and one to check whether something is classified as a given classification) and a macro (the case pattern for classification).
(defpackage #:larcs.classify (:use #:cl #:larcs.common) (:import-from #:alexandria #:symbolicate) (:export #:classify #:classified-as-p #:classification-case) (:nicknames #:classify))
CLOSED: [2016-08-21 Sun 12:09]
Polynomial Functions are used in several of the other packages, and provide a way of comparing and retrieving information about specific terms, or providing a way to collect information about variables.
(defpackage #:larcs.polynomials (:use #:cl #:larcs.common #:larcs.classify) (:export #:collect-variables #:coefficient #:term-variable #:get-power #:term-order-< #:term-order-= #:term-order-> #:save-variable-p #:single-term-combinable-p) (:nicknames #:polynomials))
CLOSED: [2016-08-21 Sun 12:21]
This package provides for a method to manipulate and perform algebra symbolically. In a way, this is the core of the library, upon which nearly everything else is built.
(defpackage #:larcs.manipulate (:use #:cl #:larcs.common #:larcs.classify #:larcs.polynomials) (:import-from #:alexandria #:symbolicate) (:export #:manipulate #:collect-terms) (:nicknames #:manipulate))
CLOSED: [2016-08-21 Sun 13:19]
This is a rather simple package, providing a way to differentiate equations for use in a variety of functions.
(defpackage #:larcs.differentiate (:use #:cl #:larcs.common #:larcs.classify #:larcs.manipulate #:larcs.polynomials) (:import-from #:alexandria #:symbolicate) (:import-from #:com.informatimago.common-lisp.cesarum.list #:aget #:ensure-list) (:export :differentiate) (:nicknames :diff))
CLOSED: [2016-08-21 Sun 13:35]
Again, this is a relatively simple package definition, providing a way to convert symbolic equations to a form that can be more easily read by most humans.
(defpackage #:larcs.typeset (:use #:cl #:larcs.common #:larcs.classify #:larcs.manipulate #:larcs.polynomials) (:import-from #:alexandria #:symbolicate) (:import-from #:com.informatimago.common-lisp.cesarum.list #:aget #:ensure-list) (:export #:convert-for-display) (:nicknames #:typeset))
CLOSED: [2016-08-21 Sun 11:23]
This defines the LARCS Library system, allowing the functionality to be loaded by other systems or to provide a way to make development quickly and easily.
(asdf:defsystem #:larcs-lib :description "A CAS Library for use within Lisp Software." :author "Samuel Flint <swflint@flintfam.org>" :license "GNU GPLv3 or Later" :depends-on (#:alexandria #:com.informatimago) :serial t :components ((:file "larcs-packages") (:file "larcs-common") (:file "larcs-classify") (:file "larcs-polynomials") (:file "larcs-manipulation") (:file "larcs-manipulators-addition") (:file "larcs-manipulators-subtraction") (:file "larcs-manipulators-multiplication") (:file "larcs-manipulators-division") (:file "larcs-manipulators-trig") (:file "larcs-differentiate") (:file "larcs-typeset")))
This document is version src_sh{git describe –always –long –dirty –abbrev=10 –tags}.