Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

parser-pres

  • Loading branch information...
commit 2438d90b42867515c554dad4fb33c2d462b04c1d 1 parent 54386ba
@VincentToups VincentToups authored
View
76 chemistry.el
@@ -1,10 +1,11 @@
-(require 'with-stack)
+ (require 'with-stack)
(require 'stack-words)
(require 'eperiodic)
(require 'defn)
(require 'monads)
(require 'functional)
(require 'units)
+(require 'recur)
(defun element-name (element)
(||| 'name {element} 2>assoc 1>cdr))
@@ -108,11 +109,11 @@
(defun generate-conditions (alist)
(foldl (lambda (it ac)
- (domonad monad-seq
+ (domonad< monad-seq
[a-case ac
component (cadr it)]
(cons (list (car it) component) a-case)))
- (domonad monad-seq
+ (domonad< monad-seq
[q (cadr (car alist))]
(list (list (car (car alist)) q)))
(cdr alist)))
@@ -134,7 +135,7 @@
(flatten-once grouped-condition-list))
(defun add-permutations (conditions-list condition-name values)
- (domonad monad-seq [c conditions-list
+ (domonad< monad-seq [c conditions-list
v values]
(alist>> c condition-name v)))
@@ -183,14 +184,14 @@
(defun* undsf (alist &optional (order (alist-fields alist)) (delim "="))
(join (foldl
(lambda (pair flat)
- (append flat (list (kw->string (car pair)) (to-string (cadr pair)))))
+ (append flat (list (kw->string (car pair)) (to-string (cadr pair)))))
nil
alist) delim))
(defun* undsf-camel (alist &optional (order (alist-fields alist)) (delim "="))
(join (foldl
(lambda (pair flat)
- (append flat (list (camel-case (kw->string (car pair))) (to-string (cadr pair)))))
+ (append flat (list (camel-case (kw->string (car pair))) (to-string (cadr pair)))))
nil
alist) delim))
@@ -238,28 +239,87 @@
(defcurryl da-handler #'concentration-handler
"Dopamine")
-(defcurryr default-da-handler #'da-handler (from-milli 1) (from-milli 50) :micro)
-(defcurryr default-hpo-handler #'hpo-handler (from-milli 1000) (from-milli 50) :micro)
+(defcurryl mcs-handler #'concentration-handler
+ "MCS")
+
+
+(defvar concentrated-hpo-stock 9.791 "Concentration of concentrated HPO Stock.")
+
+(in-milli (dilution-volume (from-milli 50) 9.791 (from-milli 1000)))
+
+(comment
+ (require 'chemistry)
+ (from-milli 9791.0))
+
+(defvar *final-volume-for-mixing* (from-milli 25))
+
+(defcurryr default-da-handler #'da-handler (from-milli 1) *final-volume-for-mixing* :micro)
+(defcurryr default-hpo-handler #'hpo-handler (from-milli 1000) *final-volume-for-mixing* :micro)
+(defcurryr default-mcs-handler #'mcs-handler (from-milli 100) *final-volume-for-mixing* :micro)
(defdecorated default-hpo-handler-micro #'default-hpo-handler
(lambda (arglist)
(cons (from-micro (car arglist))
(cdr arglist))))
+(defdecorated default-mcs-handler-micro #'default-mcs-handler
+ (lambda (arglist)
+ (cons (from-micro (car arglist))
+ (cdr arglist))))
+
(defdecorated default-da-handler-nano #'default-da-handler
(lambda (arglist)
(cons (from-nano (car arglist))
(cdr arglist))))
+
+
(defun default-ph (x)
(format "pH of added buffer should be %f" (from-centi x)))
(setq default-handler-alist
(alist>>
+ :sampleMcs #'default-mcs-handler-micro
:samplePh #'default-ph
:sampleDa #'default-da-handler-nano
:sampleHpo #'default-hpo-handler-micro))
+(defun alist-keys->org-mode-table-segment (alist keys)
+ (join
+ (mapcar
+ (decorate-n (pal #'format " %s ") 0 (pal #'alist alist))
+ keys)
+ "|"))
+
+(defun* generate-experiment-files (condition-args n-trials &optional (mixing-volume (from-milli 50)))
+ (print "WARNING Volumes other than 50 mil don't work correctly.")
+ (let* ((*final-volume-for-mixing* mixing-volume)
+ (keys (mapcar #'car condition-args))
+ (raw-conditions (generate-conditions condition-args))
+ (conditions (||| {raw-conditions}
+ :samplePh 2>group-by-condition
+ '( 1>permute-list ) map 1>ungroup))
+ (trials (range n-trials)))
+ (let ((instructions (find-file "instructions.md"))
+ (log (find-file "log.org")))
+ (with-current-buffer log
+ (kill-region (point-min) (point-max))
+ (insertf "| n | filename | trial | bufferPh | %s |\n" (alist-keys->org-mode-table-segment
+ (mapcar (lambda (x) (list x x))
+ keys) keys)))
+ (with-current-buffer instructions
+ (kill-region (point-min) (point-max)))
+ (loop for c in conditions and i from 1 do
+ (loop for trial in (add-permutations (list c) :trial trials) do
+ (with-current-buffer log
+ (insertf "| | %s | %d |7.40 | %s |\n"
+ (condition->filename trial)
+ (alist trial :trial)
+ (alist-keys->org-mode-table-segment trial keys))))
+ (with-current-buffer instructions
+ (insertf "%d.\t %s\n" i
+ (generate-instructions c default-handler-alist mixing-volume :milli)))))))
+
(defun* generate-ph-hpo-da-experiment-files (condition-args n-trials &optional (mixing-volume (from-milli 50)))
(print "WARNING Volumes other than 50 mil don't work correctly.")
(let* ((raw-conditions (generate-conditions condition-args))
View
BIN  chemistry.elc
Binary file not shown
View
39 defn-readme.htm
@@ -24,6 +24,16 @@
Reasoned Schemer." This archive includes just the projects described
here, but all my code is available on <a href="https://github.com/VincentToups/emacs-utils" title="Github">github</a>.</p>
+<p>I've submitted this particular code because it represents several
+months of work, demonstrates an auto-didactic streak which I think is
+an important part of my personality, and also involves my interest in
+functional programming languages and programming language theory and
+design. I also like this particular project because it demonstrates
+how plucky even an old Lisp can be - we can import very modern
+features into a lisp dialect which is quite old and crusty. I'm not,
+however, a Lisp zealot - I'm quite interested in working with other
+functional languages.</p>
+
<h3>Running the Code</h3>
<p>This code requires GNU Emacs 23.1.1. Extract the files located with
@@ -34,7 +44,9 @@
</code></pre>
<p>You should then be able to <code>(require 'defn)</code> and execute the examples
-in this document and/or play with the library. </p>
+in this document and/or play with the library. Note that like most
+other macro-heavy Elisp projects (like the partial Common Lisp
+implementation) this library performs best when byte-compiled. </p>
<h3>Destructuring Bind</h3>
@@ -309,14 +321,15 @@
<h4>Note on Recur and Lexical Scope</h4>
<p>This version of recursion will not handle lexically scoped variables
-correctly because it mutates the context for recursion without
-considering whether a lambda expression or other artifact is hanging
-onto a reference to some value. Supporting the correct behavior would
-require a much more complex codewalker, and, in any case the need is
-somewhat obviated by the requirement that Emacs Lisp programmers
-explicitly indicate a desire for lexical scope using a <code>lexical-let</code>
-expression. Each <code>lexical-let</code> then closes over its own version of
-the variables in scope. So even though we are employing mutation:</p>
+completely correctly. This is because it mutates the context of a
+recursion without considering whether a <code>lambda</code> expression or other
+artifact is hanging onto a reference to some value in that context.
+Supporting the correct behavior would require a much more complex
+codewalker, and, in any case the need is somewhat obviated by the
+requirement that Emacs Lisp programmers explicitly indicate a desire
+for lexical scope using a <code>lexical-let</code> expression. Each
+<code>lexical-let</code> then closes over its own version of the variables in
+scope. So even though we are employing mutation under the hood:</p>
<pre><code>(setq closures (dloop [i 0
acc nil]
@@ -327,8 +340,8 @@
(lambda () x)) acc)))))
</code></pre>
-<p>Which collects a series of <code>lambda</code>'s with different values of <code>i</code>,
-the following code produces the correct values:</p>
+<p>, which collects a series of <code>lambda</code>'s enclosing different values of
+<code>i</code>, the following code produces the correct values:</p>
<pre><code>(funcall (elt closures 0)) -&gt; 0
(funcall (elt closures 4)) -&gt; 4
@@ -337,7 +350,9 @@
<p>etc.</p>
<p>Emacs Lisp will support real lexical scope in the next release of
-emacs. How that bodes for this project is unknown.</p>
+emacs. I'm pretty excited by this development, but I'm not sure how
+it will impact these libraries. Probably they should be completely
+rewritten to exploit the new model of execution. </p>
<h3>Example Usage</h3>
View
14 defn-readme.md
@@ -25,6 +25,16 @@ an implementation of Kanren, the logic language described in "The
Reasoned Schemer." This archive includes just the projects described
here, but all my code is available on [github][1].
+I've submitted this particular code because it represents several
+months of work, demonstrates an auto-didactic streak which I think is
+an important part of my personality, and also involves my interest in
+functional programming languages and programming language theory and
+design. I also like this particular project because it demonstrates
+how plucky even an old Lisp can be - we can import very modern
+features into a lisp dialect which is quite old and crusty. I'm not,
+however, a Lisp zealot - I'm quite interested in working with other
+functional languages.
+
### Running the Code ###
This code requires GNU Emacs 23.1.1. Extract the files located with
@@ -34,7 +44,9 @@ this readme to somewhere convenient. Then start emacs with `emacs
(add-to-list 'load-path <Location/of/files/>)
You should then be able to `(require 'defn)` and execute the examples
-in this document and/or play with the library.
+in this document and/or play with the library. Note that like most
+other macro-heavy Elisp projects (like the partial Common Lisp
+implementation) this library performs best when byte-compiled.
### Destructuring Bind ###
View
4 parser-pres/page-1.el
@@ -5,7 +5,7 @@
;; consider the question of what a monadic parser combinator is in
;; the following order:
-;; 1) What is our representation of a parse?
+;; 1) What is our representation of a parser?
;; 2) How do we combine them?
;; 3) How does this combination strategy form a monad?
@@ -17,5 +17,5 @@
(require 'el-pres)
(rebuild-control-panel)
-;;;Controls Home . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
6 parser-pres/page-10.el
@@ -6,6 +6,10 @@
(y 11))
(+ x y))
+(let* ((x 10)
+ (y (+ x 1)))
+ (+ x y))
+
;;; expands to
(comment
(funcall
@@ -56,5 +60,5 @@
;;; the idea of let*. That is, sequencing dependent computations.
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-11.el
@@ -38,5 +38,5 @@
(find-file-other-frame "~/work/art/haskell-curry-says.png")
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
4 parser-pres/page-12.el
@@ -51,6 +51,8 @@
(simple-parser-return res)))
(funcall (-cat-or-dog) "ewe")
+(funcall (-cat-or-dog) "cat")
+(funcall (-cat-or-dog) "dog")
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
7 parser-pres/page-13.el
@@ -18,6 +18,9 @@
(funcall (-zero-or-more
(-matches "a"))
"aaaab")
+(funcall (-zero-or-more
+ (-matches "a"))
+ "bbbb")
(defun -one-or-more (parser)
(lexical-let ((parser parser))
@@ -29,7 +32,7 @@
(-matches "dog "))
"dog dog dog dog cat")
-(funcall (-zero-or-more
+(funcall (-one-or-more
(-matches "dog "))
"cat dog dog dog cat")
@@ -91,5 +94,5 @@
(funcall (-n-of 3 (-matches "a")) "aaab")
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
17 parser-pres/page-14.el
@@ -28,13 +28,15 @@
(simple-parser-return
(list :trailing (reduce #'concat trailing)))))
+(defun -colon ()
+ (-matches ":"))
+
(defun -colon-then-trailing ()
(parser-let* ((colon (-colon))
(trailing (-trailing)))
(simple-parser-return trailing)))
-(defun -colon ()
- (-matches ":"))
+
(setq tab (format "\t"))
(defun -whitespaces ()
@@ -43,7 +45,7 @@
(defun -middle ()
(parser-let*
- ((colon (-not (-colon)))
+ ((not-colon (-not (-colon)))
(contents (-zero-or-more (-not-whitespace))))
(simple-parser-return (list :middle (reduce #'concat contents)))))
@@ -53,11 +55,6 @@
(middle (-middle)))
(simple-parser-return middle)))
-(setq tab (format "\t"))
-(defun -whitespaces ()
- (-one-or-more (-or (-matches " ")
- (-matches tab))))
-
(defun -params ()
(parser-let*
((params (-zero-or-more (-space-middle)))
@@ -72,8 +69,8 @@
(defun -not-whitespace ()
(-satisfies
(lambda (x)
- (and (not (string= x " "))
- (not (string= x tab))))))
+ (and (not (string= x " "))
+ (not (string= x tab))))))
(defun -not-whitespaces ()
(-zero-or-more (-not-whitespace)))
View
3  parser-pres/page-2.el
@@ -1,4 +1,3 @@
-xev
;;; Parsers
;;; The whole point here is to enable us to build complex parsers out
@@ -32,5 +31,5 @@ xev
(parse-a "abracadabra")
(parse-a "dogs of war")
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-3.el
@@ -25,5 +25,5 @@
;;;
;;; It, too, will be of importance later.
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-4.el
@@ -25,5 +25,5 @@
(parse-ab "atrophy")
(parse-ab "oboe")
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-5.el
@@ -28,5 +28,5 @@
;;; pretty sweet!
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-6.el
@@ -26,5 +26,5 @@
;;; VALUE our parsers return, when combining parsers. We need an
;;; interface to expose these values selectively.
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-7.el
@@ -32,5 +32,5 @@
;;; parser by calling PARSER-PRODUCER on that value.
;;; 3 - finally, it applies this new parser to the leftovers from PARSER
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
2  parser-pres/page-8.el
@@ -24,5 +24,5 @@
;;; - wrap up everything in a containing parser.
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
View
11 parser-pres/page-9.el
@@ -27,13 +27,14 @@
(find-file-other-frame "~/work/art/monadic-return.png")
-(funcall (parser-let* ((a-res #'parse-a)
- (b-res #'parse-b)
- (c-res #'parse-c))
- (simple-parser-return (list a-res b-res c-res)))
+(funcall (parser-let*
+ ((a-res #'parse-a)
+ (b-res #'parse-b)
+ (c-res #'parse-c))
+ (simple-parser-return (list a-res b-res c-res)))
"abcdef")
;;; ZING!
-;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+;;;Controls Home <<< . >>> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; Index
Please sign in to comment.
Something went wrong with that request. Please try again.