larcs.org_archive 50 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653
  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
  759. * WORKING Common Functionality [3/6]
  760. :PROPERTIES:
  761. :CREATED: <2016-06-11 Sat 22:23>
  762. :ID: f153a0fe-ec04-47b1-bdc5-290cc62bc985
  763. :ARCHIVE_TIME: 2019-01-05 Sat 16:55
  764. :ARCHIVE_FILE: ~/Projects/larcs/larcs.org
  765. :ARCHIVE_CATEGORY: larcs
  766. :ARCHIVE_TODO: WORKING
  767. :END:
  768. There are several bits of common functions or variables that are required for use. This primarily includes functions that some of the macros rely on, or things that are required for use in other parts of the system, but don't present as specific functionality.
  769. ** DONE Generate an Args List
  770. CLOSED: [2016-07-30 Sat 16:08]
  771. :PROPERTIES:
  772. :CREATED: <2016-06-13 Mon 17:19>
  773. :ID: 49596957-2fc6-4458-ad85-99cbcf337b42
  774. :END:
  775. For some macros, an arguments list must be generated. This is done by generating a list of variables starting with the word ~expression-~ followed by a letter from the alphabet, in turn.
  776. #+Caption: Generate an Args List
  777. #+Name: common-generate-an-args-list
  778. #+BEGIN_SRC lisp
  779. (defun gen-args-list (count)
  780. (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)))
  781. (let ((variables-list '()))
  782. (dotimes (i count)
  783. (pushnew (symbolicate 'expression- (nth i letters)) variables-list))
  784. (reverse variables-list))))
  785. #+END_SRC
  786. ** DONE Constants and Greeks
  787. CLOSED: [2016-08-05 Fri 21:32]
  788. :PROPERTIES:
  789. :CREATED: <2016-06-13 Mon 20:57>
  790. :ID: 907fcf64-51eb-4a2c-a8bc-29e4f75f1dd3
  791. :END:
  792. This is a mapping between the names of constants and the way that they are correctly displayed in TeX. Besides defining the mapping, which is in the form of an alist, it also collects the names of all of the constants, and exports the names themselves.
  793. #+Caption: Constants and Greeks
  794. #+Name: constants-and-greeks
  795. #+BEGIN_SRC lisp
  796. (defvar *special-symbols-to-sequences*
  797. '((alpha . "\\alpha")
  798. (beta . "\\beta")
  799. (gamma . "\\gamma")
  800. (delta . "\\delta")
  801. (epsilon . "\\epsilon")
  802. (varepsilon . "\\varepsilon")
  803. (zeta . "\\zeta")
  804. (eta . "\\eta")
  805. (theta . "\\theta")
  806. (vartheta . "\\vartheta")
  807. (gamma . "\\gamma") (kappa . "\\kappa")
  808. (lambda . "\\lambda")
  809. (mu . "\\mu")
  810. (nu . "\\nu")
  811. (xi . "\\xi")
  812. (omicron . "\\o")
  813. (pi . "\\pi")
  814. (varpi . "\\varpi")
  815. (rho . "\\rho")
  816. (varrho . "\\varrho")
  817. (sigma . "\\sigma")
  818. (varsigm . "\\varsigm")
  819. (tau . "\\tau")
  820. (upsilon . "\\upsilon")
  821. (phi . "\\phi")
  822. (varphi . "\\varphi")
  823. (chi . "\\chi")
  824. (psi . "\\psi")
  825. (omega . "\\omega")
  826. (big-gamma . "\\Gamma")
  827. (big-delta . "\\Delta")
  828. (big-theta . "\\Theta")
  829. (big-lambda . "\\Lambda")
  830. (big-xi . "\\Xi")
  831. (big-pi . "\\Pi")
  832. (big-sigma . "\\Sigma")
  833. (big-upsilon . "\\Upsilon")
  834. (big-phi . "\\Phi")
  835. (big-psi . "\\Psi")
  836. (big-omega . "\\Omega")))
  837. (defvar *constant-names*
  838. (mapcar #'car *special-symbols-to-sequences*))
  839. (mapcar #'export *constant-names*)
  840. #+END_SRC
  841. ** TODO Aget
  842. :PROPERTIES:
  843. :CREATED: <2016-10-23 Sun 11:14>
  844. :END:
  845. #+Caption: Aget
  846. #+Name: common-aget
  847. #+BEGIN_SRC lisp
  848. (defun aget (place indicator &optional default)
  849. "
  850. RETURN: The value of the entry INDICATOR of the a-list PLACE, or DEFAULT.
  851. "
  852. (let ((a (assoc indicator place)))
  853. (if a (cdr a) default)))
  854. (define-setf-expander aget (place indicator &optional default &environment env)
  855. (declare (ignore default))
  856. (multiple-value-bind (vars vals store-vars writer-form reader-form)
  857. (get-setf-expansion place env)
  858. (let* ((vindicator (gensym "INDICATOR"))
  859. (vvalue (gensym "VALUE"))
  860. (vstore (first store-vars))
  861. (acs (gensym "PAIR")))
  862. (values (list* vindicator vars)
  863. (list* indicator vals)
  864. (list vvalue)
  865. `(let* ((,acs (assoc ,vindicator ,reader-form)))
  866. (if ,acs
  867. (setf (cdr ,acs) ,vvalue)
  868. (let ((,vstore (acons ,vindicator ,vvalue ,reader-form)))
  869. ,writer-form))
  870. ,vvalue)
  871. `(assoc ,vindicator ,reader-form)))))
  872. #+END_SRC
  873. ** TODO Ensure List
  874. :PROPERTIES:
  875. :CREATED: <2016-10-23 Sun 11:17>
  876. :ID: 08d8e031-a30f-41b6-9981-caec2f07f2a0
  877. :END:
  878. #+Caption: Ensure List
  879. #+Name: ensure-list
  880. #+BEGIN_SRC lisp
  881. (defun ensure-list (object)
  882. "
  883. RETURN: If OBJECT is a list then OBJECT, otherwise a fresh
  884. list containing OBJECT.
  885. "
  886. (if (listp object) object (list object)))
  887. #+END_SRC
  888. ** TODO Evaluating Bind
  889. :PROPERTIES:
  890. :CREATED: <2016-12-14 Wed 15:13>
  891. :ID: 390707cd-6a58-404c-b2e5-286f09be977f
  892. :END:
  893. #+Caption: Evaluating Bind
  894. #+Name: evaluating-bind
  895. #+BEGIN_SRC lisp
  896. (defun evaluating-bind (expression &rest pairs)
  897. (let ((vars (mapcar #'first pairs))
  898. (values (mapcar #'second pairs)))
  899. (apply (eval `(lambda ,vars ,expression)) values)))
  900. #+END_SRC
  901. ** DONE Assembly
  902. CLOSED: [2016-07-30 Sat 15:43]
  903. :PROPERTIES:
  904. :CREATED: <2016-06-13 Mon 17:20>
  905. :ID: d583d5e4-a2c9-432c-9486-cc6baa4239f4
  906. :END:
  907. This is where the common functions and constants are assembled into their own package. Almost all of the functions and variables are exported and available for everything else.
  908. #+Caption: Assemble Common Functions
  909. #+Name: assemble-common-functions
  910. #+BEGIN_SRC lisp :tangle "larcs-common.lisp"
  911. (in-package #:larcs.common)
  912. <<common-generate-an-args-list>>
  913. <<constants-and-greeks>>
  914. <<aget>>
  915. <<ensure-list>>
  916. <<evaluating-bind>>
  917. #+END_SRC
  918. * WORKING Symbolic To Typeset Form [0/5]
  919. :PROPERTIES:
  920. :CREATED: <2016-06-14 Tue 17:13>
  921. :ID: 75f65e8a-0cc9-477f-b5e9-3c563fe7ef5c
  922. :ARCHIVE_TIME: 2019-01-05 Sat 16:56
  923. :ARCHIVE_FILE: ~/Projects/larcs/larcs.org
  924. :ARCHIVE_CATEGORY: larcs
  925. :ARCHIVE_TODO: WORKING
  926. :END:
  927. One of the less important parts of this system is the format converter, which converts between the internal symbolic form and a format that is capable of being typeset using TeX. This is done using a variant of the common rewrite system, but instead of going between variants of the symbolic format, it converts from a symbolic format to string-based format.
  928. ** WORKING Rule Management [0/2]
  929. :PROPERTIES:
  930. :CREATED: <2016-06-14 Tue 17:17>
  931. :END:
  932. To accomplish the task of conversion from symbolic form to typeset form, rules are necessary. It is done using three main things, rule definition, rule retrieval and rule storage.
  933. *** TODO Define Rules
  934. :PROPERTIES:
  935. :CREATED: <2016-06-14 Tue 17:18>
  936. :ID: ec6fdb0d-546e-41fc-a7b7-5fbbfe4b7931
  937. :END:
  938. Rule definitions are built using the ~define-converter~ macro, which takes an expression type, a lambda list and a body. It creates a function using the body and the given arguments list, and if it hasn't been pushed onto the storage system, the converter function is pushed into storage.
  939. #+Caption: Rule Definition
  940. #+Name: stf-define-rule
  941. #+BEGIN_SRC lisp
  942. (defvar *rules* '())
  943. (defmacro define-converter (expression-type (&rest arguments-list) &body body)
  944. (let ((expansion-name (symbolicate expression-type '-conversion)))
  945. `(progn
  946. (when (not (member ',expression-type (mapcar #'car *rules*)))
  947. (setq *rules* (append *rules* '((,expression-type . ,expansion-name)))))
  948. (defun ,expansion-name (,@arguments-list)
  949. ,@body))))
  950. #+END_SRC
  951. *** TODO Rule Retrieval
  952. :PROPERTIES:
  953. :CREATED: <2016-06-14 Tue 17:18>
  954. :ID: 0c34c744-7847-46c2-bdef-228feee7c84e
  955. :END:
  956. Rule retrieval is done by taking an expression, comparing it against given classifications, and from the first classification, returning the second element of the ~(classification . converter)~ pair.
  957. #+Caption: Rule Retrieval
  958. #+Name: stf-rule-retrieval
  959. #+BEGIN_SRC lisp
  960. (defun get-rule (expression)
  961. (cdr (first (remove-if #'(lambda (pair)
  962. (let ((type (first pair)))
  963. (not (classified-as-p expression type))))
  964. ,*rules*))))
  965. #+END_SRC
  966. ** WORKING Rules [0/9]
  967. :PROPERTIES:
  968. :CREATED: <2016-06-14 Tue 17:18>
  969. :ID: 90accad9-81d0-4aaf-9c7f-2418e36e1f3c
  970. :END:
  971. The following contains all of the defined rules, which are as follows:
  972. - Numerics
  973. - Variables
  974. - Polynomial Terms
  975. - Multiplicatives
  976. - Rationals
  977. - Additives
  978. - Subtractives
  979. - Trigonometrics
  980. - Exponentials & Logarithmics
  981. #+Caption: Rules
  982. #+Name: stf-rules
  983. #+BEGIN_SRC lisp
  984. <<stf-numerics>>
  985. <<stf-variables>>
  986. <<stf-polynomial-terms>>
  987. <<stf-multiplicatives>>
  988. <<stf-rationals>>
  989. <<stf-additives>>
  990. <<stf-subtractives>>
  991. <<stf-trigonometrics>>
  992. <<stf-exponentials-logarithmics>>
  993. #+END_SRC
  994. *** TODO Numbers
  995. :PROPERTIES:
  996. :CREATED: <2016-06-14 Tue 17:22>
  997. :ID: fbc3e5ac-3276-4f54-b53e-9d4cc0263405
  998. :END:
  999. Numbers are formatted fairly simply, as they are simply surrounded by curly braces, and formatted as to be normal read syntax, which is generally correct.
  1000. #+Caption: Numerics
  1001. #+Name: stf-numerics
  1002. #+BEGIN_SRC lisp
  1003. (define-converter numeric (number)
  1004. (with-tex-output
  1005. (format nil "{~A}" number)))
  1006. #+END_SRC
  1007. *** TODO Variables
  1008. :PROPERTIES:
  1009. :CREATED: <2016-06-14 Tue 17:22>
  1010. :ID: 8ec363f7-da0f-4023-90bb-e08a85623f55
  1011. :END:
  1012. As with numbers, variables are a relatively simple thing to format. If the variable passed is in the ~*constant-names*~ list, then it must be a formattable constant for which there is a known TeX command. If there is, it is looked up in the ~*special-symbols-to-sequences*~ alist, otherwise, the given variable is downcased and output as a string. Either way, they are surrounded by, as usual, curly braces.
  1013. #+Caption: Variables
  1014. #+Name: stf-variables
  1015. #+BEGIN_SRC lisp
  1016. (define-converter variable (var)
  1017. (if (member var *constant-names*)
  1018. (with-tex-output
  1019. (format nil "{~A}" (cdr (assoc var *special-symbols-to-sequences*))))
  1020. (with-tex-output
  1021. (format nil "{~A}" (string-downcase var)))))
  1022. #+END_SRC
  1023. *** TODO Polynomial Terms
  1024. :PROPERTIES:
  1025. :CREATED: <2016-06-14 Tue 17:23>
  1026. :ID: ac2283d0-da70-4672-90cb-08511bd9105e
  1027. :END:
  1028. Polynomial Terms are a specific classification, defined as follows:
  1029. - A variable, raised to a numeric power.
  1030. - A number, followed by a single variable.
  1031. - A number, followed by a variable raised to a numeric power.
  1032. These are typeset as a single unit, ensuring readability.
  1033. #+Caption: Polynomial Terms
  1034. #+Name: stf-polynomial-terms
  1035. #+BEGIN_SRC lisp
  1036. (define-converter polynomial-term (&rest term)
  1037. (let ((variable (term-variable term))
  1038. (coefficient (coefficient term))
  1039. (power (get-power term)))
  1040. (cond
  1041. ((= 1 power)
  1042. (with-tex-output
  1043. (format nil "{~A}{~A}"
  1044. (convert-for-display coefficient)
  1045. (convert-for-display power))))
  1046. ((= 0 coefficient)
  1047. (with-tex-output
  1048. (format nil "{~A}^{~A}"
  1049. (convert-for-display variable)
  1050. (convert-for-display power))))
  1051. (t
  1052. (with-tex-output
  1053. (format nil "{~A}{~A}^{~A}"
  1054. (convert-for-display coefficient)
  1055. (convert-for-display variable)
  1056. (convert-for-display power)))))))
  1057. #+END_SRC
  1058. *** TODO Multiplicatives
  1059. :PROPERTIES:
  1060. :CREATED: <2016-06-14 Tue 17:23>
  1061. :ID: 87a7e236-072e-4c19-9f09-c458e5b50397
  1062. :END:
  1063. In the case of multiplicatives, which are variadic, a $\cdot$ or ~\cdot~ is placed in between each term, individually converted itself.
  1064. #+Caption: Multiplicatives
  1065. #+Name: stf-multiplicatives
  1066. #+BEGIN_SRC lisp
  1067. (define-converter multiplicative (op &rest elements)
  1068. (declare (ignore op))
  1069. (with-tex-output
  1070. (format nil "{~{~A~^ \\cdot ~}}"
  1071. (mapcar #'convert-for-display
  1072. elements))))
  1073. #+END_SRC
  1074. *** TODO Rationals
  1075. :PROPERTIES:
  1076. :CREATED: <2016-06-14 Tue 17:23>
  1077. :ID: 4f8f984f-e567-4efb-ba15-8a98e15915fe
  1078. :END:
  1079. #+Caption: Rationals
  1080. #+Name: stf-rationals
  1081. #+BEGIN_SRC lisp
  1082. (define-converter rational (op numerator denominator)
  1083. (declare (ignore op))
  1084. (with-tex-output
  1085. (format nil "{\\frac{~A}{~A}}"
  1086. (convert-for-display numerator)
  1087. (convert-for-display denominator))))
  1088. #+END_SRC
  1089. *** TODO Additives
  1090. :PROPERTIES:
  1091. :CREATED: <2016-06-14 Tue 17:23>
  1092. :ID: 10ec8596-094a-4900-aba0-22b958ffdc9a
  1093. :END:
  1094. #+Caption: Additives
  1095. #+Name: stf-additives
  1096. #+BEGIN_SRC lisp
  1097. (define-converter additive (op &rest terms)
  1098. (declare (ignore op))
  1099. (with-tex-output
  1100. (format nil "{~{~A~^ + ~}}"
  1101. (mapcar #'convert-for-display terms))))
  1102. #+END_SRC
  1103. *** TODO Subtractives
  1104. :PROPERTIES:
  1105. :CREATED: <2016-06-14 Tue 17:23>
  1106. :ID: 1037cb8e-f127-4c87-9312-2817bc2cfc25
  1107. :END:
  1108. #+Caption: Subtractives
  1109. #+Name: stf-subtractives
  1110. #+BEGIN_SRC lisp
  1111. (define-converter subtractive (op &rest terms)
  1112. (declare (ignore op))
  1113. (with-tex-output
  1114. (format nil "{~{~A~^ - ~}}"
  1115. (mapcar #'convert-for-display terms))))
  1116. #+END_SRC
  1117. *** TODO Trigonometrics
  1118. :PROPERTIES:
  1119. :CREATED: <2016-06-14 Tue 18:38>
  1120. :ID: 742d303a-dcea-4bb2-9553-19b968a70272
  1121. :END:
  1122. #+Caption: Trigonometrics
  1123. #+Name: stf-trigonometrics
  1124. #+BEGIN_SRC lisp
  1125. (define-converter sin (op term)
  1126. (declare (ignore op))
  1127. (with-tex-output
  1128. (format nil "{\\sin {~A}}" (convert-for-display term))))
  1129. (define-converter cos (op term)
  1130. (declare (ignore op))
  1131. (with-tex-output
  1132. (format nil "{\\cos {~A}}" (convert-for-display term))))
  1133. (define-converter tan (op term)
  1134. (declare (ignore op))
  1135. (with-tex-output
  1136. (format nil "{\\tan {~A}}" (convert-for-display term))))
  1137. (define-converter csc (op term)
  1138. (declare (ignore op))
  1139. (with-tex-output
  1140. (format nil "{\\csc {~A}}" (convert-for-display term))))
  1141. (define-converter sec (op term)
  1142. (declare (ignore op))
  1143. (with-tex-output
  1144. (format nil "{\\sec {~A}}" (convert-for-display term))))
  1145. (define-converter cot (op term)
  1146. (declare (ignore op))
  1147. (with-tex-output
  1148. (format nil "{\\cot {~A}}" (convert-for-display term))))
  1149. #+END_SRC
  1150. *** TODO Exponentials and Logarithmics
  1151. :PROPERTIES:
  1152. :CREATED: <2016-06-14 Tue 17:24>
  1153. :ID: 24dc527f-0b9d-44b0-ae0f-4515f0c1d119
  1154. :END:
  1155. #+Caption: Exponentials and Logarithmics
  1156. #+Name: stf-exponentials-logarithmics
  1157. #+BEGIN_SRC lisp
  1158. (define-converter natural-exponential (op term)
  1159. (declare (ignore op))
  1160. (with-tex-output
  1161. (format nil "{e^~A}" (convert-for-display term))))
  1162. (define-converter exponential (op base power)
  1163. (declare (ignore op))
  1164. (with-tex-output
  1165. (format nil "{~A^~A}"
  1166. (convert-for-display base)
  1167. (convert-for-display power))))
  1168. (define-converter natural-logarithmic (op term)
  1169. (declare (ignore op))
  1170. (with-tex-output
  1171. (format nil "{\\ln ~A}"
  1172. (convert-for-display term))))
  1173. (define-converter logarithmic (op term base)
  1174. (declare (ignore op))
  1175. (with-tex-output
  1176. (format nil "{\\log_~a ~a}"
  1177. (convert-for-display base)
  1178. (convert-for-display term))))
  1179. #+END_SRC
  1180. ** WORKING Converter [2/7]
  1181. :PROPERTIES:
  1182. :CREATED: <2016-06-14 Tue 17:18>
  1183. :ID: 88d433ad-e381-4747-8a29-2d78bc759fbf
  1184. :END:
  1185. The ~convert-for-display~ function is the driver for this portion of the application, and, in general, uses the previously defined rules, save for the logical functions ~and~, ~or~, ~not~, and the equality operation, summation with big-Sigma, integration and parenthesis.
  1186. #+Caption: Conversion Driver
  1187. #+Name: stf-conversion-driver
  1188. #+BEGIN_SRC lisp
  1189. (defun convert-for-display (function)
  1190. (if (and (listp function)
  1191. (member (first function) '(and or not = sum integrate parens)))
  1192. (let ((operator (first function)))
  1193. (cond
  1194. ((eq operator 'and)
  1195. <<stf-and-operator>>
  1196. )
  1197. ((eq operator 'or)
  1198. <<stf-or-operator>>
  1199. )
  1200. ((eq operator 'not)
  1201. <<stf-not-operator>>
  1202. )
  1203. ((eq operator '=)
  1204. <<stf-equality-operator>>
  1205. )
  1206. ((eq operator 'sum)
  1207. <<stf-summation>>
  1208. )
  1209. ((eq operator 'integrate)
  1210. <<stf-integration>>
  1211. )
  1212. ((eq operator 'parens)
  1213. <<stf-parenthesis>>
  1214. )))
  1215. (let ((rule (get-rule function)))
  1216. (when rule
  1217. (apply rule (ensure-list function))))))
  1218. #+END_SRC
  1219. *** DONE And
  1220. CLOSED: [2016-12-09 Fri 15:20]
  1221. :PROPERTIES:
  1222. :CREATED: <2016-06-14 Tue 17:38>
  1223. :ID: 733b98a1-90f1-4d13-abe8-cb86a5608aee
  1224. :END:
  1225. Like other rules, this formats a list of other sub-equations, with the symbol $\land$ (~\land~) between each term.
  1226. #+Caption: And Operator
  1227. #+Name: stf-and-operator
  1228. #+BEGIN_SRC lisp
  1229. (destructuring-bind (op &rest terms) function
  1230. (declare (ignore op))
  1231. (with-tex-output
  1232. (format nil "{~{~A~^ \\wedge ~}}"
  1233. (mapcar #'convert-for-display terms))))
  1234. #+END_SRC
  1235. *** DONE Or
  1236. CLOSED: [2016-12-09 Fri 15:22]
  1237. :PROPERTIES:
  1238. :CREATED: <2016-06-14 Tue 17:38>
  1239. :ID: 276de305-32c4-4f79-96e7-d0a99ff24f78
  1240. :END:
  1241. This does the same thing as "And", replacing the symbol with $\lor$ (~\lor~).
  1242. #+Caption: Or Operator
  1243. #+Name: stf-or-operator
  1244. #+BEGIN_SRC lisp
  1245. (destructuring-bind (op &rest terms) function
  1246. (declare (ignore op))
  1247. (with-tex-output
  1248. (format nil "{~{~A~^ \\vee ~}}"
  1249. (mapcar #'convert-for-display terms))))
  1250. #+END_SRC
  1251. *** TODO Not
  1252. :PROPERTIES:
  1253. :CREATED: <2016-06-14 Tue 17:38>
  1254. :ID: 1b0a28a4-744d-44d1-a328-7b2bb10bd0c7
  1255. :END:
  1256. Foo
  1257. #+Caption: Not Operator
  1258. #+Name: stf-not-operator
  1259. #+BEGIN_SRC lisp
  1260. (destructuring-bind (op term) function
  1261. (with-tex-output
  1262. (format nil "{\\not ~A}"
  1263. (convert-for-display term))))
  1264. #+END_SRC
  1265. *** TODO Equality
  1266. :PROPERTIES:
  1267. :CREATED: <2016-06-14 Tue 17:41>
  1268. :ID: 4ce4835c-e196-4494-ab4b-591690e4164c
  1269. :END:
  1270. Foo
  1271. #+Caption: Equality Operator
  1272. #+Name: stf-equality-operator
  1273. #+BEGIN_SRC lisp
  1274. (destructuring-bind (op lhs rhs) function
  1275. (declare (ignore op))
  1276. (format nil "{~A = ~A}"
  1277. (convert-for-display lhs)
  1278. (convert-for-display rhs)))
  1279. #+END_SRC
  1280. *** TODO Summation
  1281. :PROPERTIES:
  1282. :CREATED: <2016-06-14 Tue 17:24>
  1283. :ID: 98404213-b8b8-410f-b660-23b701518cea
  1284. :END:
  1285. #+Caption: Summation
  1286. #+Name: stf-summation
  1287. #+BEGIN_SRC lisp
  1288. (destructuring-bind (op start stop expression) function
  1289. (declare (ignore op))
  1290. (format nil "{\sum_~A^~A ~A}"
  1291. (convert-for-display start)
  1292. (convert-for-display stop)
  1293. (convert-for-display expression)))
  1294. #+END_SRC
  1295. *** TODO Integration
  1296. :PROPERTIES:
  1297. :CREATED: <2016-06-14 Tue 17:39>
  1298. :ID: 60c16d30-2bb3-497c-aaa0-4529ecfc523c
  1299. :END:
  1300. #+Caption: Integration
  1301. #+Name: stf-integration
  1302. #+BEGIN_SRC lisp
  1303. (destructuring-bind (op from to expression wrt) function
  1304. (declare (ignore op))
  1305. (with-tex-output
  1306. (format nil "{\\int_~A^~A ~A\\,\\mathrm{d}~A}"
  1307. (convert-for-display from)
  1308. (convert-for-display to)
  1309. (convert-for-display expression)
  1310. (convert-for-display wrt))))
  1311. #+END_SRC
  1312. *** TODO Parenthesis
  1313. :PROPERTIES:
  1314. :CREATED: <2016-06-14 Tue 17:24>
  1315. :ID: 93d643d6-2219-4c49-bba5-190520a6ff29
  1316. :END:
  1317. #+Caption: Parenthesis
  1318. #+Name: stf-parenthesis
  1319. #+BEGIN_SRC lisp
  1320. (destructuring-bind (op type expression) function
  1321. (declare (ignore op))
  1322. (let* ((types '((square . ("[" . "]"))
  1323. (curly . ("{" . "}"))
  1324. (smooth . ("(" . ")"))))
  1325. (left (cadr (assoc type types)))
  1326. (right (cddr (assoc type types))))
  1327. (with-tex-output
  1328. (format nil "{\\left~a {~a} \\right~a}"
  1329. left
  1330. (convert-for-display expression)
  1331. right))))
  1332. #+END_SRC
  1333. ** TODO Special Macros
  1334. :PROPERTIES:
  1335. :CREATED: <2016-06-14 Tue 17:20>
  1336. :ID: 56ca6afe-912a-4530-91e4-a63123dc6d9d
  1337. :END:
  1338. There is one specialty macro, ~with-tex-output~, which is used to ensure that an expression is wrapped to be a part of correct (La)TeX output. It works by checking to see whether or not the variable ~*tex-outputp*~ is true, if so, it simply pass through the given body, and if not, it binds the variable to ~t~, and makes sure that the given body is wrapped in ~$~, allowing the expression to be typeset correctly.
  1339. #+Caption: Special Macros
  1340. #+Name: stf-special-macros
  1341. #+BEGIN_SRC lisp
  1342. (defvar *tex-outputp* nil)
  1343. (declaim (special *tex-outputp*))
  1344. (defmacro with-tex-output (&body body)
  1345. `(if *tex-outputp*
  1346. (progn
  1347. ,@body)
  1348. (let ((*tex-outputp* t))
  1349. (format nil "$~a$"
  1350. (progn
  1351. ,@body)))))
  1352. #+END_SRC
  1353. ** TODO Assembly
  1354. :PROPERTIES:
  1355. :CREATED: <2016-06-14 Tue 17:15>
  1356. :ID: bbd15b88-8256-4b5b-abcc-4783fc096c29
  1357. :END:
  1358. The final assembly of this portion of the system is as simple as the rest, resolving dependencies and placing everything in a single file. As normal, this is done using NoWeb syntax, with everything tangled to the file ~larcs-typeset.lisp~.
  1359. #+Caption: Assemble Symbolic to Typeset Form
  1360. #+Name: stf-assemble
  1361. #+BEGIN_SRC lisp :tangle "larcs-typeset.lisp"
  1362. (in-package #:larcs.typeset)
  1363. <<stf-special-macros>>
  1364. <<stf-rule-retrieval>>
  1365. <<stf-define-rule>>
  1366. <<stf-conversion-driver>>
  1367. <<stf-rules>>
  1368. #+END_SRC