#+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 Rewrite Rules [0/5]
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 22:58>
:END:

Foo

** TODO Match Expressions
:PROPERTIES:
:CREATED:  <2016-05-01 Sun 16:26>
:END:

Foo

#+Caption: Match Expressions
#+Name: match-expressions
#+BEGIN_SRC lisp
  (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)))))
#+END_SRC

** TODO Define Rule
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

#+Caption: Define Rule
#+Name: define-rule
#+BEGIN_SRC lisp
  (defmacro defrule (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)))
#+END_SRC

** TODO Rule Storage
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

#+Caption: Rule Storage
#+Name: rule-storage
#+BEGIN_SRC lisp
  (defstruct (rule (:type list))
    name test-function expansion-function)

  (defvar *rules* '())
#+END_SRC

** TODO Rule Retrieval
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:07>
:END:

Foo

** TODO Rule Application
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:08>
:END:

Foo

* WORKING Expression Typing [0/5]
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:15>
:ID:       c6921b1e-d269-4243-acff-5a77685c331e
:END:

#+Caption: Determine Expression Type
#+Name: determine-expression-type
#+BEGIN_SRC lisp
  <<classification-storage>>
  <<define-classification>>
  <<check-classification>>
  <<classify-expression>>
  <<possible-classifications>>
#+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 Define Classification
:PROPERTIES:
:CREATED:  <2016-05-02 Mon 13:56>
:ID:       d8826a51-50b8-467a-9e52-158502bd4138
:END:

#+Caption: Define Classification
#+Name: define-classification
#+BEGIN_SRC lisp
  (defmacro defclassification (name &body body)
    `(progn
       (defun ,(symbolicate name '-classifier) (expression &aux (length (if (listp expression) (length expression) 1)))
         (declare (ignorable length))
         ,@body)
       (pushnew '(,name . ,(symbolicate name '-classifier)) *classifications*)
       ',name))
#+END_SRC

** WORKING Check Classification
:PROPERTIES:
:CREATED:  <2016-05-02 Mon 13:56>
:ID:       6505b0b1-ffd8-4dd6-b81a-3e49483d8437
:END:

#+Caption: Check Classification
#+Name: check-classification
#+BEGIN_SRC lisp
  (defun expression-type-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*)))

  (defun expression-type (expression)
    (first (classify expression)))
#+END_SRC

** WORKING Classifications [0/11]
:PROPERTIES:
:CREATED:  <2016-05-02 Mon 13:56>
:ID:       dcce4a6b-1b2d-4638-a82b-0c4917b0698a
:END:

#+Caption: Possible Classifications
#+Name: possible-classifications
#+BEGIN_SRC lisp
  <<classify-numbers>>
  <<classify-variables>>
  <<classify-additives>>
  <<classify-subtractives>>
  <<classify-powers>>
  <<classify-exponentials>>
  <<classify-multiplicatives>>
  <<classify-logarithmics>>
  <<classify-rationals>>
  <<classify-polynomial-term>>
  <<classify-polynomials>>
#+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
  (defclassification 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
  (defclassification 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
  (defclassification 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
  (defclassification 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
  (defclassification power
    (when (listp expression)
      (and (eq 'expt (first expression))
         (expression-type-p (second expression) 'variable)
         (expression-type-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
  (defclassification natural-exponential
    (when (listp expression)
      (and (= 2 length)
         (eq 'exp (first expression)))))

  (defclassification 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
  (defclassification 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
  (defclassification natural-logarithmic
    (when (listp expression)
      (and (= 2 length)
         (eq 'log (first expression)))))

  (defclassification 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
  (defclassification 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
  (defclassification polynomial-term
    (or (expression-type-p expression 'numeric)
       (expression-type-p expression 'variable)
       (expression-type-p expression 'power)
       (and (expression-type-p expression 'multiplicative)
          (= (length (rest expression)) 2)
          (or (and (expression-type-p (second expression) 'numeric)
                (or (expression-type-p (third expression) 'power)
                   (expression-type-p (third expression) 'variable)))
             (and (expression-type-p (third expression) 'numeric)
                (or (expression-type-p (second expression) 'power)
                   (expression-type-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
  (defclassification polynomial
    (when (listp expression)
      (and (or (eq '- (first expression))
            (eq '+ (first expression)))
         (reduce #'(lambda (a b)
                     (and a b))
                 (map 'list
                   #'(lambda (the-expression)
                       (expression-type-p the-expression 'polynomial-term))
                   (rest expression))))))
#+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 (expression-type-p term 'polynomial-term)
      (if (expression-type-p term 'multiplicative)
          (second term)
          (if (expression-type-p term 'variable)
              1
              term))))

  (defun term-variable (term)
    (when (expression-type-p term 'polynomial-term)
      (cond
        ((expression-type-p term 'multiplicative) (second (third term)))
        ((expression-type-p term 'power) (second term))
        (t nil))))

  (defun get-power (term)
    (cond
      ((expression-type-p term 'polynomial-term) (third (third term)))
      ((expression-type-p term 'power) (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/7]
: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
  <<define-expression-manipulator>>
  <<external-manipulator>>
  <<addition-manipulator>>
  <<subtraction-manipulator>>
#+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
  (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)))))

  (defmacro defoperation (name arity short)
    (check-type name symbol)
    (check-type arity (integer 1 26))
    (check-type short symbol)
    (let* ((args (gen-args-list arity))
           (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
                                             `(expression-type-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 ((&rest types) &body body)
           (let ((manipulator-name (symbolicate ',base-manipulator-name (format nil "~a" (1+ (length ,rules-name))))))
             `(progn
                (setf ,',rules-name (append ,',rules-name '((,types . ,manipulator-name))))
                (defun ,manipulator-name ,',args
                  ,@body)))))))

  ;; (defmacro defmanipulator (name arity &body body)
  ;;   (cond
  ;;     ((listp arity)
  ;;      `(defun ,name (,@arity)
  ;;         ,@body))
  ;;     ((typep arity '(integer 1 26))
  ;;      (if (= arity 1)
  ;;          `(defun ,name (expression)
  ;;             ,@body)
  ;;          (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))
  ;;                 (args (loop for i from 1 to arity
  ;;                          collect (symbolicate 'expression- (nth (1- i) letters)))))
  ;;            `(defun ,name (,@args)
  ;;               ,@body))))
  ;;     ((eq arity 'rest)
  ;;      `(defun ,name (&rest expressions)
  ;;         ,@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
  (defoperation 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 (expression-type-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 (expression-type-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 (expression-type-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 ,new-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
  (defoperation 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 (expression-type-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

** TODO Multiplication
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:08>
:END:

Foo

** TODO Division
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 23:09>
:END:

Foo

** 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)

  <<determine-expression-type>>

  <<polynomial-related-functions>>

  <<collect-terms>>

  <<expression-manipulation>>
#+END_SRC