danlentz · August 29, 2015 13:56
diff --git a/reducers.lisp b/reducers.lisp
 ;;
 ;; originally posted:  http://paste.lisp.org/display/132849
 ;;

 ;; The fastest and easiest way to learn the essential concepts and motivation
 ;; for a more generalized notion of collections based on the minimal abstraction
 ;; of REDUCTIBLE, Rich Hickey gives an excellent overview on his original Clojure
 ;; implementation of core.reducers.  Note that it is not currently part of the 
 ;; default Clojure environment due to the requirement of the ForkJoin concurrency
 ;; facilities introduced in Java7 (or Java6 + JSR167Y)
 ;;
 ;; http://clojure.com/blog/2012/05/08/reducers-a-library-and-model-for-collection-processing.html


 (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)))
 ;;;
	;;
	;; originally posted: http://paste.lisp.org/display/132849
	;;

	;; The fastest and easiest way to learn the essential concepts and motivation
	;; for a more generalized notion of collections based on the minimal abstraction
	;; of REDUCTIBLE, Rich Hickey gives an excellent overview on his original Clojure
	;; implementation of core.reducers. Note that it is not currently part of the
	;; default Clojure environment due to the requirement of the ForkJoin concurrency
	;; facilities introduced in Java7 (or Java6 + JSR167Y)
	;;
	;; http://clojure.com/blog/2012/05/08/reducers-a-library-and-model-for-collection-processing.html


	(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)))
	;;;
No results found