LARCS/manipulation.org

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 [2/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 type)
    (if (eq '* type)
        t
        (funcall (cdr (assoc type *classifications*))
                 expression)))

WORKING Classify Expression

  (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 [0/12]

  <<classify-numbers>>
  <<classify-variables>>
  <<classify-additives>>
  <<classify-subtractives>>
  <<classify-powers>>
  <<classify-exponentials>>
  <<classify-multiplicatives>>
  <<classify-logarithmics>>
  <<classify-rationals>>
  <<classify-polynomial-term>>
  <<classify-polynomials>>
  <<classify-trigonometrics>>

WORKING Numbers

  (define-classification numeric
    (numberp expression))

WORKING Variables

  (define-classification variable
    (symbolp expression))

WORKING Additives

  (define-classification additive
    (when (listp expression)
      (eq '+ (first expression))))

WORKING Subtractive

  (define-classification subtractive
    (when (listp expression)
      (eq '- (first expression))))

WORKING Powers

  (define-classification power
    (when (listp expression)
      (and (eq 'expt (first expression))
         (classified-as-p (second expression) 'variable)
         (classified-as-p (third expression) 'numeric))))

WORKING Exponentials

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

WORKING Multiplicatives

  (define-classification multiplicative
    (when (listp expression)
      (eq '* (first expression))))

WORKING Logarithmics

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

WORKING Rationals

  (define-classification rational
    (when (listp expression)
      (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 (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))))))

WORKING Trigonometrics

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

WORKING Classification Storage

  (defvar *classifications* '())

WORKING Term Collector

Foo

  (defun collect-terms (expression)
    (let ((terms (rest expression)))
      ))

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

  <<collect-terms>>

  <<expression-manipulation>>