Browse code
Initial commit
fiddlerwoaroof authored on 13/08/2017 19:49:23Showing 3 changed files
| 0 | 2 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,8 @@ |
| 1 |
+(asdf:defsystem #:data-lens |
|
| 2 |
+ :description "Utilities for building data transormations from composable functions, modeled on lenses and transducers" |
|
| 3 |
+ :author "Edward Langley <edward@elangley.org>" |
|
| 4 |
+ :license "MIT" |
|
| 5 |
+ :depends-on (cl-ppcre) |
|
| 6 |
+ :serial t |
|
| 7 |
+ :components ((:file "lens"))) |
|
| 8 |
+ |
| 0 | 9 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,75 @@ |
| 1 |
+(defpackage :data-lens |
|
| 2 |
+ (:use :cl) |
|
| 3 |
+ (:export #:regex-match #:include #:exclude #:pick |
|
| 4 |
+ #:snapshot-to-vector #:vector-to-lt #:key-transform |
|
| 5 |
+ #:combine #:derive #:cumsum #:over #:on #:shortcut |
|
| 6 |
+ #:defun-ct)) |
|
| 7 |
+(in-package :data-lens) |
|
| 8 |
+ |
|
| 9 |
+(defmacro shortcut (name function &body bound-args) |
|
| 10 |
+ `(eval-when (:load-toplevel :compile-toplevel :execute) |
|
| 11 |
+ (setf (fdefinition ',name) |
|
| 12 |
+ (,function ,@bound-args)))) |
|
| 13 |
+ |
|
| 14 |
+(defmacro defun-ct (name (&rest args) &body body) |
|
| 15 |
+ `(eval-when (:load-toplevel :compile-toplevel :execute) |
|
| 16 |
+ (defun ,name ,args |
|
| 17 |
+ ,@body))) |
|
| 18 |
+ |
|
| 19 |
+(defun-ct regex-match (regex) |
|
| 20 |
+ (lambda (data) |
|
| 21 |
+ (cl-ppcre:scan-to-strings regex data))) |
|
| 22 |
+ |
|
| 23 |
+(defun-ct include (pred) |
|
| 24 |
+ (lambda (seq) |
|
| 25 |
+ (remove-if-not pred seq))) |
|
| 26 |
+ |
|
| 27 |
+(defun-ct exclude (pred) |
|
| 28 |
+ (lambda (seq) |
|
| 29 |
+ (remove-if pred seq))) |
|
| 30 |
+ |
|
| 31 |
+(defun-ct pick (selector) |
|
| 32 |
+ (lambda (seq) |
|
| 33 |
+ (map 'list selector seq))) |
|
| 34 |
+ |
|
| 35 |
+(defun-ct key-transform (fun key-get key-set) |
|
| 36 |
+ (lambda (it) |
|
| 37 |
+ (let ((key-val (funcall key-get it))) |
|
| 38 |
+ (funcall key-set |
|
| 39 |
+ (funcall fun key-val))))) |
|
| 40 |
+ |
|
| 41 |
+(defun-ct combine (fun1 fun2) |
|
| 42 |
+ (lambda (item) |
|
| 43 |
+ (list (funcall fun1 item) |
|
| 44 |
+ (funcall fun2 item)))) |
|
| 45 |
+ |
|
| 46 |
+(defun-ct derive (diff-fun &key (key #'identity)) |
|
| 47 |
+ (lambda (list) |
|
| 48 |
+ (mapcar (lambda (next cur) |
|
| 49 |
+ (cons (funcall diff-fun (funcall key next) (funcall key cur)) |
|
| 50 |
+ next)) |
|
| 51 |
+ (cdr list) |
|
| 52 |
+ list))) |
|
| 53 |
+ |
|
| 54 |
+(defun-ct cumsum (&key (add-fun #'+) (key #'identity) (combine (lambda (x y) y x)) (zero 0)) |
|
| 55 |
+ (lambda (seq) |
|
| 56 |
+ (nreverse |
|
| 57 |
+ (reduce (lambda (accum next) |
|
| 58 |
+ (let ((key-val (funcall key next)) |
|
| 59 |
+ (old-val (if accum |
|
| 60 |
+ (funcall key (car accum)) |
|
| 61 |
+ zero))) |
|
| 62 |
+ (cons (funcall combine |
|
| 63 |
+ (funcall add-fun old-val key-val) |
|
| 64 |
+ next) |
|
| 65 |
+ accum))) |
|
| 66 |
+ seq |
|
| 67 |
+ :initial-value ())))) |
|
| 68 |
+ |
|
| 69 |
+(defun-ct over (fun &key (result-type 'list)) |
|
| 70 |
+ (lambda (seq) |
|
| 71 |
+ (map result-type fun seq))) |
|
| 72 |
+ |
|
| 73 |
+(defun-ct on (fun key) |
|
| 74 |
+ (lambda (it) |
|
| 75 |
+ (funcall fun (funcall key it)))) |