larcs.org_archive 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941
  1. # -*- mode: org -*-
  2. Archived entries from file /home/swflint/Projects/lisp-cas/lisp-cas.org
  3. * TODO Match Expressions
  4. :PROPERTIES:
  5. :ID: 39f69de5-6fcc-4ad4-984f-72fc0f77f11b
  6. :CREATED: <2016-06-11 Sat 22:20>
  7. :ARCHIVE_TIME: 2016-06-13 Mon 20:27
  8. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  9. :ARCHIVE_OLPATH: Symbolic Differentiation/Expansions
  10. :ARCHIVE_CATEGORY: lisp-cas
  11. :ARCHIVE_TODO: TODO
  12. :END:
  13. 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 ($=$, $>$, $\leq$), it will construct a simple boolean statement in the format of $(function = operator) \land (argument-count == arity)$, where $==$ is one of the above arity types.
  14. #+Caption: Match Expressions
  15. #+Name: derive-match-expressions
  16. #+BEGIN_SRC lisp
  17. ;; (defun generate-match-expression (on arity &optional (type '=))
  18. ;; (check-type on symbol)
  19. ;; (check-type type (member = > >=))
  20. ;; (check-type arity (integer 0))
  21. ;; (case type
  22. ;; (=
  23. ;; `(and (eq function ',on)
  24. ;; (= arg-count ,arity)))
  25. ;; (>
  26. ;; `(and (eq function ',on)
  27. ;; (> arg-count ,arity)))
  28. ;; (>=
  29. ;; `(and (eq function ',on)
  30. ;; (>= arg-count ,arity)))))
  31. #+END_SRC
  32. * TODO Match Test
  33. :PROPERTIES:
  34. :ID: 9d165cb9-95f2-4006-a8a1-73a0750b2000
  35. :CREATED: <2016-04-30 Sat 16:19>
  36. :ARCHIVE_TIME: 2016-06-13 Mon 20:29
  37. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  38. :ARCHIVE_OLPATH: Conversion from Symbolic Expressions to Typeset Display Formats/Matching And Generating
  39. :ARCHIVE_CATEGORY: lisp-cas
  40. :ARCHIVE_TODO: TODO
  41. :END:
  42. #+Caption: Generate Match Test
  43. #+Name: tex-gen-match-test
  44. #+BEGIN_SRC lisp
  45. ;; (defun generate-match-expression (op arity &optional (type '=))
  46. ;; (declare (symbol op type)
  47. ;; (integer arity))
  48. ;; (ecase type
  49. ;; (=
  50. ;; `(and (eq function ',op)
  51. ;; (= arg-count ,arity)))
  52. ;; (>
  53. ;; `(and (eq function ',op)
  54. ;; (> arg-count ,arity)))
  55. ;; (>=
  56. ;; `(and (eq function ',op)
  57. ;; (>= arg-count ,arity)))))
  58. #+END_SRC
  59. * WORKING Symbolic Differentiation [0/5]
  60. :PROPERTIES:
  61. :CREATED: <2016-06-09 Thu 09:21>
  62. :ID: 360bc5f4-39ac-4161-9326-00c3daaf368c
  63. :ARCHIVE_TIME: 2016-06-14 Tue 10:57
  64. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  65. :ARCHIVE_CATEGORY: lisp-cas
  66. :ARCHIVE_TODO: WORKING
  67. :END:
  68. The calculation of derivatives has many uses. However, the calculation of derivatives can often be tedious. To make this faster, I've written the following program to make it faster.
  69. ** WORKING Expansions [0/3]
  70. CLOSED: [2016-06-09 Thu 09:22]
  71. :PROPERTIES:
  72. :CREATED: <2016-06-09 Thu 09:22>
  73. :END:
  74. This program works in terms of expansion functions, and application tests. That is to say, there is a test to see if the expansion is valid for the given expression.
  75. *** WORKING Definition
  76. :PROPERTIES:
  77. :ID: d7430ac9-cc9a-4942-a8c7-4d21c1705ad4
  78. :CREATED: <2016-06-11 Sat 22:20>
  79. :END:
  80. To define an expansion requires just a bit of syntactic sugar in the form of the ~defexpansion~ macro. This macro does 3 things, generate a test function, generate an expansion function and pushes the name of the expansion, the test function and the expansion function on to the rules list.
  81. To generate the test function, it uses the match-expression generator and wraps it into a function taking two arguments, a function and a list of arguments to the function. The test is then made, acting as predicate function for whether or not the expansion is applicable.
  82. To generate the expansion function, a series of expressions is used as the body of the function, with the function destructured to form the arguments.
  83. #+Caption: Expansion Definition
  84. #+Name: derive-expansion-definition
  85. #+BEGIN_SRC lisp
  86. (defmacro defexpansion (name (on arity &optional (type '=)) (&rest arguments) &body expansion)
  87. (let ((match-expression (generate-match-expression on arity type 'function 'arg-count))
  88. (test-name (symbolicate name '-test))
  89. (expansion-name (symbolicate name '-expansion)))
  90. `(progn
  91. (defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
  92. ,match-expression)
  93. (defun ,expansion-name (,@arguments)
  94. ,@expansion)
  95. (setf (aget *rules* ',name)
  96. (make-rule :name ',name
  97. :test-function #',test-name
  98. :expansion-function #',expansion-name))
  99. ',name)))
  100. #+END_SRC
  101. *** WORKING Retrieval
  102. :PROPERTIES:
  103. :ID: 71d8545b-d5d1-4179-a0b1-3539c8e68105
  104. :CREATED: <2016-06-11 Sat 22:20>
  105. :END:
  106. To allow for the use of expansions, you must be able to retrieve the correct one from the expansions list.
  107. To do so, you need the second element of the list that is the ~(name test expansion)~ for the rule. This is found by removing the expansions for which the test returns false for the given expression.
  108. #+Caption: Expansion Retrieval
  109. #+Name: derive-expansion-retrieval
  110. #+BEGIN_SRC lisp
  111. (defun get-expansion (expression)
  112. (rule-expansion-function (rest (first
  113. (remove-if-not #'(lambda (nte)
  114. (let ((test (rule-test-function (rest nte))))
  115. (apply test expression)))
  116. ,*rules*)))))
  117. #+END_SRC
  118. *** TODO Storage
  119. :PROPERTIES:
  120. :ID: 0cf2d0ad-cdd1-4a5e-a849-615961c2e869
  121. :CREATED: <2016-06-11 Sat 22:20>
  122. :END:
  123. One of the more important parts of the program is a way to store expansions. This is however, quite boring. It's just a global variable (~*rules*~), containing a list of lists having the form of ~(name test-lambda expander-lambda)~.
  124. #+Caption: Expansion Storage
  125. #+Name: derive-expansion-storage
  126. #+BEGIN_SRC lisp
  127. (defstruct (rule (:type list))
  128. name test-function expansion-function)
  129. (defvar *rules* '())
  130. #+END_SRC
  131. ** WORKING Rules [0/5]
  132. CLOSED: [2016-06-09 Thu 09:22]
  133. :PROPERTIES:
  134. :CREATED: <2016-06-09 Thu 09:22>
  135. :END:
  136. There are many rules for derivation of equations. These rules allow one to derive equations quickly and easily by matching equations up with relevant rules and applying those rules.
  137. *** TODO Multiplication
  138. :PROPERTIES:
  139. :ID: 15f0ba68-9335-4d97-b3c7-418187895706
  140. :CREATED: <2016-06-11 Sat 22:21>
  141. :END:
  142. The derivatives of multiplication follows two rules, the Constant Multiple rule:
  143. \[ \frac{d}{dx} cf(x) = c \cdot f^\prime(x) ,\]
  144. which is a specialized version of the more generalized Product Rule:
  145. \[ \frac{d}{dx} f(x) \cdot g(x) = f(x) \cdot g^\prime(x) + g(x) \cdot f^\prime(x) .\]
  146. There are two forms of the Product Rule as implemented, both matching on the ~*~ function, but taking a different number of arguments. The first takes 2 arguments, and is the main driver for derivation, following the two above rules. The second takes 3 or more, and modifies the arguments slightly so as to make it a derivative of two different equations.
  147. #+Caption: Rules for Multiplication
  148. #+Name: derive-multiplication
  149. #+BEGIN_SRC lisp
  150. (defexpansion mult/2 (* 2) (first second)
  151. (cond
  152. ((numberp first)
  153. `(* ,first ,(derive (ensure-list second))))
  154. ((numberp second)
  155. `(* ,second ,(derive (if (listp first) first (list second)))))
  156. (t
  157. `(+ (* ,first ,(derive (ensure-list second)))
  158. (* ,second ,(derive (ensure-list first)))))))
  159. (defexpansion mult/3+ (* 3 >=) (first &rest rest)
  160. (derive `(* ,first ,(cons '* rest))))
  161. #+END_SRC
  162. *** TODO Division
  163. :PROPERTIES:
  164. :ID: 483285d3-f035-4b50-9f3f-4389d01b7504
  165. :CREATED: <2016-06-11 Sat 22:21>
  166. :END:
  167. Division follows the Quotient Rule, which is as follows:
  168. \[ \frac{d}{dx} \frac{f(x)}{g(x)} = \frac{f^\prime(x) \cdot g(x) - g^\prime(x) \cdot f(x)}{(g(x))^2} .\]
  169. The rule matches on the ~/~ function, and takes 2 arguments, a numerator and a denominator, its expansion is as above.
  170. #+Caption: Rules for Division
  171. #+Name: derive-division
  172. #+BEGIN_SRC lisp
  173. (defexpansion div/2 (/ 2) (numerator denominator)
  174. `(/ (- (* ,numerator ,(derive (ensure-list denominator)))
  175. (* ,denominator ,(derive (ensure-list numerator))))
  176. (expt ,denominator 2)))
  177. #+END_SRC
  178. *** TODO Addition/Subtraction
  179. :PROPERTIES:
  180. :ID: b4f6b80a-0904-491a-a0ca-850dcb6809c5
  181. :CREATED: <2016-06-11 Sat 22:21>
  182. :END:
  183. Addition and subtraction of functions in derivatives is simple, simply add or subtract the derivatives of the functions, as shown here:
  184. \[ \frac{d}{dx} f_1(x) + f_2(x) + \cdots + f_n(x) = f_1^\prime(x) + f_2^\prime(x) + \cdots + f_n^\prime(x) \]
  185. and here:
  186. \[ \frac{d}{dx} f_1(x) - f_2(x) - \cdots - f_n(x) = f_1^\prime(x) - f_2^\prime(x) - \cdots - f_n^\prime(x) .\]
  187. This is accomplished by matching on either ~+~ or ~-~, and taking 2 or more arguments, deriving all of the passed in equations and applying the respective operation.
  188. #+Caption: Rules for Addition and Subtraction
  189. #+Name: derive-addition-subtraction
  190. #+BEGIN_SRC lisp
  191. (defexpansion plus/2+ (+ 2 >=) (&rest clauses)
  192. `(+ ,@(map 'list #'(lambda (clause)
  193. (if (listp clause)
  194. (derive clause)
  195. (derive (list clause))))
  196. clauses)))
  197. (defexpansion minus/2+ (- 2 >=) (&rest clauses)
  198. `(- ,@(map 'list #'(lambda (clause)
  199. (if (listp clause)
  200. (derive clause)
  201. (derive (list clause))))
  202. clauses)))
  203. #+END_SRC
  204. *** TODO Exponentials and Logarithms
  205. :PROPERTIES:
  206. :ID: eaed7558-82d0-4300-8e5f-eb48a06d4e64
  207. :CREATED: <2016-06-11 Sat 22:21>
  208. :END:
  209. The derivatives of exponential and logarithmic functions follow several rules. For $e^x$ or $a^x$, the "Xerox" rule is used:
  210. \[ \frac{d}{dx} e^x = e^x ,\]
  211. and
  212. \[ \frac{d}{dx} a^x = a^x \cdot \ln x .\]
  213. Logarithmic functions follow the forms as shown:
  214. \[ \frac{d}{dx} \ln x = \frac{x^\prime}{x} ,\]
  215. and
  216. \[ \frac{d}{dx} \log_b x = \frac{x^\prime}{\ln b \cdot x} .\]
  217. However, equations of the form $x^n$ follow this form (The Power Rule):
  218. \[ \frac{d}{dx} x^n = x^\prime \cdot n \cdot x^{n-1} .\]
  219. The following rules match based on the appropriate Lisp functions and the number of arguments taken based on whether or not you are performing natural or unnatural operations.
  220. #+Caption: Rules for Exponentials and Logarithms
  221. #+Name: derive-exponentials-logarithms
  222. #+BEGIN_SRC lisp
  223. (defexpansion exp/1 (exp 1) (expression)
  224. (if (listp expression)
  225. `(* (exp ,expression) ,(derive expression))
  226. (if (numberp expression)
  227. 0
  228. `(exp ,expression))))
  229. (defexpansion expt/2 (expt 2) (base exponent)
  230. (if (numberp exponent)
  231. (if (listp base)
  232. `(* ,exponent (expt ,base ,(1- exponent)) ,(derive base))
  233. `(* ,exponent (expt ,base ,(1- exponent))))
  234. `(* (expt ,base ,exponent) (log ,base))))
  235. (defexpansion log/1 (log 1) (expression)
  236. `(/ ,(derive (ensure-list expression)) ,expression))
  237. (defexpansion log/2 (log 2) (number base)
  238. (declare (ignorable number base))
  239. `(/ ,(derive (cons 'log number)) (* (log ,base) ,number)))
  240. #+END_SRC
  241. *** TODO Trigonometric
  242. :PROPERTIES:
  243. :ID: c0f40e80-8a19-4749-bc9b-b1e94ef6949a
  244. :CREATED: <2016-06-11 Sat 22:21>
  245. :END:
  246. The derivation of trigonometric functions is simply the application of the chain rule. As such, each of the trig functions has a different derivative, as shown here:
  247. \[ \frac{d}{dx} \sin x = x^\prime \cdot \cos x ,\]
  248. \[ \frac{d}{dx} \cos x = x^\prime \cdot -\sin x ,\]
  249. \[ \frac{d}{dx} \tan x = x^\prime \cdot \sec^2 x ,\]
  250. \[ \frac{d}{dx} \csc x = x^\prime \cdot -\csc x \cdot \cot x ,\]
  251. \[ \frac{d}{dx} \sec x = x^\prime \cdot \sec x \cdot \tan x ,\]
  252. and
  253. \[ \frac{d}{dx} \cot x = x^\prime \cdot -\csc^2 x .\]
  254. These rules all match on their respective trig function and substitute as appropriate.
  255. #+Caption: Rules for Trigonometric Functions
  256. #+Name: derive-trigonometrics
  257. #+BEGIN_SRC lisp
  258. (defexpansion sin/1 (sin 1) (arg)
  259. `(* (cos ,arg) ,(derive (ensure-list arg))))
  260. (defexpansion cos/1 (cos 1) (arg)
  261. `(* (- (sin ,arg)) ,(derive (ensure-list arg))))
  262. (defexpansion tan/1 (tan 1) (arg)
  263. `(* (expt (sec ,arg) 2) ,(derive (ensure-list arg))))
  264. (defexpansion csc/1 (csc 1) (arg)
  265. `(* (- (csc ,arg)) (cot ,arg) ,(derive (ensure-list arg))))
  266. (defexpansion sec/1 (sec 1) (arg)
  267. `(* (sec ,arg) (tan ,arg) ,(derive (ensure-list arg))))
  268. (defexpansion cot/1 (cot 1) (arg)
  269. `(* (- (expt (csc ,arg) 2)) ,(derive (ensure-list arg))))
  270. #+END_SRC
  271. ** TODO Derivative Driver
  272. :PROPERTIES:
  273. :ID: b03c5070-602a-412e-a6ce-3dda65630153
  274. :CREATED: <2016-06-09 Thu 09:22>
  275. :END:
  276. This function is probably the most important user-facing function in the package.
  277. Derive takes a list, and based on the first element in the list, and the length of the list, it will do one of the following things:
  278. - Number :: Return 0, the derivative of a number is 0, except in certain cases listed above.
  279. - Symbol, and length is 1 :: This is a variable. Return 1, $\frac{d}{dx}x=1$.
  280. - Expansion Function Available :: There is an expansion rule, use this to derive the equation.
  281. - No Expansion Rule :: Signal an error, equation was likely malformed.
  282. #+Caption: Derivative Driver
  283. #+Name: derive-derivative-driver
  284. #+BEGIN_SRC lisp
  285. (defun derive (function)
  286. (check-type function cons)
  287. (let ((op (first function)))
  288. (cond
  289. ((numberp op)
  290. 0)
  291. ((and (symbolp op)
  292. (= 1 (length function)))
  293. 1)
  294. (t
  295. (let ((expansion-function (get-expansion function)))
  296. (if (functionp expansion-function)
  297. (apply expansion-function (rest function))
  298. (error "Undefined expansion: ~a" op)))))))
  299. #+END_SRC
  300. ** TODO Miscellaneous Functions
  301. :PROPERTIES:
  302. :ID: 41439f82-466f-46a5-b706-df43e5f23650
  303. :CREATED: <2016-06-09 Thu 09:22>
  304. :END:
  305. As Common Lisp does not have cosecant or secant functions, and they appear in the definitions of the derivatives of some trigonometric functions, I define them here as follows:
  306. \[ \csc x = \frac{1}{\sin x} \]
  307. \[ \sec x = \frac{1}{\cos x} \]
  308. I also take the liberty of defining two macros, a ~define-equation-functions~ macro and ~take-derivative~. The first defines two functions, one that is the original equation, and the second being the derivative of the original equation. The ~take-derivative~ macro does simply that, but allows you to write the equation without having to quote it, providing a little bit of syntactic sugar.
  309. #+Caption: Miscellaneous Functions
  310. #+Name: derive-misc-functions
  311. #+BEGIN_SRC lisp
  312. (defun csc (x)
  313. "csc -- (csc x)
  314. Calculate the cosecant of x"
  315. (/ (sin x)))
  316. (defun sec (x)
  317. "sec -- (sec x)
  318. Calculate the secant of x"
  319. (/ (cos x)))
  320. (defmacro define-equation-functions (name variable equation)
  321. (let ((derivative-name (symbolicate 'd/d- variable '- name))
  322. (derivative (derive equation)))
  323. `(progn
  324. (defun ,name (,variable)
  325. ,equation)
  326. (defun ,derivative-name (,variable)
  327. ,derivative))))
  328. (defmacro take-derivative (equation)
  329. (let ((derivative (derive equation)))
  330. `',derivative))
  331. #+END_SRC
  332. ** TODO Assembly
  333. :PROPERTIES:
  334. :ID: e15262d2-23d5-4306-a68b-387a21265b6e
  335. :CREATED: <2016-06-09 Thu 09:22>
  336. :END:
  337. Now that the functions, macros and rules are defined, it's time to put them together into a package. This package has only one dependency, Common Lisp itself, and exports the following five symbols: ~derive~, ~csc~, ~sec~, ~define-equation-functions~ and ~take-derivative~.
  338. #+Caption: Packaging
  339. #+Name: derive-packaging
  340. #+BEGIN_SRC lisp :tangle "larcs-derive.lisp"
  341. (in-package #:larcs.derive)
  342. <<derive-expansion-storage>>
  343. <<derive-expansion-retrieval>>
  344. <<derive-match-expressions>>
  345. <<derive-expansion-definition>>
  346. <<derive-derivative-driver>>
  347. <<derive-multiplication>>
  348. <<derive-division>>
  349. <<derive-addition-subtraction>>
  350. <<derive-exponentials-logarithms>>
  351. <<derive-trigonometrics>>
  352. <<derive-misc-functions>>
  353. #+END_SRC
  354. * WORKING Symbolic Form to Typeset [0/5]
  355. :PROPERTIES:
  356. :CREATED: <2016-06-09 Thu 09:23>
  357. :ID: ed9f4311-bf9f-42df-8f46-254658b93c10
  358. :ARCHIVE_TIME: 2016-06-14 Tue 19:10
  359. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  360. :ARCHIVE_CATEGORY: lisp-cas
  361. :ARCHIVE_TODO: WORKING
  362. :END:
  363. The goal of this portion of the CAS is to produce \LaTeX{} formulae that can be inserted into a document for whatever reason, and it does so using rewrite rules, this time, rewriting s-expressions (~(+ (* 3 (expt x 3)) (expt x 2) (* 4 x) 22)~) to the \LaTeX{} equivalent, ~${{{{3} \cdot {{x ^ {3}}}}} + {{x ^ {2}}} + {{{4} \cdot {x}}} + {22}}$~ (${{{{3} \cdot {{x ^ {3}}}}} + {{x ^ {2}}} + {{{4} \cdot {x}}} + {22}}$).
  364. ** WORKING Matching And Generating [0/3]
  365. :PROPERTIES:
  366. :CREATED: <2016-04-30 Sat 16:19>
  367. :END:
  368. *** TODO Define Rule
  369. :PROPERTIES:
  370. :ID: d4f77ac3-a059-4fb6-b936-1b9e972646ee
  371. :CREATED: <2016-04-30 Sat 16:19>
  372. :END:
  373. #+Caption: Define Matching Rule
  374. #+Name: tex-def-match-rule
  375. #+BEGIN_SRC lisp
  376. (defmacro defrule (name (on arity &optional type) (&rest arguments) &body rule)
  377. (let ((match-expression (generate-match-expression on arity type 'function 'arg-count))
  378. (test-name (symbolicate name '-test))
  379. (expansion-name (symbolicate name '-expansion)))
  380. `(progn
  381. (defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
  382. ,match-expression)
  383. (defun ,expansion-name (,@arguments)
  384. ,@rule)
  385. (setf (aget *rules* ',name)
  386. (make-rule :name ',name
  387. :test-function #',test-name
  388. :expansion-function #',expansion-name))
  389. ',name)))
  390. #+END_SRC
  391. *** TODO Store Rules
  392. :PROPERTIES:
  393. :ID: 002ea704-4286-429f-9149-0f29fb73c503
  394. :CREATED: <2016-04-30 Sat 16:19>
  395. :END:
  396. #+Caption: Rule Storage
  397. #+Name: tex-rule-storage
  398. #+BEGIN_SRC lisp
  399. (defstruct (rule (:type list))
  400. name test-function expansion-function)
  401. (defvar *rules* '())
  402. #+END_SRC
  403. *** TODO Retrieve Rule
  404. :PROPERTIES:
  405. :CREATED: <2016-04-30 Sat 15:25>
  406. :ID: e3f34100-d0a5-4039-8b9d-115cfcb0804e
  407. :END:
  408. #+Caption: Retrieve Rule
  409. #+Name: tex-retrieve-rule
  410. #+BEGIN_SRC lisp
  411. (defun get-expansion (expression)
  412. (rule-expansion-function (rest
  413. (first
  414. (remove-if-not #'(lambda (nte)
  415. (let ((test (rule-test-function (rest nte))))
  416. (apply test expression)))
  417. ,*rules*)))))
  418. #+END_SRC
  419. ** WORKING Rules [0/10]
  420. :PROPERTIES:
  421. :CREATED: <2016-04-30 Sat 16:19>
  422. :END:
  423. *** TODO Multiplication
  424. :PROPERTIES:
  425. :CREATED: <2016-04-30 Sat 16:19>
  426. :ID: 5417a6bf-f265-418a-984b-6bfd14b79a80
  427. :END:
  428. #+Caption: Multiplication Rule
  429. #+Name: tex-multiplication-rule
  430. #+BEGIN_SRC lisp
  431. (defrule multiplication (* 2 >=) (&rest elements)
  432. (format nil "{~{{~a}~^ \\cdot ~}}"
  433. (map 'list #'convert-to-tex
  434. (map 'list #'ensure-list
  435. elements))))
  436. #+END_SRC
  437. *** TODO Division
  438. :PROPERTIES:
  439. :CREATED: <2016-04-30 Sat 16:19>
  440. :ID: 056aa99c-f2b9-4ab6-99ba-bfb87e3baed5
  441. :END:
  442. #+Caption: Division Rule
  443. #+Name: tex-division-rule
  444. #+BEGIN_SRC lisp
  445. (defrule division (/ 2 =) (a b)
  446. (format nil "{\\frac{~a}{~a}}"
  447. (convert-to-tex (ensure-list a))
  448. (convert-to-tex (ensure-list b))))
  449. #+END_SRC
  450. *** TODO Addition
  451. :PROPERTIES:
  452. :ID: 68f3dac3-9f0a-4fee-8da6-a39f4491f3ce
  453. :CREATED: <2016-04-30 Sat 16:19>
  454. :END:
  455. #+Caption: Rule for addition
  456. #+Name: tex-addition-rule
  457. #+BEGIN_SRC lisp
  458. (defrule addition (+ 2 >=) (&rest elements)
  459. (format nil "{~{{~a}~^ + ~}}"
  460. (map 'list #'convert-to-tex
  461. (map 'list #'ensure-list
  462. elements))))
  463. #+END_SRC
  464. *** TODO Subtraction
  465. :PROPERTIES:
  466. :ID: 9a908130-af5e-4c87-bb07-13bd66c35fcf
  467. :CREATED: <2016-04-30 Sat 16:19>
  468. :END:
  469. #+Caption: Subtraction Rule
  470. #+Name: tex-subtraction-rule
  471. #+BEGIN_SRC lisp
  472. (defrule subtraction (- 2 >=) (&rest elements)
  473. (format nil "{~{{~a}~^ - ~}}"
  474. (map 'list #'convert-to-tex
  475. (map 'list #'ensure-list
  476. elements))))
  477. #+END_SRC
  478. *** TODO Exponentials and Logarithmics
  479. :PROPERTIES:
  480. :CREATED: <2016-04-30 Sat 16:19>
  481. :ID: 269dc47f-5062-4081-a08e-d50188af6a57
  482. :END:
  483. #+Caption: Exponentials and Logarithms
  484. #+Name: tex-exponentials-and-logarithms
  485. #+BEGIN_SRC lisp
  486. (defrule exp (exp 1 =) (expression)
  487. (format nil "{e^{~a}}"
  488. (convert-to-tex (ensure-list expression))))
  489. (defrule expt (expt 2 =) (base exponent)
  490. (format nil "{~a ^ {~a}}"
  491. (convert-to-tex (ensure-list base))
  492. (convert-to-tex (ensure-list exponent))))
  493. (defrule natlog (log 1 =) (expression)
  494. (format nil "{\\ln {~a}}"
  495. (convert-to-tex (ensure-list expression))))
  496. (defrule logarithm (log 2 =) (expression base)
  497. (format nil "{\\log_{~a}~a}"
  498. (convert-to-tex (ensure-list base))
  499. (convert-to-tex (ensure-list expression))))
  500. #+END_SRC
  501. *** TODO Trigonometrics
  502. :PROPERTIES:
  503. :CREATED: <2016-04-30 Sat 16:19>
  504. :ID: 837806c9-7174-43a3-80b2-355b645d46ed
  505. :END:
  506. #+Caption: Trigonometric Functions
  507. #+Name: tex-trigonometrics
  508. #+BEGIN_SRC lisp
  509. (defrule sin (sin 1 =) (arg)
  510. (format nil "{\\sin {~a}}"
  511. (convert-to-tex (ensure-list arg))))
  512. (defrule cos (cos 1 =) (arg)
  513. (format nil "{\\cos {~a}}"
  514. (convert-to-tex (ensure-list arg))))
  515. (defrule tan (tan 1 =) (arg)
  516. (format nil "{\\tan {~a}}"
  517. (convert-to-tex (ensure-list arg))))
  518. (defrule csc (csc 1 =) (arg)
  519. (format nil "{\\csc {~a}}"
  520. (convert-to-tex (ensure-list arg))))
  521. (defrule sec (sec 1 =) (arg)
  522. (format nil "{\\sec {~a}}"
  523. (convert-to-tex (ensure-list arg))))
  524. (defrule cot (cot 1 =) (arg)
  525. (format nil "{\\cot {~a}}"
  526. (convert-to-tex (ensure-list arg))))
  527. #+END_SRC
  528. *** TODO Logic
  529. :PROPERTIES:
  530. :CREATED: <2016-04-30 Sat 18:29>
  531. :ID: 74d12931-343f-4982-945d-738a3e38a1db
  532. :END:
  533. #+Caption: Logic Rules
  534. #+Name: tex-logic-rules
  535. #+BEGIN_SRC lisp
  536. (defrule and (and 2 >=) (&rest elements)
  537. (format nil "{~{{~a}~^ \\wedge ~}}"
  538. (map 'list #'convert-to-tex
  539. (map 'list #'ensure-list elements))))
  540. (defrule or (or 2 >=) (&rest elements)
  541. (format nil "{~{{~a}~^ \\vee ~}}"
  542. (map 'list #'convert-to-tex
  543. (map 'list #'ensure-list elements))))
  544. (defrule not (not 1 =) (&rest elements)
  545. (format nil "{\\not {~a}}"
  546. (map 'list #'convert-to-tex
  547. (map 'list #'ensure-list elements))))
  548. #+END_SRC
  549. *** TODO Equality
  550. :PROPERTIES:
  551. :CREATED: <2016-04-30 Sat 18:29>
  552. :ID: f75273d2-d523-4404-925b-af6fd01c7520
  553. :END:
  554. #+Caption: Equality Rules
  555. #+Name: tex-equality-rules
  556. #+BEGIN_SRC lisp
  557. (defrule = (= 2 =) (lhs rhs)
  558. (format nil "{{~a} = {~a}}"
  559. (convert-to-tex (ensure-list lhs))
  560. (convert-to-tex (ensure-list rhs))))
  561. #+END_SRC
  562. *** TODO Summation and Integration
  563. :PROPERTIES:
  564. :CREATED: <2016-04-30 Sat 18:30>
  565. :ID: dda2827a-cee5-4efc-bd9a-4dd953829b5c
  566. :END:
  567. #+Caption: Summation and Integration
  568. #+Name: tex-summation-and-integration
  569. #+BEGIN_SRC lisp
  570. (defrule sum (sum 3 =) (start stop expression)
  571. (format nil "{\\sum_{~a}^{~a} {~a}}"
  572. (convert-to-tex (ensure-list start))
  573. (convert-to-tex (ensure-list stop))
  574. (convert-to-tex (ensure-list expression))))
  575. (defrule integrate (integrate 4 =) (from to expression wrt)
  576. (format nil "{\\int_{~a}^{~a} ~a\\,\mathrm{d}~a}"
  577. (convert-to-tex (ensure-list from))
  578. (convert-to-tex (ensure-list to))
  579. (convert-to-tex (ensure-list expression))
  580. (convert-to-tex (ensure-list wrt))))
  581. #+END_SRC
  582. *** TODO Specialty
  583. :PROPERTIES:
  584. :CREATED: <2016-04-30 Sat 18:30>
  585. :ID: f4e6b309-289d-4b32-bc55-4740ec86a113
  586. :END:
  587. #+Caption: Specialty
  588. #+Name: tex-specialty
  589. #+BEGIN_SRC lisp
  590. (defrule parens (parens 2 =) (type inside)
  591. (let* ((types '((square . ("[" . "]"))
  592. (curly . ("{" . "}"))
  593. (smooth . ("(" . ")"))))
  594. (left (cadr (assoc type types)))
  595. (right (cddr (assoc type types))))
  596. (format nil "{\\left~a {~a} \\right~a}"
  597. left
  598. (convert-to-tex (ensure-list inside))
  599. right)))
  600. #+END_SRC
  601. ** TODO Conversion Driver
  602. :PROPERTIES:
  603. :ID: b395bdb7-7b98-49a1-b6d6-4256fb40d4fa
  604. :CREATED: <2016-04-30 Sat 16:19>
  605. :END:
  606. #+Caption: Conversion Driver
  607. #+Name: tex-conversion-driver
  608. #+BEGIN_SRC lisp
  609. (defvar *tex-outputp* nil)
  610. (declaim (special *tex-outputp*))
  611. (defmacro with-tex-output (&body body)
  612. `(if *tex-outputp*
  613. (progn
  614. ,@body)
  615. (let ((*tex-outputp* t))
  616. (format nil "$~a$"
  617. (progn
  618. ,@body)))))
  619. (defun convert-to-tex (function)
  620. (check-type function cons)
  621. (let ((op (first function)))
  622. (with-tex-output
  623. (cond
  624. ((numberp op)
  625. (format nil "~a" op))
  626. ((and (symbolp op)
  627. (= 1 (length function)))
  628. (let ((symbol-pair (assoc op *special-symbols-to-sequences*)))
  629. (if (null symbol-pair)
  630. (string-downcase op)
  631. (cdr symbol-pair))))
  632. (t
  633. (let ((expansion-function (get-expansion function)))
  634. (if (functionp expansion-function)
  635. (apply expansion-function (rest function))
  636. (error "Undefined expansion for operation: ~a." op))))))))
  637. #+END_SRC
  638. ** TODO Miscellaneous Functions
  639. :PROPERTIES:
  640. :CREATED: <2016-04-30 Sat 16:09>
  641. :ID: a4ab8a72-0b09-453c-b936-2470d5429c05
  642. :END:
  643. #+Caption: Misc Functions
  644. #+Name: tex-misc-functions
  645. #+BEGIN_SRC lisp
  646. ;; (defvar *special-symbols-to-sequences*
  647. ;; '((alpha . "\\alpha")
  648. ;; (beta . "\\beta")
  649. ;; (gamma . "\\gamma")
  650. ;; (delta . "\\delta")
  651. ;; (epsilon . "\\epsilon")
  652. ;; (varepsilon . "\\varepsilon")
  653. ;; (zeta . "\\zeta")
  654. ;; (eta . "\\eta")
  655. ;; (theta . "\\theta")
  656. ;; (vartheta . "\\vartheta")
  657. ;; (gamma . "\\gamma") (kappa . "\\kappa")
  658. ;; (lambda . "\\lambda")
  659. ;; (mu . "\\mu")
  660. ;; (nu . "\\nu")
  661. ;; (xi . "\\xi")
  662. ;; (omicron . "\\o")
  663. ;; (pi . "\\pi")
  664. ;; (varpi . "\\varpi")
  665. ;; (rho . "\\rho")
  666. ;; (varrho . "\\varrho")
  667. ;; (sigma . "\\sigma")
  668. ;; (varsigm . "\\varsigm")
  669. ;; (tau . "\\tau")
  670. ;; (upsilon . "\\upsilon")
  671. ;; (phi . "\\phi")
  672. ;; (varphi . "\\varphi")
  673. ;; (chi . "\\chi")
  674. ;; (psi . "\\psi")
  675. ;; (omega . "\\omega")
  676. ;; (big-gamma . "\\Gamma")
  677. ;; (big-delta . "\\Delta")
  678. ;; (big-theta . "\\Theta")
  679. ;; (big-lambda . "\\Lambda")
  680. ;; (big-xi . "\\Xi")
  681. ;; (big-pi . "\\Pi")
  682. ;; (big-sigma . "\\Sigma")
  683. ;; (big-upsilon . "\\Upsilon")
  684. ;; (big-phi . "\\Phi")
  685. ;; (big-psi . "\\Psi")
  686. ;; (big-omega . "\\Omega")))
  687. #+END_SRC
  688. ** TODO Assembly
  689. :PROPERTIES:
  690. :ID: fdef3016-cb12-43ad-ba5f-14dd6ccd973c
  691. :CREATED: <2016-04-30 Sat 16:25>
  692. :END:
  693. #+Caption: Packaging
  694. #+Name: tex-packaging
  695. #+BEGIN_SRC lisp :tangle "larcs-tex.lisp"
  696. (in-package #:larcs.to-tex)
  697. <<tex-misc-functions>>
  698. <<tex-rule-storage>>
  699. <<tex-gen-match-test>>
  700. <<tex-def-match-rule>>
  701. <<tex-retrieve-rule>>
  702. <<tex-conversion-driver>>
  703. <<tex-addition-rule>>
  704. <<tex-subtraction-rule>>
  705. <<tex-multiplication-rule>>
  706. <<tex-division-rule>>
  707. <<tex-exponentials-and-logarithms>>
  708. <<tex-trigonometrics>>
  709. <<tex-logic-rules>>
  710. <<tex-equality-rules>>
  711. <<tex-summation-and-integration>>
  712. <<tex-specialty>>
  713. #+END_SRC
  714. * TODO Manipulator Miscellaneous Functions
  715. :PROPERTIES:
  716. :CREATED: <2016-05-03 Tue 15:38>
  717. :ID: 20450528-d763-4c14-a085-5ac54d4d4b85
  718. :ARCHIVE_TIME: 2016-06-27 Mon 18:44
  719. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  720. :ARCHIVE_OLPATH: Algebraic Manipulation/Expression Manipulators
  721. :ARCHIVE_CATEGORY: lisp-cas
  722. :ARCHIVE_TODO: TODO
  723. :END:
  724. 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.
  725. #+Caption: Misc Manipulator Functions
  726. #+Name: am-misc-manipulator-functions
  727. #+BEGIN_SRC lisp
  728. (defvar *manipulator-map* '())
  729. #+END_SRC
  730. * TODO Match Expression Generation
  731. :PROPERTIES:
  732. :CREATED: <2016-06-13 Mon 17:18>
  733. :ID: f7876b1d-3b67-48c1-863a-85e1b3026ed6
  734. :ARCHIVE_TIME: 2016-08-05 Fri 21:47
  735. :ARCHIVE_FILE: ~/Projects/lisp-cas/lisp-cas.org
  736. :ARCHIVE_OLPATH: Common Functionality
  737. :ARCHIVE_CATEGORY: lisp-cas
  738. :ARCHIVE_TODO: TODO
  739. :END:
  740. 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 ($=$, $>$, $\leq$), it will construct a simple boolean statement in the format of $(function = operator) \land (argument-count == arity)$, where $==$ is one of the above arity types.
  741. #+Caption: Match Expression Generation
  742. #+Name: common-match-expression-generation
  743. #+BEGIN_SRC lisp
  744. (defun generate-match-expression (on arity &optional (type '=) (function-var 'function) (arg-count-var 'arg-count))
  745. (check-type on symbol)
  746. (check-type type (member = > >=))
  747. (check-type arity (integer 0))
  748. (case type
  749. (=
  750. `(and (eq ,function-var ',on)
  751. (= ,arg-count-var ,arity)))
  752. (>
  753. `(and (eq ,function-var ',on)
  754. (> ,arg-count-var ,arity)))
  755. (>=
  756. `(and (eq ,function-var ',on)
  757. (>= ,arg-count-var ,arity)))))
  758. #+END_SRC