LARCS/lisp-cas.org

LARCS

WORKING Introduction   nonum

It's a bold move to do what this does, building a Computer Algebra System from scratch, but I'm doing it anyway. I've chosen to do this because I wanted to understand how most CASs work, and that can be accomplished by either reading thhe source code for one, or by building one. While there are several very good CASs, the majority of them are non-free, and thus I'm not able to learn how exactly they work. Those that are free software are either not complete, or are too complex to be able to learn from easily.

This is my Computer Algebra System, and it contains the following components:

• Common Functionality

• Expression Typing

• Algebraic Manipulation

• Symbolic Solver

• Symbolic Trigonometry

• Symbolic Differentiation

• Symbolic Integration

• Symbolic To Typeset Form

• Library Assembly

• Text User Interface

• Graphical User Interface

What's in a name?   nonum

CLOSED: [2016-06-09 Thu 12:48]

The CAS contained in this is called LARCS, or the Lisp Automated Rewrite and Calculation System. This describes the system as follows:

Lisp

The CAS is written in Lisp. This is not novel, as other CAS have been written in Lisp before (Macsyma/Maxima), but it is unusual in that most new ones have been written in other languages.

Automated

The CAS will perform rewrites and calculations automatically.

Rewrite

The system is built on the concept of a rewrite system. This workse because to perform many actions in the algebra, you rewrite an equation in one way or another.

Calculation

The ability to go from a symbolic equation, something like $33 + x^2 + 10x - 3$ (+ (* 3 (expt x 3)) (expt x 2) (* 10 x) -3)~), to the result where $xgets 4$ 45).

System

A complete library and application for symbolic algebra.

TOC   ignore

WORKING Common Functionality [0/4]

Match Expression Generation

To be able to apply an expansion, you need to determine eligibility. To do this, you need an expression that matches on two things, function name and arity. To generate this, it takes an operation name and the arity. Based on the arity type ($= $> $\q$)it will construct a simple boolean statement in the format of $(nction = operator) ∧ (argument-count == arity)$,here $= is one of the above arity types.

  (defun generate-match-expression (on arity &optional (type '=) (function-var 'function) (arg-count-var 'arg-count))
    (check-type on symbol)
    (check-type type (member = > >=))
    (check-type arity (integer 0))
    (case type
      (=
       `(and (eq ,function-var ',on)
           (= ,arg-count-var ,arity)))
      (>
       `(and (eq ,function-var ',on)
           (> ,arg-count-var ,arity)))
      (>=
       `(and (eq ,function-var ',on)
           (>= ,arg-count-var ,arity)))))

Generate an Args List

  (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)))
      (let ((variables-list '()))
        (dotimes (i count)
          (pushnew (symbolicate 'expression- (nth i letters)) variables-list))
        (reverse variables-list))))

Constants and Greeks

  (defvar *special-symbols-to-sequences*
    '((alpha . "\\alpha")
      (beta . "\\beta")
      (gamma . "\\gamma")
      (delta . "\\delta")
      (epsilon . "\\epsilon")
      (varepsilon . "\\varepsilon")
      (zeta . "\\zeta")
      (eta . "\\eta")
      (theta . "\\theta")
      (vartheta . "\\vartheta")
      (gamma . "\\gamma") (kappa . "\\kappa")
      (lambda . "\\lambda")
      (mu . "\\mu")
      (nu . "\\nu")
      (xi . "\\xi")
      (omicron . "\\o")
      (pi . "\\pi")
      (varpi . "\\varpi")
      (rho . "\\rho")
      (varrho . "\\varrho")
      (sigma . "\\sigma")
      (varsigm . "\\varsigm")
      (tau . "\\tau")
      (upsilon . "\\upsilon")
      (phi . "\\phi")
      (varphi . "\\varphi")
      (chi . "\\chi")
      (psi . "\\psi")
      (omega . "\\omega")
      (big-gamma . "\\Gamma")
      (big-delta . "\\Delta")
      (big-theta . "\\Theta")
      (big-lambda . "\\Lambda")
      (big-xi . "\\Xi")
      (big-pi . "\\Pi")
      (big-sigma . "\\Sigma")
      (big-upsilon . "\\Upsilon")
      (big-phi . "\\Phi")
      (big-psi . "\\Psi")
      (big-omega . "\\Omega")))

  (defvar *constant-names*
    (mapcar #'car *special-symbols-to-sequences*))

  (mapcar #'export *constant-names*)

Assembly

  (in-package #:larcs.common)

  <<common-match-expression-generation>>

  <<common-generate-an-args-list>>

  <<constants-and-greeks>>

WORKING Expression Typing [1/8]

To be able to provide various forms of matching and manipulation, the type of an expression must be determined. This is done by analyzing the contents of the expression. To accomplish this, there must be a way to define a classifier, store all possible classifiers, check a classifier and produce a classification. To provide more flexibility in programming, there is also a special version of case, called classification-case and a when-pattern macro called when-classified-as.

Define Classification

CLOSED: [2016-06-14 Tue 23:00]

Classifications are defined as define-classification. This macro takes a name, which is the name of the classification, and a body, which is classified within a function. Inside the function, the following are bound: expression, the expression to be classified; and, length, which is the length of the expression if it's a list, otherwise, 0 if it's atomic. A cons cell containing the name of the classification and the name of the classifier is pushed onto classification storage, and the classifier name is exported.

  (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*)
         (export ',name)
         ',name)))

Check Classification

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

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)
    (let ((classifications '()))
      (dolist (possible
                ,*classifications*
               (reverse classifications))
        (let ((name (car possible))
              (checker (cdr possible)))
          (when (funcall checker expression)
            (push name classifications))))))

Classification Case

Following the case pattern, and to allow for cleaner code, I've defined the classification case macro. It does this by taking a variable name and a list of cases. These are then mapped over, producing clauses suitable for a cond expression, to which this macro finally expands, binding the complete classification of the given expression to the-classification.

  (defmacro classification-case (var &rest cases)
    (let ((conditions (map 'list #'(lambda (case)
                                     (destructuring-bind (type &body body) case
                                       (if (eq type 't)
                                           `((classified-as-p ,var '*) ,@body)
                                           `((classified-as-p ,var ',type) ,@body))))
                           cases)))
      `(let ((the-classification (classify ,var)))
         (declare (ignorable the-classification))
         (cond
           ,@conditions))))

When Classified

The when-classified-as macro takes a classification, variable and a body. It expands to a when form, with the classification and variable put into a classified-as-p call becoming the predicate, determining whether or not the body is run.

  (defmacro when-classified-as (classification variable &body body)
    `(when (classified-as-p ,variable ',classification)
       ,@body))

WORKING Classifications [0/13]

I must define several different classifications, ranging from simple numeric expressions (numbers) to trigonometric expressions ($\n$,cos$ d the lot). They are as follows:

• Numbers

• Variables

• Non-Atomics

• Additives

• Subtractives

• Powers

• Exponentials

• Multiplicatives

• Logarithmics

• Rationals

• Polynomial Terms

• Polynomials

• Trigonometrics

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

Numbers

Check to see if a given expression is a number using numberp.

  (define-classification numeric
    (numberp expression))

Variables

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

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

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 non-atomic expression
      (eq '+ (first expression))))

Subtractive

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 non-atomic expression
      (eq '- (first expression))))

Powers

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 non-atomic expression
      (and (eq 'expt (first expression))
         (classified-as-p (second expression) 'variable)
         (classified-as-p (third expression) 'numeric))))

Exponentials

This classifies both natural and non-natural exponentials. It does so by ensuring that natural exponentials ($e$)re of the form (exp x), and non-natural exponentials ($a$)re of the form (expt base power).

  (define-classification natural-exponential
    (when-classified-as non-atomic expression
      (and (= 2 length)
         (eq 'exp (first expression)))))

  (define-classification exponential
    (when-classified-as non-atomic expression
      (and (= 3 length)
         (eq 'expt (first expression)))))

Multiplicatives

To classify multiplicative expressions, it is first ensured that they are non-atomic, and then, the first element is tested to see if it is equal to the symbol *.

  (define-classification multiplicative
    (when-classified-as non-atomic expression
      (eq '* (first expression))))

Logarithmics

This defines the classifications for logarithmic expressions, for both natural and non-natural bases. For natural bases ($\ x$)it ensures that expressions are of the form (log x), and for non-natural bases ($\g_bx$)re of the form (log expression base-expression).

  (define-classification natural-logarithmic
    (when-classified-as non-atomic expression
      (and (= 2 length)
         (eq 'log (first expression)))))

  (define-classification logarithmic
    (when-classified-as non-atomic expression
      (and (= 3 length)
         (eq 'log (first expression)))))

Rationals

Rationals are classified similarly to multiplicatives, checking to see whether or not they are non-atomic and checking whether or not the first element is /, but rationals are also defined as only having three elements, the operation and two following operands, and thus, the length is also checked.

  (define-classification rational
    (when-classified-as non-atomic expression
      (and (= 3 length)
         (eq '/ (first expression)))))

Polynomial Terms

To classify a polynomial term, The expression is checked to see if it satisfies one of the following:

• Numeric

• Variable

• Power

• Multiplicative that composed of a numeric and a power or variable.

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

Polynomials

This determines whether or not a given expression is a polynomial, that is to say it is either additive or subtractive, and each and every term is classified as polynomial-term, that is to say, a numeric, power, or a multiplicative consisting of a numeric followed by a power.

  (define-classification polynomial
    (when-classified-as non-atomic 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))))))

Trigonometrics

Trigonometrics are classified as many others are, they are first checked to see if they are non-atomic, and then the first element is checked, with the following being valid symbols:

• sin

• cos

• tan

• csc

• sec

• cot

  (define-classification trigonometric
    (when-classified-as non-atomic expression
      (member (first expression) '(sin cos tan csc sec cot))))

  (define-classification sin
    (when-classified-as non-atomic expression
      (eq 'sin (first expression))))

  (define-classification cos
    (when-classified-as non-atomic expression
      (eq 'cos (first expression))))

  (define-classification tan
    (when-classified-as non-atomic expression
      (eq 'tan (first expression))))

  (define-classification csc
    (when-classified-as non-atomic expression
      (eq 'csc (first expression))))

  (define-classification sec
    (when-classified-as non-atomic expression
      (eq 'sec (first expression))))

  (define-classification cot
    (when (classified-as-p expression 'non-atomic)
      (eq 'cot (first expression))))

Classification Storage

The storage of classifications is simple, they are stored as an alist in the form of (name . classifier), in the list *classifications*.

  (defvar *classifications* '())

Assembly

  (in-package #:larcs.classify)
  <<et-classification-storage>>
  <<et-define-classification>>
  <<et-check-classification>>
  <<et-classify-expression>>
  <<et-classification-case>>
  <<et-when-classified>>
  <<et-possible-classifications>>

WORKING Algebraic Manipulation [1/5]

At the core of LARCS is the algebraic manipulation library. This provides a way for other libraries to add, subtract, multiply and divide symbolically, essentially giving a programmer the ability to create or manipulate equations. While it is neither a solver nor a simplifier, it provides the base for both of them by providing manipulators and automatic expression rewriters.

Collect Variables

CLOSED: [2016-05-31 Tue 18:54]

Variable collection is somewhat important, and to accomplish this, I use a recursive algorithm. An expression is passed to the function, and if the expression is a variable, then the variable is collected and spit out; otherwise, if the expression is non-atomic, it is passed to the function recursively, and the returned variables are then merged into the variables list. Upon termination (no further sub-expressions), all variables are returned. (See Figure fig:variable-collection.)

  digraph {
          start [label = "Start"];
          stop [label = "Stop"];
          collect [label = "Collect"];
          if_var [label = "If Variable", shape = rectangle];
          recurse_collect [label = "Iterate, Recurse and Collect Results"];

          start -> if_var;
          if_var -> collect [label = "True"];
          collect -> stop;

          if_var -> recurse_collect [label = "Non-atomic"];
          recurse_collect -> start;
  }

  (defun collect-variables (expression)
    (let ((variables '()))
      (flet ((merge-variables (variable)
               (pushnew variable variables)))
        (classification-case expression
                             (variable (merge-variables expression))
                             (non-atomic (map 'list #'(lambda (expr)
                                                        (dolist (variable (collect-variables expr))
                                                          (merge-variables variable)))
                                              (rest expression)))))
      (reverse variables)))

WORKING Polynomial Related Functions [0/6]

  <<am-get-coefficient>>
  <<am-get-term-variable>>
  <<am-get-power>>
  <<am-same-order>>
  <<am-same-variable>>
  <<am-is-combinable>>

Get Coefficient

  (defun coefficient (term)
    (when (classified-as-p term 'polynomial-term)
      (classification-case term
                           (variable 1)
                           (power 1)
                           (multiplicative (second term))
                           (numeric term))))

Get Term Variables

  (defun term-variable (term)
    (when (classified-as-p term 'polynomial-term)
      (classification-case term
                           (power (second term))
                           (multiplicative
                            (if (listp (third term))
                                (second (third term))
                                (third term)))
                           (numeric nil))))

Get Power

  (defun get-power (term)
    (classification-case term
                         (numeric 0)
                         (variable 1)
                         (power (third term))
                         (multiplicative
                          (if (listp (third term))
                              (third (third term))
                              1))
                         (* 0)))

Same Order

  (defun same-order-p (term-a term-b)
    (= (get-power term-a)
       (get-power term-b)))

Same Variable

  (defun same-variable-p (term-a term-b)
    (eq (term-variable term-a)
        (term-variable term-b)))

Is Combinable

  (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 [2/8]

Foo

  <<am-misc-manipulator-functions>>
  <<am-define-expression-manipulator>>
  <<am-external-manipulator>>
  <<am-addition-manipulator>>
  <<am-subtraction-manipulator>>
  <<am-multiplication-manipulators>>
  <<am-division-manipulators>>
  <<am-trigonometric-manipulators>>

Manipulator Miscellaneous Functions

CLOSED: [2016-05-08 Sun 10:34]

This defines the *manipulator-map*, where the manipulators for various functions are stored, and defines a function to generate an arguments list given a count of arguments.

  (defvar *manipulator-map* '())

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

  (defpackage #:manipulator
    (:use #:cl)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:manipulate
             #:classify
             #:classified-as-p
             #:classification-case
             #:collect-variables
             #:collect-terms))

  (load "larcs-manipulation")

  (in-package #:manipulator)

  (format t "#+Caption: Expression Manipulator Expansion~%#+Name: am-ex-manip-expansion~%#+BEGIN_SRC lisp :exports code~%~a~%#+END_SRC"
          (macroexpand-1 '(define-operation frobnicate 2 frob)))

(PROGN
 (PUSH '(FROB . FROBNICATE) *MANIPULATOR-MAP*)
 (DEFVAR *MANIPULATORS-FROBNICATE* 'NIL)
 (DEFUN FROBNICATE-IS-APPLICABLE-P (TYPES EXPRESSION-A EXPRESSION-B)
   (AND (CLASSIFIED-AS-P EXPRESSION-A (NTH 0 TYPES))
        (CLASSIFIED-AS-P EXPRESSION-B (NTH 1 TYPES))))
 (DEFUN GET-FROBNICATE-MANIPULATORS (EXPRESSION-A EXPRESSION-B)
   (REMOVE-IF #'NULL
              (MAP 'LIST
                   #'(LAMBDA (OPTION)
                       (LET ((TYPES (CAR OPTION)) (NAME (CDR OPTION)))
                         (IF (FROBNICATE-IS-APPLICABLE-P TYPES EXPRESSION-A
                              EXPRESSION-B)
                             NAME)))
                   *MANIPULATORS-FROBNICATE*)))
 (DEFUN FROBNICATE (EXPRESSION-A EXPRESSION-B)
   (FUNCALL (FIRST (GET-FROBNICATE-MANIPULATORS EXPRESSION-A EXPRESSION-B))
            EXPRESSION-A EXPRESSION-B))
 (DEFMACRO DEFINE-FROBNICATE-MANIPULATOR
           ((EXPRESSION-A-TYPE EXPRESSION-B-TYPE) &BODY BODY)
   (LET ((MANIPULATOR-NAME
          (SYMBOLICATE 'FROBNICATE-MANIPULATOR- EXPRESSION-A-TYPE
                       EXPRESSION-B-TYPE)))
     `(PROGN
       (SETF ,'*MANIPULATORS-FROBNICATE*
               (APPEND ,'*MANIPULATORS-FROBNICATE*
                       '(((,EXPRESSION-A-TYPE ,EXPRESSION-B-TYPE)
                          ,@MANIPULATOR-NAME))))
       (DEFUN ,MANIPULATOR-NAME ,'(EXPRESSION-A EXPRESSION-B) ,@BODY)))))

External Manipulator

CLOSED: [2016-05-31 Tue 19:48]

The Expression Manipulators should not be touched outside of this package, as they are not designed to be used outside of it. Instead, they should be used through this simple function. It takes an action and a list of expressions. The function used to perform the action correctly is determined, and used to reduce the expressions.

  (defun manipulate (action &rest expressions)
    (let ((the-manipulator (cdr (assoc action *manipulator-map*))))
      (reduce the-manipulator
              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 *)

  (define-multiply-manipulator (numeric numeric)
    (* expression-a expression-b))

  (define-multiply-manipulator (numeric polynomial-term)
    (let ((new-coefficient (* expression-a (coefficient expression-b)))
          (variable (term-variable expression-b))
          (power (get-power expression-b)))
      (if (= 1 power)
          `(* ,new-coefficient ,variable)
          `(* ,new-coefficient (expt ,variable ,power)))))

  (define-multiply-manipulator (polynomial-term polynomial-term)
    (let ((new-coefficient (* (coefficient expression-a)
                              (coefficient expression-b)))
          (variable (term-variable expression-b))
          (power (+ (get-power expression-a)
                    (get-power expression-b))))
      `(* ,new-coefficient (expt ,variable ,power))))

WORKING Division

Foo

  (define-operation division 2 /)

  (define-division-manipulator (numeric numeric)
    (/ expression-a expression-b))

  (define-division-manipulator (polynomial-term polynomial-term)
    (let ((new-coefficient (/ (coefficient expression-a)
                              (coefficient expression-b)))
          (variable (term-variable expression-b))
          (power (- (get-power expression-a)
                    (get-power expression-b))))
      `(* ,new-coefficient (expt ,variable ,power))))

WORKING Trigonometric [0/6]

Foo

  <<am-sine-manipulators>>
  <<am-cosine-manipulators>>
  <<am-tangent-manipulators>>
  <<am-cosecant-manipulators>>
  <<am-secant-manipulators>>
  <<am-cotangent-manipulators>>

WORKING Sine

Foo

  (define-operation sine 1 sin)

  (define-sine-manipulator (numeric)
    (sin expression-a))

WORKING Cosine

Foo

  (define-operation cosine 1 cos)

  (define-cosine-manipulator (numeric)
    (cosine expression-a))

WORKING Tangent

Foo

  (define-operation tangent 1 tan)

  (define-tangent-manipulator (numeric)
    (tan expression-a))

WORKING Cosecant

Foo

  (define-operation cosecant 1 csc)

WORKING Secant

Foo

  (define-operation secant 1 sec)

WORKING Cotangent

Foo

  (define-operation cotangent 1 cot)

Assembly

This assembles and packages the algebraic manipulation system into a single file and library. To do so, it must first define a package, import specific symbols from other packages, and export symbols from itself. It then includes the remainder of the functionality, placing it in the file manipulation.lisp.

  (in-package #:larcs.manipulate)

  <<am-determine-expression-type>>

  <<am-collect-variables>>

  <<am-collect-terms>>

  <<am-polynomial-related-functions>>

  <<am-expression-manipulation>>

WORKING Symbolic Solver [0/3]

Techniques

Rules

Assembly

WORKING Symbolic Trigonometry [0/2]

Rules

Assembly

WORKING Symbolic Differentiation [0/4]

WORKING Rule Definition [0/3]

Definition

  (defmacro define-derivative (expression-type (&rest arguments-list) &body body)
    (let ((expansion-name (symbolicate expression-type '-expansion)))
      `(progn
         (when (not (member ',expression-type (mapcar #'car *rules*)))
           (setq *rules* (append *rules* '((,expression-type . ,expansion-name)))))
         (defun ,expansion-name (,@arguments-list)
           ,@body))))

Retrieval

  (defun get-rule (expression)
    (cdr (first (remove-if #'(lambda (pair)
                               (let ((type (first pair)))
                                 (not (classified-as-p expression type))))
                           ,*rules*))))

Storage

  (defvar *rules* '())

WORKING Rules [0/9]

  <<sd-numbers>>
  <<sd-variables>>
  <<sd-polynomial-terms>>
  <<sd-multiplicatives>>
  <<sd-rationals>>
  <<sd-additives>>
  <<sd-subtractives>>
  <<sd-exponentials-and-logarithmics>>

Numbers

  (define-derivative numeric (&rest junk)
    (declare (ignorable junk))
    0)

Variables

  (define-derivative variable (&rest junk)
    (declare (ignorable junk))
    1)

Polynomial Terms

  (define-derivative polynomial-term (&rest term)
    (let* ((coefficient (coefficient term))
           (variable (term-variable term))
           (power (get-power term)))
      (cond
        ((= 1 power)
         coefficient)
        ((= 2 power)
         `(* ,(* coefficient power) ,variable))
        (t
         `(* ,(* coefficient power) (expt ,variable ,(1- power)))))))

Multiplicatives

  (define-derivative multiplicative (function first &rest rest)
    (declare (ignore function))
    (if (= 1 (length rest))
        (let ((second (first rest)))
          (cond
            ((and (classified-as-p first 'numeric)
                (classified-as-p second 'numeric))
             (* first second))
            ((classified-as-p first 'numeric)
             `(* ,first ,(differentiate second)))
            ((classified-as-p second 'numeric)
             `(* ,second ,(differentiate first)))
            (t
             `(+ (* ,first ,(differentiate second))
                 (* ,second ,(differentiate first))))))
        (differentiate `(* ,first (* ,@rest)))))

Rationals

  (define-derivative rational (function numerator denominator)
    (declare (ignore function))
    `(/ (- (* ,numerator ,(differentiate denominator))
           (* ,denominator ,(differentiate numerator)))
        (expt ,denominator 2)))

Additives

  (define-derivative additive (function &rest terms)
    (declare (ignore function))
    `(+ ,@(map 'list #'(lambda (term) (differentiate term)) terms)))

Subtractives

  (define-derivative subtractive (function &rest terms)
    (declare (ignore function))
    `(- ,@(map 'list #'(lambda (term) (differentiate term)) terms)))

Exponentials and Logarithmics

  (define-derivative natural-exponential (function expression)
    (declare (ignore function))
    `(exp ,expression))

  (define-derivative exponential (function base power)
    (declare (ignore function))
    (if (numberp power)
        (if (listp base)
            `(* ,power (expt ,base ,(1- power)) ,(differentiate base))
            `(* ,power (expt ,base ,(1- power))))
        `(* (expt ,base ,power) (log ,base))))

  (define-derivative natural-logarithmic (function expression)
    (declare (ignore function))
    `(/ ,(differentiate expression) ,expression))

  (define-derivative logarithmic (function number base)
    (declare (ignore function))
    `(/ ,(differentiate (cons 'log number)) (* (log ,base) ,number)))

Trigonometric Functions

  (define-derivative sin (function expression)
    (declare (ignore function))
    `(* ,(differentiate expression) (cos ,expression)))

  (define-derivative cos (function expression)
    (declare (ignore function))
    `(* ,(differentiate expression) (- (sin ,expression))))

  (define-derivative tan (function expression)
    (declare (ignore function))
    `(* ,(differentiate expression) (expt (sec ,expression) 2)))

  (define-derivative csc (function expression)
    (declare (ignore function))
    `(* ,(differentiate expression) (- (csc ,expression)) (cot ,expression)))

  (define-derivative cot (function expression)
    (declare (ignore function))
    `(* ,(differentiate expression) (- (expt (csc ,expression) 2))))

Driver

  (defun differentiate (function)
    (let ((rule (get-rule function)))
      (when rule
        (apply rule (ensure-list function)))))

Assembly

  (in-package #:larcs.differentiate)
  <<sd-rule-storage>>
  <<sd-rule-definition>>
  <<sd-rule-retrieval>>
  <<sd-rules>>
  <<sd-derivative-driver>>

WORKING Symbolic Integration [0/3]

Rules

Techniques

Assembly

WORKING Symbolic To Typeset Form [0/5]

WORKING Rule Management [0/3]

Define Rules

  (defmacro define-converter (expression-type (&rest arguments-list) &body body)
    (let ((expansion-name (symbolicate expression-type '-conversion)))
      `(progn
         (when (not (member ',expression-type (mapcar #'car *rules*)))
           (setq *rules* (append *rules* '((,expression-type . ,expansion-name)))))
         (defun ,expansion-name (,@arguments-list)
           ,@body))))

Rule Retrieval

  (defun get-rule (expression)
    (cdr (first (remove-if #'(lambda (pair)
                               (let ((type (first pair)))
                                 (not (classified-as-p expression type))))
                           ,*rules*))))

Rule Storage

  (defvar *rules* '())

WORKING Rules [0/9]

  <<stf-numerics>>
  <<stf-variables>>
  <<stf-polynomial-terms>>
  <<stf-multiplicatives>>
  <<stf-rationals>>
  <<stf-additives>>
  <<stf-subtractives>>
  <<stf-trigonometrics>>
  <<stf-exponentials-logarithmics>>

Numbers

  (define-converter numeric (number)
    (with-tex-output
      (format nil "{~A}" number)))

Variables

  (define-converter variable (var)
    (if (member var *constant-names*)
        (with-tex-output
          (format nil "{~A}" (cdr (assoc var *special-symbols-to-sequences*))))
        (with-tex-output
          (format nil "{~A}" (string-downcase var)))))

Polynomial Terms

  (define-converter polynomial-term (&rest term)
    (let ((variable (term-variable term))
          (coefficient (coefficient term))
          (power (get-power term)))
      (cond
        ((= 1 power)
         (with-tex-output
           (format nil "{~A}{~A}"
                   (convert-for-display coefficient)
                   (convert-for-display power))))
        ((= 0 coefficient)
         (with-tex-output
           (format nil "{~A}^{~A}"
                   (convert-for-display variable)
                   (convert-for-display power))))
        (t
         (with-tex-output
           (format nil "{~A}{~A}^{~A}"
                   (convert-for-display coefficient)
                   (convert-for-display variable)
                   (convert-for-display power)))))))

Multiplicatives

  (define-converter multiplicative (op &rest elements)
    (declare (ignore op))
    (with-tex-output
      (format nil "{~{~A~^ \\cdot ~}}"
              (mapcar #'convert-for-display
                      elements))))

Rationals

  (define-converter rational (op numerator denominator)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\frac{~A}{~A}}"
              (convert-for-display numerator)
              (convert-for-display denominator))))

Additives

  (define-converter additive (op &rest terms)
    (declare (ignore op))
    (with-tex-output
      (format nil "{~{~A~^ + ~}}"
              (mapcar #'convert-for-display terms))))

Subtractives

  (define-converter subtractive (op &rest terms)
    (declare (ignore op))
    (with-tex-output
      (format nil "{~{~A~^ - ~}}"
              (mapcar #'convert-for-display terms))))

Trigonometrics

  (define-converter sin (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\sin {~A}}" (convert-for-display term))))

  (define-converter cos (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\cos {~A}}" (convert-for-display term))))

  (define-converter tan (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\tan {~A}}" (convert-for-display term))))

  (define-converter csc (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\csc {~A}}" (convert-for-display term))))

  (define-converter sec (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\sec {~A}}" (convert-for-display term))))

  (define-converter cot (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\cot {~A}}" (convert-for-display term))))

Exponentials and Logarithmics

  (define-converter natural-exponential (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{e^~A}" (convert-for-display term))))

  (define-converter exponential (op base power)
    (declare (ignore op))
    (with-tex-output
      (format nil "{~A^~A}"
              (convert-for-display base)
              (convert-for-display power))))

  (define-converter natural-logarithmic (op term)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\ln ~A}"
              (convert-for-display term))))

  (define-converter logarithmic (op term base)
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\log_~a ~a}"
              (convert-for-display base)
              (convert-for-display term))))

WORKING Converter [0/4]

  (defun convert-for-display (function)
    (if (and (listp function)
           (member (first function) '(and or not = sum integrate parens)))
        (let ((operator (first function)))
          (cond
            ((eq operator 'and)
             <<stf-and-operator>>
             )
            ((eq operator 'or)
             <<stf-or-operator>>
             )
            ((eq operator 'not)
             <<stf-not-operator>>
             )
            ((eq operator '=)
             <<stf-equality-operator>>
             )
            ((eq operator 'sum)
             <<stf-summation>>
             )
            ((eq operator 'integrate)
             <<stf-integration>>
             )
            ((eq operator 'parens)
             <<stf-parenthesis>>
             )))
        (let ((rule (get-rule function)))
          (when rule
            (apply rule (ensure-list function))))))

WORKING Logical Operators [0/4]

And

Foo

  (destructuring-bind (op &rest terms) function
    (declare (ignore op))
    (with-tex-output
      (format nil "{~{~A~^ \\wedge ~}}"
              (mapcar #'convert-for-display terms))))

Or

Foo

  (destructuring-bind (op &rest terms) function
    (declare (ignore op))
    (with-tex-output
      (format nil "{~{~A~^ \\vee ~}}"
              (mapcar #'convert-for-display terms))))

Not

Foo

  (destructuring-bind (op term) function
    (with-tex-output
      (format nil "{\\not ~A}"
              (convert-for-display term))))

Equality

Foo

  (destructuring-bind (op lhs rhs) function
    (declare (ignore op))
    (format nil "{~A = ~A}"
            (convert-for-display lhs)
            (convert-for-display rhs)))

Summation

  (destructuring-bind (op start stop expression) function
    (declare (ignore op))
    (format nil "{\sum_~A^~A ~A}"
            (convert-for-display start)
            (convert-for-display stop)
            (convert-for-display expression)))

Integration

  (destructuring-bind (op from to expression wrt) function
    (declare (ignore op))
    (with-tex-output
      (format nil "{\\int_~A^~A ~A\\,\\mathrm{d}~A}"
              (convert-for-display from)
              (convert-for-display to)
              (convert-for-display expression)
              (convert-for-display wrt))))

Parenthesis

  (destructuring-bind (op type expression) function
    (declare (ignore op))
    (let* ((types '((square . ("[" . "]"))
                    (curly . ("{" . "}"))
                    (smooth . ("(" . ")"))))
           (left (cadr (assoc type types)))
           (right (cddr (assoc type types))))
      (with-tex-output
        (format nil "{\\left~a {~a} \\right~a}"
                left
                (convert-for-display expression)
                right))))

Special Macros

  (defvar *tex-outputp* nil)
  (declaim (special *tex-outputp*))

  (defmacro with-tex-output (&body body)
    `(if *tex-outputp*
         (progn
           ,@body)
         (let ((*tex-outputp* t))
           (format nil "$~a$"
                   (progn
                     ,@body)))))

Assembly

  (in-package #:larcs.typeset)
  <<stf-special-macros>>
  <<stf-rule-storage>>
  <<stf-rule-retrieval>>
  <<stf-define-rule>>
  <<stf-conversion-driver>>

WORKING Library Assembly [0/2]

Package Definitions

  (defpackage #:larcs.common
    (:use #:cl)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:generate-match-expression
             #:gen-args-list
             #:*special-symbols-to-sequences*
             #:*constant-names*))

  (defpackage #:larcs.classify
    (:use #:cl
          #:larcs.common)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:classify
             #:classified-as-p
             #:classification-case))

  (defpackage #:larcs.manipulate
    (:use #:cl
          #:larcs.common
          #:larcs.classify)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:manipulate
             #:collect-variables
             #:collect-terms
             #:coefficient
             #:term-variable
             #:get-power
             #:same-order-p
             #:save-variable-p
             #:single-term-combinable-p))

  (defpackage #:larcs.differentiate
    (:use #:cl
          #:larcs.common
          #:larcs.classify
          #:larcs.manipulate)
    (:import-from #:alexandria
                  #:symbolicate)
    (:import-from #:com.informatimago.common-lisp.cesarum.list
                  #:aget
                  #:ensure-list)
    (:export :differentiate))

  (defpackage #:larcs.typeset
    (:use #:cl
          #:larcs.common
          #:larcs.classify
          #:larcs.manipulate)
    (:import-from #:alexandria
                  #:symbolicate)
    (:import-from #:com.informatimago.common-lisp.cesarum.list
                  #:aget
                  #:ensure-list)
    (:export #:convert-for-display))

System Definition

  (asdf:defsystem #:larcs-lib
    :description "A CAS Library for use within Lisp Software."
    :author "Samuel Flint <swflint@flintfam.org>"
    :license "GNU GPLv3 or Later"
    :depends-on (#:alexandria
                 #:com.informatimago)
    :serial t
    :components ((:file "larcs-packages")
                 (:file "larcs-common")
                 (:file "larcs-classify")
                 (:file "larcs-manipulation")
                 (:file "larcs-differentiate")
                 (:file "larcs-typeset")))

WORKING Text User Interface [0/2]

System Definition

  '(#:alexandria
    #:command-line-arguments
    #:cl-readline)

Functionality

WORKING Graphical User Interface [0/3]

System Definition

  '(#:alexandria
    #:command-line-arguments
    #:commonqt)

Interface Elements

Interface Functionality