LARCS/lisp-to-tex.org

Lisp Equations to TeX

Introduction   nonum

Foo

TOC   ignoreheading

WORKING Matching And Generating [0/4]

TODO Match Test

  (defun generate-match-expression (op arity &optional (type '=))
    (declare (symbol op type)
             (integer arity))
    (ecase type
      (=
       `(and (eq function ',op)
           (= arg-count ,arity)))
      (>
       `(and (eq function ',op)
           (> arg-count ,arity)))
      (>=
       `(and (eq function ',op)
           (>= arg-count ,arity)))))

TODO Define Rule

  (defmacro defrule (name (on arity &optional type) (&rest arguments) &body rule)
    (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)
           ,@rule)
         (setf (aget *rules* ',name)
               (make-rule :name ',name
                          :test-function #',test-name
                          :expansion-function #',expansion-name))
         ',name)))

TODO Store Rules

  (defstruct (rule (:type list))
    name test-function expansion-function)

  (defvar *rules* '())

TODO Retrieve Rule

  (defun get-expansion (expression)
    (rule-expansion-function (rest
                              (first
                               (remove-if-not #'(lambda (nte)
                                                  (let ((test (rule-test-function (rest nte))))
                                                    (apply test expression)))
                                              ,*rules*)))))

WORKING Rules [0/6]

TODO Multiplication

  (defrule multiplication (* 2 >=) (&rest elements)
    (format nil "{~{{~a}~^ \\cdot ~}}"
            (map 'list #'convert-to-tex
                 (map 'list #'ensure-list
                      elements))))

TODO Division

  (defrule division (/ 2 =) (a b)
    (format nil "{\\frac{~a}{~a}}"
            (convert-to-tex (ensure-list a))
            (convert-to-tex (ensure-list b))))

TODO Addition

  (defrule addition (+ 2 >=) (&rest elements)
           (format nil "{~{{~a}~^ + ~}}"
                   (map 'list #'convert-to-tex
                        (map 'list #'ensure-list
                             elements))))

TODO Subtraction

  (defrule subtraction (- 2 >=) (&rest elements)
    (format nil "{~{{~a}~^ - ~}}"
            (map 'list #'convert-to-tex
                 (map 'list #'ensure-list
                      elements))))

TODO Exponentials and Logarithmics

  (defrule exp (exp 1 =) (expression)
    (format nil "{e^{~a}}"
            (convert-to-tex (ensure-list expression))))

  (defrule expt (expt 2 =) (base exponent)
    (format nil "{~a ^ {~a}}"
            (convert-to-tex (ensure-list base))
            (convert-to-tex (ensure-list exponent))))

  (defrule natlog (log 1 =) (expression)
    (format nil "{\\ln {~a}}"
            (convert-to-tex (ensure-list expression))))

  (defrule logarithm (log 2 =) (expression base)
    (format nil "{\\log_{~a}~a}"
            (convert-to-tex (ensure-list base))
            (convert-to-tex (ensure-list expression))))

TODO Trigonometrics

  (defrule sin (sin 1 =) (arg)
    (format nil "{\\sin {~a}}"
            (convert-to-tex (ensure-list arg))))

  (defrule cos (cos 1 =) (arg)
    (format nil "{\\cos {~a}}"
            (convert-to-tex (ensure-list arg))))

  (defrule tan (tan 1 =) (arg)
    (format nil "{\\tan {~a}}"
            (convert-to-tex (ensure-list arg))))

  (defrule csc (csc 1 =) (arg)
    (format nil "{\\csc {~a}}"
            (convert-to-tex (ensure-list arg))))

  (defrule sec (sec 1 =) (arg)
    (format nil "{\\sec {~a}}"
            (convert-to-tex (ensure-list arg))))

  (defrule cot (cot 1 =) (arg)
    (format nil "{\\cot {~a}}"
            (convert-to-tex (ensure-list arg))))

TODO Conversion Driver

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

  (defun convert-to-tex (function)
    (check-type function cons)
    (let ((op (first function)))
      (with-tex-output
        (cond
          ((numberp op)
           (format nil "~a" op))
          ((and (symbolp op)
              (= 1 (length function)))
           (string-downcase op))
          (t
           (let ((expansion-function (get-expansion function)))
             (if (functionp expansion-function)
                 (apply expansion-function (rest function))
                 (error "Undefined expansion for operation: ~a." op))))))))

TODO Miscellaneous Functions

  (defun ensure-list (list)
    (if (listp list)
        list
        (list list)))

TODO Putting it Together

  ;;;; to-tex.lisp
  ;;;;
  ;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>

  (defpackage #:to-tex
    (:use #:cl
          #:com.informatimago.common-lisp.cesarum.list)
    (:import-from #:alexandria
                  #:symbolicate)
    (:export #:convert-to-tex))

  (in-package #:to-tex)

  ;;; "to-tex" goes here.

  <<misc-function>>

  <<rule-storage>>

  <<gen-match-test>>

  <<def-match-rule>>

  <<retrieve-rule>>

  <<conversion-driver>>

  <<addition-rule>>

  <<subtraction-rule>>

  <<multiplication-rule>>

  <<division-rule>>

  <<exponentials-and-logarithms>>

  <<trigonometrics>>

  ;;; End to-tex