Last active
August 29, 2015 13:56
-
-
Save danlentz/8996607 to your computer and use it in GitHub Desktop.
Common Lisp implementation of the REDUCERS protocol
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (ql:quickload :alexandria) | |
| (defclass reducer (sequence standard-object) | |
| ((coll :initarg :coll) | |
| (xf :initarg :xf))) | |
| (defun reducer (coll xf) | |
| (make-instance 'reducer :coll coll :xf xf)) | |
| (defclass folder (reducer sequence standard-object) | |
| ((coll :initarg :coll) | |
| (xf :initarg :xf))) | |
| (defun folder (coll xf) | |
| (make-instance 'folder :coll coll :xf xf)) | |
| (defgeneric fold (n combinef reducef sequence)) | |
| (defmethod fold (n combinef reducef (sequence folder)) | |
| (with-slots (coll xf) sequence | |
| (fold n combinef (funcall xf reducef) coll))) | |
| (defmethod fold (n combinef reducef (sequence sequence)) | |
| (sequence:reduce reducef sequence :initial-value (funcall combinef))) | |
| (defmethod fold (n combinef reducef (sequence vector)) | |
| (reduce combinef (lparallel:preduce-partial reducef sequence :initial-value (funcall combinef) :parts n))) | |
| (defmethod sequence:reduce (function (sequence reducer) | |
| &key from-end (start 0) end (initial-value nil iv-p)) | |
| (with-slots (coll xf) sequence | |
| (sequence:reduce (funcall xf function) | |
| coll | |
| :initial-value (if iv-p | |
| initial-value | |
| (funcall function))))) | |
| (defun mapping (f) | |
| (lambda (f1) | |
| (lambda (result input) | |
| (funcall f1 result (funcall f input))))) | |
| (defun filtering (pred) | |
| (lambda (f1) | |
| (lambda (result input) | |
| (if (funcall pred input) | |
| (funcall f1 result input) | |
| result)))) | |
| (defun mapcatting (f) | |
| (lambda (f1) | |
| (lambda (result input) | |
| (sequence:reduce f1 (funcall f input) :initial-value result)))) | |
| (defun rmap (f coll) | |
| (folder coll (mapping f))) | |
| (defun rfilter (pred coll) | |
| (folder coll (filtering pred))) | |
| (defun rmapcat (f coll) | |
| (reducer coll (mapcatting f))) | |
| (defun rcons (&optional x y) | |
| (when (or x y) (cons y x))) | |
| (defmacro rbind (&rest reducers) | |
| (let ((reducers | |
| (mapcar (lambda (reducer) `(alexandria:curry #',(car reducer) ,@(cdr reducer))) reducers))) | |
| `(alexandria:compose ,@reducers))) | |
| ;;; | |
| ;; examples | |
| ;;; | |
| ;; | |
| ;; (sequence:reduce #'+ (rmap #'1+ (rfilter #'evenp (alexandria:iota 100)))) | |
| ;; | |
| ;; (let ((pipeline (rbind (rmap #'1+) (rfilter #'evenp))) | |
| ;; (collection (alexandria:iota 100))) | |
| ;; (sequence:reduce #'+ (funcall pipeline collection))) | |
| ;;; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment