lisp-cas.org 71 KB
LARCS
WORKING Introduction nonum
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:
-
Algebraic Manipulation
-
Derivation
-
Lisp Equation Conversion to LaTeX
What's in a name? nonum
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:
- Lisp
-
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.
- Automated
-
The CAS will perform rewrites and calculations automatically.
- Rewrite
-
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.
- Calculation
-
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).
- System
-
A complete library and application for symbolic algebra.
TOC ignore
Common Functionality
WORKING Algebraic Manipulation [3/7]
At the core of LARCS is the algebraic manipulation library. This provides a way for other libraries to add, subtract, multiply and divide symbolically, essentially giving a programmer the ability to create or manipulate equations. While it is neither a solver nor a simplifier, it provides the base for both of them by providing manipulators and automatic expression rewriters.
Expression Typing [7/7]
To accomplish the goal of providing a complete system to manipulate algebraic expressions, a way to determine the type of expression is important. This will allow for a form of "generic programming" to be used in the development of the manipulator functions, as a way to ensure that the correct manipulator is chosen.
This includes a form of storage, the classification definition macro, a way to check a classification, an expression classifier, and all possible classifications.
<<am-classification-storage>> <<am-define-classification>> <<am-check-classification>> <<am-classify-expression>> <<am-classification-case>> <<am-when-classified>> <<am-possible-classifications>>
Define Classification
CLOSED: [2016-05-04 Wed 19:30]
This is the classification definition macro, define-classification. It takes one symbol argument, name (the name of the classification), and a body, which is encapsulated within a defun, and binds the following variables:
-
expression -
the expression which is to be classified
-
length -
the length of the expression if the expression is a list, or 0 if it is not.
Aside from defining the classification, it also pushes the classification name and the classifier onto the stack, which can be used for direct classification checking or to completely classify an expression.
(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*)
',name)))
Check Classification
CLOSED: [2016-05-04 Wed 19:37]
To check a classification, the classifier is obtained, unless the specified classifier is *, in which case, t is always returned. If the classification is not, the classifier function is called on the expression, the result of which is returned.
(defun classified-as-p (expression classification)
(if (eq '* classification)
t
(funcall (cdr (assoc classification *classifications*))
expression)))
Classify Expression
CLOSED: [2016-05-04 Wed 19:44]
To completely classify an expression, the *classifications* alist is mapped over, checking to see if each classification is applicable to the expression, if so, the name being returned, otherwise nil. All nils are removed, leaving the complete classification, which is returned for use.
(defun classify (expression)
(let ((classifications '()))
(dolist (possible
,*classifications*
(reverse classifications))
(let ((name (car possible))
(checker (cdr possible)))
(when (funcall checker expression)
(push name classifications))))))
Classification Case
CLOSED: [2016-05-30 Mon 18:17]
Following the case pattern, and to allow for cleaner code, I've defined the classification case macro. It does this by taking a variable name and a list of cases. These are then mapped over, producing clauses suitable for a cond expression, to which this macro finally expands, binding the complete classification of the given expression to the-classification.
(defmacro classification-case (var &rest cases)
(declare (slime-indent (as case)))
(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))))
When Classified
CLOSED: [2016-05-30 Mon 19:18]
The when-classified-as macro takes a classification, variable and a body. It expands to a when form, with the classification and variable put into a classified-as-p call becoming the predicate, determining whether or not the body is run.
(defmacro when-classified-as (classification variable &body body)
`(when (classified-as-p ,variable ',classification)
,@body))
Classifications [13/13]
I must define several different classifications, ranging from simple numeric expressions (numbers) to trigonometric expressions ($\n$,cos$ d the lot). They are as follows:
-
Numbers
-
Variables
-
Non-Atomics
-
Additives
-
Subtractives
-
Powers
-
Exponentials
-
Multiplicatives
-
Logarithmics
-
Rationals
-
Polynomial Terms
-
Polynomials
-
Trigonometrics
<<am-classify-numbers>> <<am-classify-variables>> <<am-classify-non-atomics>> <<am-classify-additives>> <<am-classify-subtractives>> <<am-classify-powers>> <<am-classify-exponentials>> <<am-classify-multiplicatives>> <<am-classify-logarithmics>> <<am-classify-rationals>> <<am-classify-polynomial-term>> <<am-classify-polynomials>> <<am-classify-trigonometrics>>
Numbers
CLOSED: [2016-05-04 Wed 19:56]
Check to see if a given expression is a number using numberp.
(define-classification numeric
(numberp expression))
Variables
CLOSED: [2016-05-04 Wed 19:57]
Check to see if a given expression is a variable, that is to say a symbol, using symbolp.
(define-classification variable
(symbolp expression))
Non Atomics
CLOSED: [2016-05-04 Wed 19:59]
Check to see if a given expression is a non-atomic (any expression other than a number or a variable) using listp.
(define-classification non-atomic
(listp expression))
Additives
CLOSED: [2016-05-04 Wed 20:01]
Check to see whether or not an expression is an additive by ensuring that it is non-atomic and the first element is the symbol +.
(define-classification additive
(when-classified-as non-atomic expression
(eq '+ (first expression))))
Subtractive
CLOSED: [2016-05-04 Wed 20:02]
Check to see whether a given expression is a subtractive by ensuring it is non-atomic and the first element is the symbol -.
(define-classification subtractive
(when-classified-as non-atomic expression
(eq '- (first expression))))
Powers
CLOSED: [2016-05-04 Wed 20:07]
This is used to classify "powers", that is to say, equations of the form $x$,here $nis any numeric. It does so by first ensuring that the expression is non-atomic, following that, it checks to see if the first element in the expression is the symbol expt, the second is a variable and the third 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))))
Exponentials
CLOSED: [2016-05-30 Mon 18:24]
This classifies both natural and non-natural exponentials. It does so by ensuring that natural exponentials ($e$)re of the form (exp x), and non-natural exponentials ($a$)re of the form (expt base power).
(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)))))
Multiplicatives
CLOSED: [2016-05-30 Mon 18:55]
To classify multiplicative expressions, it is first ensured that they are non-atomic, and then, the first element is tested to see if it is equal to the symbol *.
(define-classification multiplicative
(when-classified-as non-atomic expression
(eq '* (first expression))))
Logarithmics
CLOSED: [2016-05-30 Mon 18:30]
This defines the classifications for logarithmic expressions, for both natural and non-natural bases. For natural bases ($\ x$)it ensures that expressions are of the form (log x), and for non-natural bases ($\gbx$)re of the form (log expression base-expression).
(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)))))
Rationals
CLOSED: [2016-05-30 Mon 18:58]
Rationals are classified similarly to multiplicatives, checking to see whether or not they are non-atomic and checking whether or not the first element is /, but rationals are also defined as only having three elements, the operation and two following operands, and thus, the length is also checked.
(define-classification rational
(when-classified-as non-atomic expression
(and (= 3 length)
(eq '/ (first expression)))))
Polynomial Terms
CLOSED: [2016-05-30 Mon 19:13]
To classify a polynomial term, The expression is checked to see if it satisfies one of the following:
-
Numeric
-
Variable
-
Power
-
Multiplicative that composed of a numeric and a power or variable.
(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)))))))
Polynomials
CLOSED: [2016-05-08 Sun 16:46]
This determines whether or not a given expression is a polynomial, that is to say it is either additive or subtractive, and each and every term is classified as polynomial-term, that is to say, a numeric, power, or a multiplicative consisting of a numeric followed by a power.
(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))))))
Trigonometrics
CLOSED: [2016-05-30 Mon 19:15]
Trigonometrics are classified as many others are, they are first checked to see if they are non-atomic, and then the first element is checked, with the following being valid symbols:
-
sin -
cos -
tan -
csc -
sec -
cot
(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))))
Classification Storage
CLOSED: [2016-05-04 Wed 19:49]
The storage of classifications is simple, they are stored as an alist in the form of (name . classifier), in the list *classifications*.
(defvar *classifications* '())
Collect Variables
CLOSED: [2016-05-31 Tue 18:54]
Variable collection is somewhat important, and to accomplish this, I use a recursive algorithm. An expression is passed to the function, and if the expression is a variable, then the variable is collected and spit out; otherwise, if the expression is non-atomic, it is passed to the function recursively, and the returned variables are then merged into the variables list. Upon termination (no further sub-expressions), all variables are returned. (See Figure fig:variable-collection.)
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)))
WORKING Polynomial Related Functions [0/6]
<<am-get-coefficient>> <<am-get-term-variable>> <<am-get-power>> <<am-same-order>> <<am-same-variable>> <<am-is-combinable>>
Get Coefficient
(defun coefficient (term)
(when (classified-as-p term 'polynomial-term)
(classification-case term
(variable 1)
(power 1)
(multiplicative (second term))
(numeric term))))
Get Term Variables
(defun term-variable (term)
(when (classified-as-p term 'polynomial-term)
(classification-case term
(power (second term))
(multiplicative
(if (listp (third term))
(second (third term))
(third term)))
(numeric nil))))
Get Power
(defun get-power (term)
(classification-case term
(numeric 0)
(variable 1)
(power (third term))
(multiplicative
(if (listp (third term))
(third (third term))
1))
(* 0)))
Same Order
(defun same-order-p (term-a term-b)
(= (get-power term-a)
(get-power term-b)))
Same Variable
(defun same-variable-p (term-a term-b)
(eq (term-variable term-a)
(term-variable term-b)))
Is Combinable
(defun single-term-combinable-p (term-a term-b)
(and (same-order-p term-a term-b)
(same-variable-p term-a term-b)))
WORKING Expression Manipulators [2/8]
Foo
<<am-misc-manipulator-functions>> <<am-define-expression-manipulator>> <<am-external-manipulator>> <<am-addition-manipulator>> <<am-subtraction-manipulator>> <<am-multiplication-manipulators>> <<am-division-manipulators>> <<am-trigonometric-manipulators>>
Manipulator Miscellaneous Functions
CLOSED: [2016-05-08 Sun 10:34]
This defines the *manipulator-map*, where the manipulators for various functions are stored, and defines a function to generate an arguments list given a count of arguments.
(defvar *manipulator-map* '())
(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))))
WORKING Define Expression Manipulator
(defmacro define-operation (name arity short)
(declare (slime-indent (as defun)))
(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)
(declare (slime-indent (as defun)))
(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)))))))
(load "manipulation")
(in-package #:manipulator)
(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)
(DECLARE (SLIME-INDENT (AS DEFUN)))
(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)))))
External Manipulator
CLOSED: [2016-05-31 Tue 19:48]
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)))
WORKING Addition
Foo
(define-operation add 2 +)
(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))
WORKING Subtraction
Foo
(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))
WORKING Multiplication
Foo
(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))))
WORKING Division
Foo
(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))))
WORKING Trigonometric [0/6]
Foo
<<am-sine-manipulators>> <<am-cosine-manipulators>> <<am-tangent-manipulators>> <<am-cosecant-manipulators>> <<am-secant-manipulators>> <<am-cotangent-manipulators>>
WORKING Sine
Foo
(define-operation sine 1 sin)
(define-sine-manipulator (numeric)
(sin expression-a))
WORKING Cosine
Foo
(define-operation cosine 1 cos)
(define-cosine-manipulator (numeric)
(cosine expression-a))
WORKING Tangent
Foo
(define-operation tangent 1 tan)
(define-tangent-manipulator (numeric)
(tan expression-a))
WORKING Cosecant
Foo
(define-operation cosecant 1 csc)
WORKING Secant
Foo
(define-operation secant 1 sec)
WORKING Cotangent
Foo
(define-operation cotangent 1 cot)
Packaging
CLOSED: [2016-05-05 Thu 21:21]
This assembles and packages the algebraic manipulation system into a single file and library. To do so, it must first define a package, import specific symbols from other packages, and export symbols from itself. It then includes the remainder of the functionality, placing it in the file manipulation.lisp.
(defpackage #:manipulator
(:use #:cl)
(:import-from #:alexandria
#:symbolicate)
(:export #:manipulate
#:classify
#:classified-as-p
#:classification-case
#:collect-variables
#:collect-terms))
(in-package #:manipulator)
(declaim (declaration slime-indent))
<<am-determine-expression-type>>
<<am-collect-variables>>
<<am-collect-terms>>
<<am-polynomial-related-functions>>
<<am-expression-manipulation>>
WORKING Symbolic Solver [0/3]
Techniques
Rules
Assembly
WORKING Symbolic Trigonometry [0/2]
Rules
Assembly
WORKING Symbolic Differentiation [0/5]
The calculation of derivatives has many uses. However, the calculation of derivatives can often be tedious. To make this faster, I've written the following program to make it faster.
WORKING Expansions [0/4]
CLOSED: [2016-06-09 Thu 09:22]
This program works in terms of expansion functions, and application tests. That is to say, there is a test to see if the expansion is valid for the given expression.
Match Expressions
To be able to apply an expansion, you need to determine eligibility. To do this, you need an expression that matches on two things, function name and arity. To generate this, it takes an operation name and the arity. Based on the arity type ($= $> $\q$)it will construct a simple boolean statement in the format of $(nction = operator) ∧ (argument-count == arity)$,here $= is one of the above arity types.
(defun generate-match-expression (on arity &optional (type '=))
(check-type on symbol)
(check-type type (member = > >=))
(check-type arity (integer 0))
(case type
(=
`(and (eq function ',on)
(= arg-count ,arity)))
(>
`(and (eq function ',on)
(> arg-count ,arity)))
(>=
`(and (eq function ',on)
(>= arg-count ,arity)))))
WORKING Definition
To define an expansion requires just a bit of syntactic sugar in the form of the defexpansion macro. This macro does 3 things, generate a test function, generate an expansion function and pushes the name of the expansion, the test function and the expansion function on to the rules list.
To generate the test function, it uses the match-expression generator and wraps it into a function taking two arguments, a function and a list of arguments to the function. The test is then made, acting as predicate function for whether or not the expansion is applicable.
To generate the expansion function, a series of expressions is used as the body of the function, with the function destructured to form the arguments.
(defmacro defexpansion (name (on arity &optional (type '=)) (&rest arguments) &body expansion)
(let ((match-expression (generate-match-expression on arity type))
(test-name (symbolicate name '-test))
(expansion-name (symbolicate name '-expansion)))
`(progn
(defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
,match-expression)
(defun ,expansion-name (,@arguments)
,@expansion)
(setf (aget *rules* ',name)
(make-rule :name ',name
:test-function #',test-name
:expansion-function #',expansion-name))
',name)))
WORKING Retrieval
To allow for the use of expansions, you must be able to retrieve the correct one from the expansions list.
To do so, you need the second element of the list that is the (name test expansion) for the rule. This is found by removing the expansions for which the test returns false for the given expression.
(defun get-expansion (expression)
(rule-expansion-function (rest (first
(remove-if-not #'(lambda (nte)
(let ((test (rule-test-function (rest nte))))
(apply test expression)))
,*rules*)))))
Storage
One of the more important parts of the program is a way to store expansions. This is however, quite boring. It's just a global variable (*rules*), containing a list of lists having the form of (name test-lambda expander-lambda).
(defstruct (rule (:type list))
name test-function expansion-function)
(defvar *rules* '())
WORKING Rules [0/5]
CLOSED: [2016-06-09 Thu 09:22]
There are many rules for derivation of equations. These rules allow one to derive equations quickly and easily by matching equations up with relevant rules and applying those rules.
Multiplication
The derivatives of multiplication follows two rules, the Constant Multiple rule:
\[ \frac{d}{dx} cf(x) = c \cdot f^\prime(x) ,\]
which is a specialized version of the more generalized Product Rule:
\[ \frac{d}{dx} f(x) \cdot g(x) = f(x) \cdot g^\prime(x) + g(x) \cdot f^\prime(x) .\]
There are two forms of the Product Rule as implemented, both matching on the * function, but taking a different number of arguments. The first takes 2 arguments, and is the main driver for derivation, following the two above rules. The second takes 3 or more, and modifies the arguments slightly so as to make it a derivative of two different equations.
(defexpansion mult/2 (* 2) (first second)
(cond
((numberp first)
`(* ,first ,(derive (if (listp second) second (list second)))))
((numberp second)
`(* ,second ,(derive (if (listp first) first (list second)))))
(t
`(+ (* ,first ,(derive (if (listp second) second (list second))))
(* ,second ,(derive (if (listp first) first (list first))))))))
(defexpansion mult/3+ (* 3 >=) (first &rest rest)
(derive `(* ,first ,(cons '* rest))))
Division
Division follows the Quotient Rule, which is as follows:
\[ \frac{d}{dx} \frac{f(x)}{g(x)} = \frac{f^\prime(x) \cdot g(x) - g^\prime(x) \cdot f(x)}{(g(x))^2} .\]
The rule matches on the / function, and takes 2 arguments, a numerator and a denominator, its expansion is as above.
(defexpansion div/2 (/ 2) (numerator denominator)
`(/ (- (* ,numerator ,(derive (if (listp denominator) denominator (list denominator))))
(* ,denominator ,(derive (if (listp numerator) numerator (list numerator)))))
(expt ,denominator 2)))
Addition/Subtraction
Addition and subtraction of functions in derivatives is simple, simply add or subtract the derivatives of the functions, as shown here:
\[ \frac{d}{dx} f_1(x) + f_2(x) + \cdots + f_n(x) = f_1^\prime(x) + f_2^\prime(x) + \cdots + f_n^\prime(x) \]
and here:
\[ \frac{d}{dx} f_1(x) - f_2(x) - \cdots - f_n(x) = f_1^\prime(x) - f_2^\prime(x) - \cdots - f_n^\prime(x) .\]
This is accomplished by matching on either + or -, and taking 2 or more arguments, deriving all of the passed in equations and applying the respective operation.
(defexpansion plus/2+ (+ 2 >=) (&rest clauses)
`(+ ,@(map 'list #'(lambda (clause)
(if (listp clause)
(derive clause)
(derive (list clause))))
clauses)))
(defexpansion minus/2+ (- 2 >=) (&rest clauses)
`(- ,@(map 'list #'(lambda (clause)
(if (listp clause)
(derive clause)
(derive (list clause))))
clauses)))
Exponentials and Logarithms
The derivatives of exponential and logarithmic functions follow several rules. For $e$ $a$,he "Xerox" rule is used:
\[ \frac{d}{dx} e^x = e^x ,\]
and
\[ \frac{d}{dx} a^x = a^x \cdot \ln x .\]
Logarithmic functions follow the forms as shown:
\[ \frac{d}{dx} \ln x = \frac{x^\prime}{x} ,\]
and
\[ \frac{d}{dx} \log_b x = \frac{x^\prime}{\ln b \cdot x} .\]
However, equations of the form $x$ llow this form (The Power Rule):
\[ \frac{d}{dx} x^n = x^\prime \cdot n \cdot x^{n-1} .\]
The following rules match based on the appropriate Lisp functions and the number of arguments taken based on whether or not you are performing natural or unnatural operations.
(defexpansion exp/1 (exp 1) (expression)
(if (listp expression)
`(* (exp ,expression) ,(derive expression))
(if (numberp expression)
0
`(exp ,expression))))
(defexpansion expt/2 (expt 2) (base exponent)
(if (numberp exponent)
(if (listp base)
`(* ,exponent (expt ,base ,(1- exponent)) ,(derive base))
`(* ,exponent (expt ,base ,(1- exponent))))
`(* (expt ,base ,exponent) (log ,base))))
(defexpansion log/1 (log 1) (expression)
`(/ ,(derive (if (listp expression) expression (list expression))) ,expression))
(defexpansion log/2 (log 2) (number base)
(declare (ignorable number base))
`(/ ,(derive (cons 'log number)) (* (log ,base) ,number)))
Trigonometric
The derivation of trigonometric functions is simply the application of the chain rule. As such, each of the trig functions has a different derivative, as shown here:
\[ \frac{d}{dx} \sin x = x^\prime \cdot \cos x ,\]
\[ \frac{d}{dx} \cos x = x^\prime \cdot -\sin x ,\]
\[ \frac{d}{dx} \tan x = x^\prime \cdot \sec^2 x ,\]
\[ \frac{d}{dx} \csc x = x^\prime \cdot -\csc x \cdot \cot x ,\]
\[ \frac{d}{dx} \sec x = x^\prime \cdot \sec x \cdot \tan x ,\]
and
\[ \frac{d}{dx} \cot x = x^\prime \cdot -\csc^2 x .\]
These rules all match on their respective trig function and substitute as appropriate.
(defexpansion sin/1 (sin 1) (arg)
`(* (cos ,arg) ,(derive (if (listp arg) arg (list arg)))))
(defexpansion cos/1 (cos 1) (arg)
`(* (- (sin ,arg)) ,(derive (if (listp arg) arg (list arg)))))
(defexpansion tan/1 (tan 1) (arg)
`(* (expt (sec ,arg) 2) ,(derive (if (listp arg) arg (list arg)))))
(defexpansion csc/1 (csc 1) (arg)
`(* (- (csc ,arg)) (cot ,arg) ,(derive (if (listp arg) arg (list arg)))))
(defexpansion sec/1 (sec 1) (arg)
`(* (sec ,arg) (tan ,arg) ,(derive (if (listp arg) arg (list arg)))))
(defexpansion cot/1 (cot 1) (arg)
`(* (- (expt (csc ,arg) 2)) ,(derive (if (listp arg) arg (list arg)))))
Derivative Driver
This function is probably the most important user-facing function in the package.
Derive takes a list, and based on the first element in the list, and the length of the list, it will do one of the following things:
- Number
-
Return 0, the derivative of a number is 0, except in certain cases listed above.
- Symbol, and length is 1
-
This is a variable. Return 1, $\ac{d}{dx}x=1$.
- Expansion Function Available
-
There is an expansion rule, use this to derive the equation.
- No Expansion Rule
-
Signal an error, equation was likely malformed.
(defun derive (function)
(check-type function cons)
(let ((op (first function)))
(cond
((numberp op)
0)
((and (symbolp op)
(= 1 (length function)))
1)
(t
(let ((expansion-function (get-expansion function)))
(if (functionp expansion-function)
(apply expansion-function (rest function))
(error "Undefined expansion: ~a" op)))))))
Miscellaneous Functions
As Common Lisp does not have cosecant or secant functions, and they appear in the definitions of the derivatives of some trigonometric functions, I define them here as follows:
\[ \csc x = \frac{1}{\sin x} \]
\[ \sec x = \frac{1}{\cos x} \]
I also take the liberty of defining two macros, a define-equation-functions macro and take-derivative. The first defines two functions, one that is the original equation, and the second being the derivative of the original equation. The take-derivative macro does simply that, but allows you to write the equation without having to quote it, providing a little bit of syntactic sugar.
(defun csc (x)
"csc -- (csc x)
Calculate the cosecant of x"
(/ (sin x)))
(defun sec (x)
"sec -- (sec x)
Calculate the secant of x"
(/ (cos x)))
(defmacro define-equation-functions (name variable equation)
(let ((derivative-name (symbolicate 'd/d- variable '- name))
(derivative (derive equation)))
`(progn
(defun ,name (,variable)
,equation)
(defun ,derivative-name (,variable)
,derivative))))
(defmacro take-derivative (equation)
(let ((derivative (derive equation)))
`',derivative))
Packaging
Now that the functions, macros and rules are defined, it's time to put them together into a package. This package has only one dependency, Common Lisp itself, and exports the following five symbols: derive, csc, sec, define-equation-functions and take-derivative.
;;;; derive.lisp
;;;;
;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
(defpackage #:derive
(:use #:cl
#:com.informatimago.common-lisp.cesarum.list)
(:import-from #:alexandria
#:symbolicate)
(:export :derive
:csc
:sec
:define-equation-functions
:take-derivative))
(in-package #:derive)
;;; "derive" goes here.
<<derive-expansion-storage>>
<<derive-expansion-retrieval>>
<<derive-match-expressions>>
<<derive-expansion-definition>>
<<derive-derivative-driver>>
<<derive-multiplication>>
<<derive-division>>
<<derive-addition-subtraction>>
<<derive-exponentials-logarithms>>
<<derive-trigonometrics>>
<<derive-misc-functions>>
;;; End derive
WORKING Symbolic Integration [0/3]
Rules
Techniques
Assembly
WORKING Conversion from Symbolic Expressions to Typeset Display Formats [0/5]
The goal of this portion of the CAS is to produce \LaTeX{} formulae that can be inserted into a document for whatever reason, and it does so using rewrite rules, this time, rewriting s-expressions ((+ (* 3 (expt x 3)) (expt x 2) (* 4 x) 22)) to the \LaTeX{} equivalent, ${{{{3} \cdot {{x ^ {3}}}}} + {{x ^ {2}}} + {{{4} \cdot {x}}} + {22}}$ (${{3} ⋅ {{x ^ {3}}}}} + {{x ^ {2}}} + {{{4} ⋅ {x}}} + {22}}$)
WORKING Matching And Generating [0/4]
Match Test
(defun generate-match-expression (op arity &optional (type '=))
(declare (symbol op type)
(integer arity))
(ecase type
(=
`(and (eq function ',op)
(= arg-count ,arity)))
(>
`(and (eq function ',op)
(> arg-count ,arity)))
(>=
`(and (eq function ',op)
(>= arg-count ,arity)))))
Define Rule
(defmacro defrule (name (on arity &optional type) (&rest arguments) &body rule)
(let ((match-expression (generate-match-expression on arity type))
(test-name (symbolicate name '-test))
(expansion-name (symbolicate name '-expansion)))
`(progn
(defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
,match-expression)
(defun ,expansion-name (,@arguments)
,@rule)
(setf (aget *rules* ',name)
(make-rule :name ',name
:test-function #',test-name
:expansion-function #',expansion-name))
',name)))
Store Rules
(defstruct (rule (:type list))
name test-function expansion-function)
(defvar *rules* '())
Retrieve Rule
(defun get-expansion (expression)
(rule-expansion-function (rest
(first
(remove-if-not #'(lambda (nte)
(let ((test (rule-test-function (rest nte))))
(apply test expression)))
,*rules*)))))
WORKING Rules [0/10]
Multiplication
(defrule multiplication (* 2 >=) (&rest elements)
(format nil "{~{{~a}~^ \\cdot ~}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list
elements))))
Division
(defrule division (/ 2 =) (a b)
(format nil "{\\frac{~a}{~a}}"
(convert-to-tex (ensure-list a))
(convert-to-tex (ensure-list b))))
Addition
(defrule addition (+ 2 >=) (&rest elements)
(format nil "{~{{~a}~^ + ~}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list
elements))))
Subtraction
(defrule subtraction (- 2 >=) (&rest elements)
(format nil "{~{{~a}~^ - ~}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list
elements))))
Exponentials and Logarithmics
(defrule exp (exp 1 =) (expression)
(format nil "{e^{~a}}"
(convert-to-tex (ensure-list expression))))
(defrule expt (expt 2 =) (base exponent)
(format nil "{~a ^ {~a}}"
(convert-to-tex (ensure-list base))
(convert-to-tex (ensure-list exponent))))
(defrule natlog (log 1 =) (expression)
(format nil "{\\ln {~a}}"
(convert-to-tex (ensure-list expression))))
(defrule logarithm (log 2 =) (expression base)
(format nil "{\\log_{~a}~a}"
(convert-to-tex (ensure-list base))
(convert-to-tex (ensure-list expression))))
Trigonometrics
(defrule sin (sin 1 =) (arg)
(format nil "{\\sin {~a}}"
(convert-to-tex (ensure-list arg))))
(defrule cos (cos 1 =) (arg)
(format nil "{\\cos {~a}}"
(convert-to-tex (ensure-list arg))))
(defrule tan (tan 1 =) (arg)
(format nil "{\\tan {~a}}"
(convert-to-tex (ensure-list arg))))
(defrule csc (csc 1 =) (arg)
(format nil "{\\csc {~a}}"
(convert-to-tex (ensure-list arg))))
(defrule sec (sec 1 =) (arg)
(format nil "{\\sec {~a}}"
(convert-to-tex (ensure-list arg))))
(defrule cot (cot 1 =) (arg)
(format nil "{\\cot {~a}}"
(convert-to-tex (ensure-list arg))))
Logic
(defrule and (and 2 >=) (&rest elements)
(format nil "{~{{~a}~^ \\wedge ~}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list elements))))
(defrule or (or 2 >=) (&rest elements)
(format nil "{~{{~a}~^ \\vee ~}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list elements))))
(defrule not (not 1 =) (&rest elements)
(format nil "{\\not {~a}}"
(map 'list #'convert-to-tex
(map 'list #'ensure-list elements))))
Equality
(defrule = (= 2 =) (lhs rhs)
(format nil "{{~a} = {~a}}"
(convert-to-tex (ensure-list lhs))
(convert-to-tex (ensure-list rhs))))
Summation and Integration
(defrule sum (sum 3 =) (start stop expression)
(format nil "{\\sum_{~a}^{~a} {~a}}"
(convert-to-tex (ensure-list start))
(convert-to-tex (ensure-list stop))
(convert-to-tex (ensure-list expression))))
(defrule integrate (integrate 4 =) (from to expression wrt)
(format nil "{\\int_{~a}^{~a} ~a\\,\mathrm{d}~a}"
(convert-to-tex (ensure-list from))
(convert-to-tex (ensure-list to))
(convert-to-tex (ensure-list expression))
(convert-to-tex (ensure-list wrt))))
Specialty
(defrule parens (parens 2 =) (type inside)
(let* ((types '((square . ("[" . "]"))
(curly . ("{" . "}"))
(smooth . ("(" . ")"))))
(left (cadr (assoc type types)))
(right (cddr (assoc type types))))
(format nil "{\\left~a {~a} \\right~a}"
left
(convert-to-tex (ensure-list inside))
right)))
Conversion Driver
(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)))))
(defun convert-to-tex (function)
(check-type function cons)
(let ((op (first function)))
(with-tex-output
(cond
((numberp op)
(format nil "~a" op))
((and (symbolp op)
(= 1 (length function)))
(let ((symbol-pair (assoc op *special-symbols-to-sequences*)))
(if (null symbol-pair)
(string-downcase op)
(cdr symbol-pair))))
(t
(let ((expansion-function (get-expansion function)))
(if (functionp expansion-function)
(apply expansion-function (rest function))
(error "Undefined expansion for operation: ~a." op))))))))
Miscellaneous Functions
(defun ensure-list (list)
(if (listp list)
list
(list list)))
(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")))
Putting it Together
;;;; to-tex.lisp
;;;;
;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
(defpackage #:to-tex
(:use #:cl
#:com.informatimago.common-lisp.cesarum.list)
(:import-from #:alexandria
#:symbolicate)
(:export #:convert-to-tex))
(in-package #:to-tex)
;;; "to-tex" goes here.
<<tex-misc-functions>>
<<tex-rule-storage>>
<<tex-gen-match-test>>
<<tex-def-match-rule>>
<<tex-retrieve-rule>>
<<tex-conversion-driver>>
<<tex-addition-rule>>
<<tex-subtraction-rule>>
<<tex-multiplication-rule>>
<<tex-division-rule>>
<<tex-exponentials-and-logarithms>>
<<tex-trigonometrics>>
<<tex-logic-rules>>
<<tex-equality-rules>>
<<tex-summation-and-integration>>
<<tex-specialty>>
;;; End to-tex