manipulation.org 24 KB
Simple Algebraic Manipulation
COMMENT Export
(save-buffer)
(let ((org-confirm-babel-evaluate
(lambda (lang body)
(declare (ignorable lang body))
nil)))
(org-latex-export-to-pdf))
COMMENT Tangle
(save-buffer)
(let ((python-indent-offset 4))
(org-babel-tangle))
Introduction nonum
CLOSED: [2016-05-01 Sun 14:33]
As a part of my lisp-based Computer Algebra System, an algebraic manipulation toolkit is required. This will be used to simplify equations, or for that matter solve them. This creates this toolkit, but does not create a complete simplifier or solver. It does this by providing manipulators and automatic rewriters. These together will provide simplification and solving utilities.
TOC ignore
WORKING Expression Typing [4/5]
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.
<<classification-storage>> <<define-classification>> <<check-classification>> <<classify-expression>> <<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)
(remove-if #'null
(map 'list #'(lambda (name-and-checker)
(let ((name (car name-and-checker))
(checker (cdr name-and-checker)))
(if (funcall checker expression)
name
nil)))
,*classifications*)))
WORKING Classifications [6/13]
I must define several different classifications, ranging from numeric expressions to trigonometric expressions. They are as follows:
-
Numbers
-
Variables
-
Non-Atomics
-
Additives
-
Subtractives
-
Powers
-
Exponentials
-
Multiplicatives
-
Logarithmics
-
Rationals
-
Polynomial Terms
-
Polynomials
-
Trigonometrics
<<classify-numbers>> <<classify-variables>> <<classify-non-atomics>> <<classify-additives>> <<classify-subtractives>> <<classify-powers>> <<classify-exponentials>> <<classify-multiplicatives>> <<classify-logarithmics>> <<classify-rationals>> <<classify-polynomial-term>> <<classify-polynomials>> <<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-p expression 'non-atomic)
(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-p expression 'non-atomic)
(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-p expression 'non-atomic)
(and (eq 'expt (first expression))
(classified-as-p (second expression) 'variable)
(classified-as-p (third expression) 'numeric))))
WORKING Exponentials
(define-classification natural-exponential
(when (classified-as-p expression 'non-atomic)
(and (= 2 length)
(eq 'exp (first expression)))))
(define-classification exponential
(when (classified-as-p expression 'non-atomic)
(and (= 3 length)
(eq 'expt (first expression)))))
WORKING Multiplicatives
(define-classification multiplicative
(when (classified-as-p expression 'non-atomic)
(eq '* (first expression))))
WORKING Logarithmics
(define-classification natural-logarithmic
(when (classified-as-p expression 'non-atomic)
(and (= 2 length)
(eq 'log (first expression)))))
(define-classification logarithmic
(when (classified-as-p expression 'non-atomic)
(and (= 3 length)
(eq 'log (first expression)))))
WORKING Rationals
(define-classification rational
(when (classified-as-p expression 'non-atomic)
(and (= 3 length)
(eq '/ (first expression)))))
WORKING Polynomial Terms
(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)))))))
WORKING Polynomials
(define-classification polynomial
(when (classified-as-p expression 'non-atomic)
(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))))))
WORKING Trigonometrics
(define-classification sin
(when (classified-as-p expression 'non-atomic)
(eq 'sin (first expression))))
(define-classification cos
(when (classified-as-p expression 'non-atomic)
(eq 'cos (first expression))))
(define-classification tan
(when (classified-as-p expression 'non-atomic)
(eq 'tan (first expression))))
(define-classification csc
(when (classified-as-p expression 'non-atomic)
(eq 'csc (first expression))))
(define-classification sec
(when (classified-as-p expression 'non-atomic)
(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* '())
WORKING Polynomial Related Functions
(defun coefficient (term)
(when (classified-as-p term 'polynomial-term)
(cond
((classified-as-p term 'variable) 1)
((classified-as-p term 'power) 1)
((classified-as-p term 'multiplicative) (second term))
((classified-as-p term 'numeric) term))))
(defun term-variable (term)
(when (classified-as-p term 'polynomial-term)
(cond
((classified-as-p term 'multiplicative) (second (third term)))
((classified-as-p term 'power) (second term))
(t nil))))
(defun get-power (term)
(cond
((classified-as-p term 'power) (third term))
((classified-as-p term 'polynomial-term) (third (third term)))
(t 0)))
(defun same-order-p (term-a term-b)
(= (get-power term-a)
(get-power term-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 (same-order-p term-a term-b)
(same-variable-p term-a term-b)))
WORKING Expression Manipulators [0/8]
Foo
<<misc-manipulator-functions>> <<define-expression-manipulator>> <<external-manipulator>> <<addition-manipulator>> <<subtraction-manipulator>> <<multiplication-manipulators>>
WORKING Manipulator Miscellaneous Functions
(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)))
(loop for i from 1 to count
collect (symbolicate 'expression- (nth (1- i) letters)))))
WORKING Define Expression Manipulator
(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)))))))
WORKING External Manipulator
;; (defun manipulate (action &rest expressions) ;; (case action ;; (+ ;; (reduce #'add expressions)) ;; (- ;; (reduce #'subtract expressions)) ;; (* ;; (reduce #'multiply expressions)) ;; (/ ;; (reduce #'divide expressions)) ;; (sin ;; (reduce #'manip-sin expressions)) ;; (cos ;; (reduce #'manip-cos expressions)) ;; (tan ;; (reduce #'manip-tan expressions)) ;; (expt ;; (reduce #'powers 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 *)
Division
Foo
(define-operation division 2 /)
Trigonometric
Foo
WORKING Packaging
Foo
(defpackage #:manipulator
(:use #:cl)
(:import-from #:alexandria
#:symbolicate)
(:export #:manipulate))
(in-package #:manipulator)
<<determine-expression-type>>
<<polynomial-related-functions>>
<<expression-manipulation>>