#+Title: Lisp Equations to LaTeX
#+AUTHOR: Sam Flint
#+EMAIL: swflint@flintfam.org
#+DATE: \today
#+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js
#+OPTIONS: toc:nil H:5 ':t *:t
#+PROPERTY: noweb no-export
#+PROPERTY: comments noweb
#+LATEX_HEADER: \usepackage[color]{showkeys}
#+LATEX_HEADER: \parskip=5pt
#+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,basestyle=\ttfamily,frame=lines,literate={lambda}{$\lambda$}{1} {set}{$\gets$}1 {setq}{$\gets$}1 {setf}{$\gets$}1 {<=}{$\leq$}1 {>=}{$\geq$}1}

* TODO Introduction                                                   :nonum:
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 17:53>
:END:

Foo

* TOC                                                         :ignoreheading:

#+TOC: headlines 3
#+TOC: listings

* WORKING Matching And Generating [0/4]
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:END:

** TODO Match Test
:PROPERTIES:
:ID:       9d165cb9-95f2-4006-a8a1-73a0750b2000
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Generate Match Test
#+Name: gen-match-test
#+BEGIN_SRC lisp
  (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)))))
#+END_SRC

** TODO Define Rule
:PROPERTIES:
:ID:       d4f77ac3-a059-4fb6-b936-1b9e972646ee
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Define Matching Rule
#+Name: def-match-rule
#+BEGIN_SRC lisp
  (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)))
#+END_SRC

** TODO Store Rules
:PROPERTIES:
:ID:       002ea704-4286-429f-9149-0f29fb73c503
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Rule Storage
#+Name: rule-storage
#+BEGIN_SRC lisp
  (defstruct (rule (:type list))
    name test-function expansion-function)

  (defvar *rules* '())
#+END_SRC

** TODO Retrieve Rule
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 15:25>
:ID:       e3f34100-d0a5-4039-8b9d-115cfcb0804e
:END:

#+Caption: Retrieve Rule
#+Name: retrieve-rule
#+BEGIN_SRC lisp
  (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*)))))
#+END_SRC

* WORKING Rules [0/6]
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:END:

** TODO Multiplication
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:ID:       5417a6bf-f265-418a-984b-6bfd14b79a80
:END:

#+Caption: Multiplication Rule
#+Name: multiplication-rule
#+BEGIN_SRC lisp
  (defrule multiplication (* 2 >=) (&rest elements)
    (format nil "{~{{~a}~^ \\cdot ~}}"
            (map 'list #'convert-to-tex
                 (map 'list #'ensure-list
                      elements))))
#+END_SRC

** TODO Division
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:ID:       056aa99c-f2b9-4ab6-99ba-bfb87e3baed5
:END:

#+Caption: Division Rule
#+Name: division-rule
#+BEGIN_SRC lisp
  (defrule division (/ 2 =) (a b)
    (format nil "{\\frac{~a}{~a}}"
            (convert-to-tex (ensure-list a))
            (convert-to-tex (ensure-list b))))
#+END_SRC

** TODO Addition
:PROPERTIES:
:ID:       68f3dac3-9f0a-4fee-8da6-a39f4491f3ce
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Rule for addition
#+Name: addition-rule
#+BEGIN_SRC lisp
  (defrule addition (+ 2 >=) (&rest elements)
           (format nil "{~{{~a}~^ + ~}}"
                   (map 'list #'convert-to-tex
                        (map 'list #'ensure-list
                             elements))))
#+END_SRC

** TODO Subtraction
:PROPERTIES:
:ID:       9a908130-af5e-4c87-bb07-13bd66c35fcf
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Subtraction Rule
#+Name: subtraction-rule
#+BEGIN_SRC lisp
  (defrule subtraction (- 2 >=) (&rest elements)
    (format nil "{~{{~a}~^ - ~}}"
            (map 'list #'convert-to-tex
                 (map 'list #'ensure-list
                      elements))))
#+END_SRC

** TODO Exponentials and Logarithmics
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:ID:       269dc47f-5062-4081-a08e-d50188af6a57
:END:

#+Caption: Exponentials and Logarithms
#+Name: exponentials-and-logarithms
#+BEGIN_SRC lisp
  (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))))
#+END_SRC

** TODO Trigonometrics
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:19>
:ID:       837806c9-7174-43a3-80b2-355b645d46ed
:END:

#+Caption: Trigonometric Functions
#+Name: trigonometrics
#+BEGIN_SRC lisp
  (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))))
#+END_SRC

* TODO Conversion Driver
:PROPERTIES:
:ID:       b395bdb7-7b98-49a1-b6d6-4256fb40d4fa
:CREATED:  <2016-04-30 Sat 16:19>
:END:

#+Caption: Conversion Driver
#+Name: conversion-driver
#+BEGIN_SRC lisp
  (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))))))))
#+END_SRC

* TODO Miscellaneous Functions
:PROPERTIES:
:CREATED:  <2016-04-30 Sat 16:09>
:ID:       a4ab8a72-0b09-453c-b936-2470d5429c05
:END:

#+Caption: Misc Functions
#+Name: misc-functions
#+BEGIN_SRC lisp
  (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")))
#+END_SRC

* TODO Putting it Together
:PROPERTIES:
:ID:       fdef3016-cb12-43ad-ba5f-14dd6ccd973c
:CREATED:  <2016-04-30 Sat 16:25>
:END:

#+Caption: Packaging
#+Name: packaging
#+BEGIN_SRC lisp :tangle "to-tex.lisp"
  ;;;; 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>>

  ;;; End to-tex
#+END_SRC