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 Macros [0/2]

Foo

WORKING Define Expression Manipulator

  (defmacro defmanipulator (name arity &body body)
    (check-type name symbol)
    (check-type arity (or (integer 1 26) (eql rest) (cons symbol *)))
    (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))))

WORKING Rewrite Rules [0/4]

Foo

Define Rule

Foo

Rule Storage

Foo

Rule Retrieval

Foo

Rule Application

Foo

WORKING Expression Typing

  (defun expression-type (expression)
    (cond
      ((numberp expression) 'number)
      ((symbolp expression) 'variable)
      ((eq '+ (first expression)) 'additive)
      ((eq '- (first expression)) 'subtractive)
      ((and (eq '* (first expression))
          (= 2 (length (rest expression)))
          (expression-type-p (third expression) 'power)) 'polynomial-term)
      ((eq '* (first expression)) 'multiplicative)
      ((eq 'expt (first expression)) 'power)))

  (defun expression-type-p (expression type)
    (eq type (expression-type expression)))

Term Collector

Foo

Combine Polynomial Terms

  (defun coefficient (term)
    (second term))

  (defun term-variable (term)
    (second (third term)))

  (defun get-power (term)
    (cond
      ((expression-type-p term 'polynomial-term) (third (third term)))
      ((expression-type-p term 'power) (third term))))

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

  (defun combine-polynomial-terms (operation term-a term-b)
    (if (single-term-combinable-p term-a term-b)
        `(* ,(if (eq operation '+)
                 (+ (coefficient term-a)
                    (coefficient term-b))
                 (- (coefficient term-a)
                    (coefficient term-b)))
            (expt ,(term-variable term-a) ,(get-power term-a)))
        `(,operation ,term-a ,term-b)))

WORKING Expression Manipulators [0/6]

Foo

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

  (defmanipulator add 2
    (if (and (expression-type-p expression-b 'number)
           (not (eq 'number (expression-type expression-a))))
        (add expression-b expression-a)
        (cond
          ((and (expression-type-p expression-a 'number)
              (expression-type-p expression-b 'number))
           (+ expression-a expression-b))
          ((and (expression-type-p expression-a 'number)
              (expression-type-p expression-b 'additive))
           (let ((total expression-a)
                 (the-other (rest expression-b))
                 (non-numbers '()))
             (loop for other in the-other
                do (if (numberp other)
                       (incf total other)
                       (push other non-numbers)))
             (if (null non-numbers)
                 total
                 `(+ ,total ,@non-numbers))))
          ((and (expression-type-p expression-a 'additive)
              (expression-type-p expression-b 'additive))
           (let ((total 0)
                 (elements (append (rest expression-a)
                                   (rest expression-b)))
                 (non-numerics '()))
             (loop for element in elements
                do (if (numberp element)
                       (incf total element)
                       (push element non-numerics)))
             (if (null non-numerics)
                 total
                 `(+ ,total ,@non-numerics))))
          ((and (expression-type-p expression-a 'number)
              (expression-type-p expression-b 'subtractive))
           (let ((total expression-a)
                 (the-other (rest expression-b))
                 (non-numeric '()))
             (loop for other in the-other
                do (if (numberp other)
                       (decf total other)
                       (push other non-numeric)))
             (if (null non-numeric)
                 total
                 `(+ ,total (- ,@(reverse non-numeric))))))
          ((and (expression-type-p expression-a 'polynomial-term)
              (expression-type-p expression-b 'polynomial-term))
           (combine-polynomial-terms '+ expression-a expression-b)))))

Subtraction

Foo

Multiplication

Foo

Division

Foo

Trigonometric

Foo

Rewrite Rules

Foo

WORKING Packaging

Foo

  (defpackage #:manipulator
    (:use #:cl)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:manipulate))

  (in-package #:manipulator)

  <<define-expression-manipulator>>

  <<determine-expression-type>>

  <<combine-polynomial-terms>>

  <<addition-manipulator>>

  <<external-manipulator>>