fiddlerwoaroof/data-lens
1
0
Fork 0
mirror of https://github.com/fiddlerwoaroof/data-lens.git synced 2025-11-08 18:26:32 +00:00
Code Issues Releases Wiki Activity

add denest

Browse Source
This commit is contained in:
Ed Langley
2019-02-06 17:56:06 -08:00
parent 72a785dc80
commit 14b91cf5fe
1 changed files with 46 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
lens.lisp
View File

@ -22,7 +22,8 @@
#:maximizing #:maximizing
#:zipping #:zipping
#:applying #:applying
#:transform-elt)) #:transform-elt
#:denest))
(in-package :data-lens) (in-package :data-lens)
(declaim (declaim
@ -155,15 +156,30 @@
(lambda (it) (lambda (it)
(subseq it start end))) (subseq it start end)))
(defun-ct update (thing fun &rest args)
(apply fun thing args))
(define-modify-macro updatef (fun &rest args)
update)
(defun-ct transform-head (fun) (defun-ct transform-head (fun)
(lambda (it) (lambda (it)
(list* (funcall fun (car it)) (typecase it
(cdr it)))) (list (list* (funcall fun (car it))
(cdr it)))
(vector (let ((result (copy-seq it)))
(prog1 result
(updatef (elt result 0) fun)))))))
(defun-ct transform-tail (fun) (defun-ct transform-tail (fun)
(lambda (it) (lambda (it)
(list* (car it) (typecase it
(funcall fun (cdr it))))) (list (list* (car it)
(funcall fun (cdr it))))
(vector (let ((result (copy-seq it)))
(prog1 result
(updatef (subseq result 1)
fun)))))))
(defun-ct transform-elt (elt fun) (defun-ct transform-elt (elt fun)
(lambda (it) (lambda (it)
@ -177,10 +193,9 @@
(funcall key-set (funcall key-set
(funcall fun key-val))))) (funcall fun key-val)))))
(defun-ct juxt (fun1 fun2 &rest r) (defun-ct juxt (fun1 &rest r)
(lambda (&rest args) (lambda (&rest args)
(list* (apply fun1 args) (list* (apply fun1 args)
(apply fun2 args)
(when r (when r
(mapcar (lambda (f) (mapcar (lambda (f)
(apply f args)) (apply f args))
@ -192,15 +207,25 @@
(funcall fun2)))) (funcall fun2))))
(defun-ct derive (diff-fun &key (key #'identity)) (defun-ct derive (diff-fun &key (key #'identity))
(lambda (list) (lambda (seq)
(cons (cons nil (car list)) (typecase seq
(list (cons (cons nil (car seq))
(mapcar (lambda (next cur) (mapcar (lambda (next cur)
(cons (funcall diff-fun (cons (funcall diff-fun
(funcall key next) (funcall key next)
(funcall key cur)) (funcall key cur))
next)) next))
(cdr list) (cdr seq)
list)))) seq)))
(vector (coerce (loop for cur = nil then next
for next across seq
if cur
collect (cons (funcall diff-fun
(funcall key next)
(funcall key cur))
cur)
else collect (cons nil next))
'vector)))))
(defun-ct cumsum (defun-ct cumsum
(&key (add-fun #'+) (key #'identity) (combine (lambda (x y) y x)) (zero 0)) (&key (add-fun #'+) (key #'identity) (combine (lambda (x y) y x)) (zero 0))
@ -222,6 +247,11 @@
(lambda (seq) (lambda (seq)
(map result-type fun seq))) (map result-type fun seq)))
(defun-ct denest (&key (result-type 'list))
(lambda (seq)
(apply #'concatenate result-type
seq)))
(defmacro applying (fun &rest args) (defmacro applying (fun &rest args)
(alexandria:with-gensyms (seq) (alexandria:with-gensyms (seq)
`(lambda (,seq) `(lambda (,seq)