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

feat(transducers): add function for mapping mv-lists

Browse Source
This commit is contained in:
fiddlerwoaroof
2020-12-18 22:05:21 -08:00
parent 139535d8e5
commit 1f67b287f5
1 changed files with 76 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
transducers.lisp
View File

@ -1,10 +1,18 @@
(in-package :data-lens.transducers.beta) (in-package :data-lens.transducers.beta)
(declaim (inline mapping filtering deduping catting splitting
exit-early taking dropping transduce
hash-table-builder vector-builder list-builder))
(defun mapping (function) (defun mapping (function)
(lambda (rf) (lambda (rf)
(lambda (acc next) (lambda (acc next)
(funcall rf acc (funcall function next))))) (funcall rf acc (funcall function next)))))
(defun mv-mapping (function)
(lambda (rf)
(lambda (acc next)
(funcall rf acc (multiple-value-list (funcall function next))))))
(defun filtering (predicate) (defun filtering (predicate)
(lambda (rf) (lambda (rf)
(lambda (acc next) (lambda (acc next)
@ -51,30 +59,61 @@
acc) acc)
(funcall rf acc next)))))) (funcall rf acc next))))))
(defgeneric unwrap (it obj)
(:method (it obj) obj))
(defgeneric init (it))
(defgeneric stepper (it))
(defgeneric foldling (seq func init)
(:method ((seq sequence) (func function) init)
(reduce func seq :initial-value init))
(:method ((seq sequence) (func symbol) init)
(reduce func seq :initial-value init)))
(defun transduce (xf build seq) (defun transduce (xf build seq)
(funcall build (unwrap build
(catch 'done (catch 'done
(reduce (funcall xf build) seq :initial-value (funcall build))))) (foldling seq
(funcall xf (stepper build))
(init build)))))
(defclass lazy-sequence ()
((%next :initarg :next :reader next)))
(defmethod foldling ((seq lazy-sequence) (func function) init)
(let ((next (next seq)))
(loop for next-val = (funcall next)
for acc = init then next-acc
for next-acc = (when next-val (funcall func acc next-val))
while next-val
finally (return acc))))
(defmacro comment (&body body) (defmacro comment (&body body)
(declare (ignore body)) (declare (ignore body))
nil) nil)
(defun hash-table-builder (&optional (acc nil acc-p) (next nil next-p)) (defmethod stepper ((it (eql 'hash-table-builder)))
(cond (next-p (destructuring-bind (k v) next (lambda (acc next)
(setf (gethash k acc) v)) acc) (destructuring-bind (k v) next
(acc-p acc) (setf (gethash k acc) v))
(t (make-hash-table)))) acc))
(defmethod init ((it (eql 'hash-table-builder)))
(make-hash-table))
(defun vector-builder (&optional (acc nil acc-p) (next nil next-p)) (defmethod stepper ((it (eql 'vector-builder)))
(cond (next-p (vector-push-extend next acc) acc) (lambda (acc next)
(acc-p acc) (vector-push-extend next acc)
(t (make-array 0 :fill-pointer t :adjustable t)))) acc))
(defmethod init ((it (eql 'vector-builder)))
(make-array 0 :fill-pointer t :adjustable t))
(eval-when (:load-toplevel :compile-toplevel :execute)
(labels ((make-snoc () (defmethod init ((it (eql 'list-builder)))
(vector nil nil)) (declare (optimize (speed 3)))
(add-to-snoc (acc a) (coerce (vector nil nil)
'(simple-array list (2))))
(defmethod stepper ((it (eql 'list-builder)))
(lambda (acc a)
(declare (optimize (speed 3))
(type (simple-array list (2)) acc))
(if (elt acc 1) (if (elt acc 1)
(let* ((to-build (elt acc 1))) (let* ((to-build (elt acc 1)))
(push a (cdr to-build)) (push a (cdr to-build))
@ -82,19 +121,16 @@
(let ((new (list a))) (let ((new (list a)))
(setf (elt acc 0) new (setf (elt acc 0) new
(elt acc 1) new))) (elt acc 1) new)))
acc) acc))
(desnoc (acc) (defmethod unwrap ((it (eql 'list-builder)) obj)
(elt acc 0))) (elt obj 0))
(defun list-builder (&optional (acc nil acc-p) (next nil next-p))
(cond (next-p (add-to-snoc acc next))
(acc-p (desnoc acc))
(t (make-snoc))))))
(comment (comment
(defun 2* (it) (defun 2* (it)
(* 2 it)) (* 2 it))
(let ((result (transduce (alexandria:compose (catting) (let ((result (transduce (alexandria:compose
(catting)
(mapping #'parse-integer) (mapping #'parse-integer)
(filtering (complement #'evenp)) (filtering (complement #'evenp))
(mapping (data-lens:juxt #'identity #'identity)) (mapping (data-lens:juxt #'identity #'identity))
@ -102,7 +138,8 @@
(mapping (data-lens:transform-head #'1+)) (mapping (data-lens:transform-head #'1+))
(taking 2)) (taking 2))
'hash-table-builder 'hash-table-builder
'(("123" "234" "345" "454") ("568" "490") ("567" "213"))) '(("123" "234" "345" "454")
)) ("568" "490")
("567" "213")))))
(values result (values result
(alexandria:hash-table-alist result)))) (alexandria:hash-table-alist result))))