LARCS/lisp-to-tex.org

Lisp Equations to LaTeX

TODO 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/10]

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 Logic

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

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

  (defrule not (not 1 =) (&rest elements)
    (format nil "{\\not {~a}}"
            (map 'list #'convert-to-tex
                 (map 'list #'ensure-list elements))))

TODO Equality

  (defrule = (= 2 =) (lhs rhs)
    (format nil "{{~a} = {~a}}"
            (convert-to-tex (ensure-list lhs))
            (convert-to-tex (ensure-list rhs))))

TODO Summation and Integration

  (defrule sum (sum 3 =) (start stop expression)
    (format nil "{\\sum_{~a}^{~a} {~a}}"
            (convert-to-tex (ensure-list start))
            (convert-to-tex (ensure-list stop))
            (convert-to-tex (ensure-list expression))))

  (defrule integrate (integrate 4 =) (from to expression wrt)
    (format nil "{\\int_{~a}^{~a} ~a\\,\mathrm{d}~a}"
            (convert-to-tex (ensure-list from))
            (convert-to-tex (ensure-list to))
            (convert-to-tex (ensure-list expression))
            (convert-to-tex (ensure-list wrt))))

TODO Specialty

  (defrule parens (parens 2 =) (type inside)
    (let* ((types '((square . ("[" . "]"))
                    (curly . ("{" . "}"))
                    (smooth . ("(" . ")"))))
           (left (cadr (assoc type types)))
           (right (cddr (assoc type types))))
      (format nil "{\\left~a {~a} \\right~a}"
              left
              (convert-to-tex (ensure-list inside))
              right)))

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)))
           (let ((symbol-pair (assoc op *special-symbols-to-sequences*)))
             (if (null symbol-pair)
                 (string-downcase op)
                 (cdr symbol-pair))))
          (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)))

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

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

  <<rule-storage>>

  <<gen-match-test>>

  <<def-match-rule>>

  <<retrieve-rule>>

  <<conversion-driver>>

  <<addition-rule>>

  <<subtraction-rule>>

  <<multiplication-rule>>

  <<division-rule>>

  <<exponentials-and-logarithms>>

  <<trigonometrics>>

  <<logic-rules>>

  <<equality-rules>>

  <<summation-and-integration>>

  <<specialty>>

  ;;; End to-tex