#+Title: Simple Algebraic Manipulation #+Subtitle: An approach to allow for the solving and simplification of expressions #+AUTHOR: Samuel W. Flint #+EMAIL: swflint@flintfam.org #+DATE: \today #+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js #+OPTIONS: toc:nil H:5 ':t *:t todo:nil stat:nil d:nil #+PROPERTY: noweb no-export #+PROPERTY: comments noweb #+LATEX_HEADER: \usepackage[margins=0.75in]{geometry} #+LATEX_HEADER: \parskip=5pt #+LATEX_HEADER: \parindent=0pt #+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,basicstyle=\ttfamily,frame=lines,literate={<=}{$\leq$}1 {>=}{$\geq$}1} #+LATEX_CLASS_OPTIONS: [10pt,twoside] #+LATEX_HEADER: \pagestyle{headings} * COMMENT Export #+Caption: Export Document #+Name: export-document #+BEGIN_SRC emacs-lisp :exports none :results none (save-buffer) (let ((org-confirm-babel-evaluate (lambda (lang body) (declare (ignorable lang body)) nil))) (org-latex-export-to-pdf)) #+END_SRC * COMMENT Tangle #+Caption: Tangle Document #+Name: tangle-document #+BEGIN_SRC emacs-lisp :exports none :results none (save-buffer) (let ((python-indent-offset 4)) (org-babel-tangle)) #+END_SRC * DONE Introduction :nonum: CLOSED: [2016-05-01 Sun 14:33] :PROPERTIES: :CREATED: <2016-04-30 Sat 22:55> :END: 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: :PROPERTIES: :CREATED: <2016-04-30 Sat 22:55> :END: #+TOC: headlines 3 #+TOC: listings * WORKING Expression Typing [2/5] :PROPERTIES: :CREATED: <2016-04-30 Sat 23:15> :ID: c6921b1e-d269-4243-acff-5a77685c331e :END: 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. #+Caption: Determine Expression Type #+Name: determine-expression-type #+BEGIN_SRC lisp <> <> <> <> <> #+END_SRC ** DONE Define Classification CLOSED: [2016-05-04 Wed 19:30] :PROPERTIES: :CREATED: <2016-05-02 Mon 13:56> :ID: d8826a51-50b8-467a-9e52-158502bd4138 :END: 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. #+Caption: Define Classification #+Name: define-classification #+BEGIN_SRC lisp (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))) #+END_SRC ** DONE Check Classification CLOSED: [2016-05-04 Wed 19:37] :PROPERTIES: :CREATED: <2016-05-02 Mon 13:56> :ID: 6505b0b1-ffd8-4dd6-b81a-3e49483d8437 :END: 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. #+Caption: Check Classification #+Name: check-classification #+BEGIN_SRC lisp (defun classified-as-p (expression type) (if (eq '* type) t (funcall (cdr (assoc type *classifications*)) expression))) #+END_SRC ** WORKING Classify Expression :PROPERTIES: :CREATED: <2016-05-02 Mon 14:09> :ID: 82d75d54-1d33-400b-86a3-7d16af938ac8 :END: #+Caption: Classify Expression #+Name: classify-expression #+BEGIN_SRC lisp (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*))) #+END_SRC ** WORKING Classifications [0/12] :PROPERTIES: :CREATED: <2016-05-02 Mon 13:56> :ID: dcce4a6b-1b2d-4638-a82b-0c4917b0698a :END: #+Caption: Possible Classifications #+Name: possible-classifications #+BEGIN_SRC lisp <> <> <> <> <> <> <> <> <> <> <> <> #+END_SRC *** WORKING Numbers :PROPERTIES: :CREATED: <2016-05-02 Mon 14:26> :ID: 42081153-7cc5-42ff-a17f-53e171c6d1a7 :END: #+Caption: Classify Numbers #+Name: classify-numbers #+BEGIN_SRC lisp (define-classification numeric (numberp expression)) #+END_SRC *** WORKING Variables :PROPERTIES: :CREATED: <2016-05-02 Mon 14:26> :ID: 4c676754-ef9a-485f-91a2-8f1bd83c7659 :END: #+Caption: Classify Variables #+Name: classify-variables #+BEGIN_SRC lisp (define-classification variable (symbolp expression)) #+END_SRC *** WORKING Additives :PROPERTIES: :CREATED: <2016-05-02 Mon 14:26> :ID: 736d79dc-f34c-4247-b592-690d7f2fddd9 :END: #+Caption: Classify Additives #+Name: classify-additives #+BEGIN_SRC lisp (define-classification additive (when (listp expression) (eq '+ (first expression)))) #+END_SRC *** WORKING Subtractive :PROPERTIES: :CREATED: <2016-05-02 Mon 14:26> :ID: c59d086f-2f49-485a-8f96-57d85e774f60 :END: #+Caption: Classify Subtractives #+Name: classify-subtractives #+BEGIN_SRC lisp (define-classification subtractive (when (listp expression) (eq '- (first expression)))) #+END_SRC *** WORKING Powers :PROPERTIES: :CREATED: <2016-05-02 Mon 14:27> :ID: cc15dd10-7cc0-4370-9e69-daf903b30ad5 :END: #+Caption: Classify Powers #+Name: classify-powers #+BEGIN_SRC lisp (define-classification power (when (listp expression) (and (eq 'expt (first expression)) (classified-as-p (second expression) 'variable) (classified-as-p (third expression) 'numeric)))) #+END_SRC *** WORKING Exponentials :PROPERTIES: :CREATED: <2016-05-02 Mon 15:04> :ID: a11fdd94-d56c-4749-bb22-dca75159dbcb :END: #+Caption: Classify Exponentials #+Name: classify-exponentials #+BEGIN_SRC lisp (define-classification natural-exponential (when (listp expression) (and (= 2 length) (eq 'exp (first expression))))) (define-classification exponential (when (listp expression) (and (= 3 length) (eq 'expt (first expression))))) #+END_SRC *** WORKING Multiplicatives :PROPERTIES: :CREATED: <2016-05-02 Mon 14:27> :ID: feb85a20-93e3-45a1-be01-9893ecc07c53 :END: #+Caption: Classify Multiplicatives #+Name: classify-multiplicatives #+BEGIN_SRC lisp (define-classification multiplicative (when (listp expression) (eq '* (first expression)))) #+END_SRC *** WORKING Logarithmics :PROPERTIES: :CREATED: <2016-05-02 Mon 14:27> :ID: 0b733d75-e1ab-413f-8f8a-6a8a47db409c :END: #+Caption: Classify Lograthmics #+Name: classify-logarithmics #+BEGIN_SRC lisp (define-classification natural-logarithmic (when (listp expression) (and (= 2 length) (eq 'log (first expression))))) (define-classification logarithmic (when (listp expression) (and (= 3 length) (eq 'log (first expression))))) #+END_SRC *** WORKING Rationals :PROPERTIES: :CREATED: <2016-05-02 Mon 14:28> :ID: a4505a66-c249-4438-a6df-81e21718e23e :END: #+Caption: Classify Rationals #+Name: classify-rationals #+BEGIN_SRC lisp (define-classification rational (when (listp expression) (and (= 3 length) (eq '/ (first expression))))) #+END_SRC *** WORKING Polynomial Terms :PROPERTIES: :CREATED: <2016-05-02 Mon 14:28> :ID: 37da52b7-98a0-4a16-8a17-a62fcff2ba59 :END: #+Caption: Classify Polynomial Term #+Name: classify-polynomial-term #+BEGIN_SRC lisp (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))))))) #+END_SRC *** WORKING Polynomials :PROPERTIES: :CREATED: <2016-05-02 Mon 14:28> :ID: 8cd9045b-81dd-4571-930a-a852f81969c9 :END: #+Caption: Classify Polynomials #+Name: classify-polynomials #+BEGIN_SRC lisp (define-classification polynomial (when (listp 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)))))) #+END_SRC *** WORKING Trigonometrics :PROPERTIES: :CREATED: <2016-05-04 Wed 13:38> :ID: 6f433cad-4b81-4a6f-ab65-981f4a924812 :END: #+Caption: Classify Trigonometrics #+Name: classify-trigonometrics #+BEGIN_SRC lisp (define-classification sin (when (listp expression) (eq 'sin (first expression)))) (define-classification cos (when (listp expression) (eq 'cos (first expression)))) (define-classification tan (when (listp expression) (eq 'tan (first expression)))) (define-classification csc (when (listp expression) (eq 'csc (first expression)))) (define-classification sec (when (listp expression) (eq 'sec (first expression)))) (define-classification cot (when (listp expression) (eq 'cot (first expression)))) #+END_SRC ** WORKING Classification Storage :PROPERTIES: :CREATED: <2016-05-02 Mon 13:55> :ID: ff35cd33-3c10-4a45-a2c5-32bc3fdc1acc :END: #+Caption: Classification Storage #+Name: classification-storage #+BEGIN_SRC lisp (defvar *classifications* '()) #+END_SRC * WORKING Term Collector :PROPERTIES: :CREATED: <2016-04-30 Sat 22:59> :ID: c1856735-914b-4f73-8825-3e5a062113d2 :END: Foo #+Caption: Collect Terms #+Name: collect-terms #+BEGIN_SRC lisp (defun collect-terms (expression) (let ((terms (rest expression))) )) #+END_SRC * WORKING Polynomial Related Functions :PROPERTIES: :CREATED: <2016-05-01 Sun 12:29> :ID: 984d0f52-4c52-4bfa-a150-f3289d25bdf1 :END: #+Caption: Polynomial Related Functions #+Name: polynomial-related-functions #+BEGIN_SRC lisp (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))) #+END_SRC * WORKING Expression Manipulators [0/8] :PROPERTIES: :CREATED: <2016-04-30 Sat 22:58> :ID: 4fe60cc1-be66-4d5e-8922-590554d99004 :END: Foo #+Caption: Expression Manipulation #+Name: expression-manipulation #+BEGIN_SRC lisp <> <> <> <> <> <> #+END_SRC ** WORKING Manipulator Miscellaneous Functions :PROPERTIES: :CREATED: <2016-05-03 Tue 15:38> :ID: 20450528-d763-4c14-a085-5ac54d4d4b85 :END: #+Caption: Misc Manipulator Functions #+Name: misc-manipulator-functions #+BEGIN_SRC lisp (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))))) #+END_SRC ** WORKING Define Expression Manipulator :PROPERTIES: :CREATED: <2016-04-30 Sat 22:57> :ID: 63909972-428d-47f3-9dc3-3e1fb213aa70 :END: #+Caption: Define Expression Manipulator #+Name: define-expression-manipulator #+BEGIN_SRC lisp (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))))))) #+END_SRC ** WORKING External Manipulator :PROPERTIES: :CREATED: <2016-05-01 Sun 14:33> :ID: 6419490c-3cb0-47e4-840a-c20af4bfb3d7 :END: #+Caption: External Manipulator #+Name: external-manipulator #+BEGIN_SRC lisp ;; (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)))) #+END_SRC ** WORKING Addition :PROPERTIES: :CREATED: <2016-04-30 Sat 23:08> :ID: b794486c-e493-408f-b80c-a440edae1bc8 :END: Foo #+Caption: Addition Manipulator #+Name: addition-manipulator #+BEGIN_SRC lisp (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)) #+END_SRC ** WORKING Subtraction :PROPERTIES: :CREATED: <2016-04-30 Sat 23:08> :ID: f675fd81-e995-41ee-9570-cc78261d9dc1 :END: Foo #+Caption: Subtraction Manipulator #+Name: subtraction-manipulator #+BEGIN_SRC lisp (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)) #+END_SRC ** WORKING Multiplication :PROPERTIES: :CREATED: <2016-04-30 Sat 23:08> :ID: cddffdaa-10dd-425f-9697-3f0617162953 :END: Foo #+Caption: Multiplication Manipulators #+Name: multiplication-manipulators #+BEGIN_SRC lisp (define-operation multiply 2 *) #+END_SRC ** TODO Division :PROPERTIES: :CREATED: <2016-04-30 Sat 23:09> :END: Foo #+Caption: Division Manipulators #+Name: division-manipulators #+BEGIN_SRC lisp (define-operation division 2 /) #+END_SRC ** TODO Trigonometric :PROPERTIES: :CREATED: <2016-04-30 Sat 23:09> :END: Foo * WORKING Packaging :PROPERTIES: :CREATED: <2016-04-30 Sat 23:07> :ID: d487ed31-295b-4274-aef2-b45e4fa7bec2 :END: Foo #+Caption: Packaging #+Name: packaging #+BEGIN_SRC lisp :tangle "manipulation.lisp" (defpackage #:manipulator (:use #:cl) (:import-from #:alexandria #:symbolicate) (:export #:manipulate)) (in-package #:manipulator) <> <> <> <> #+END_SRC