From bd9ef2fba3ba5595e2196961b9bee11e29377e38 Mon Sep 17 00:00:00 2001 From: Edward Date: Sat, 9 Jan 2021 03:19:38 -0800 Subject: [PATCH] feat(transducers): add DATA-LENS.TRANSDUCERS:INTO, with tests --- package.lisp | 7 +++-- t/transducers.lisp | 62 ++++++++++++++++++++++++++++++++++++++++ transducer-protocol.lisp | 34 ++++++++++++++++++++-- transducers.lisp | 16 +++++++++++ 4 files changed, 113 insertions(+), 6 deletions(-) diff --git a/package.lisp b/package.lisp index 560205a..7176348 100644 --- a/package.lisp +++ b/package.lisp @@ -18,7 +18,8 @@ #:compress-runs #:combine-matching-lists #:sorted #:applicable-when #:of-length #:of-min-length #:of-max-length #:transform-head #:maximizing #:zipping #:applying #:splice-elt #:transform-elt #:denest - #:op #:defalias #:<> #:<>1 #:== #:• #:suffixp #:functionalize)) + #:op #:defalias #:<> #:<>1 #:== #:• #:suffixp #:functionalize + #:inc)) (defpackage :data-lens.transducers.internals (:use :cl) @@ -29,11 +30,11 @@ (:use :cl) (:import-from :data-lens.transducers.internals #:unwrap #:init #:reduce-generic #:stepper #:transduce - #:exit-early) + #:exit-early #:into) (:export #:mapping :filtering :deduping :catting :splitting #:exit-early :taking :dropping :transduce #:hash-table-builder :vector-builder :list-builder #:collecting #:mv-mapping #:mv-selecting #:hash-table-select #:mv-filtering #:mapcatting #:lazy-sequence #:compressing-runs #:iota - #:repeating #:repeating*)) + #:repeating #:repeating* #:into)) diff --git a/t/transducers.lisp b/t/transducers.lisp index 423c027..e8e8be0 100644 --- a/t/transducers.lisp +++ b/t/transducers.lisp @@ -195,3 +195,65 @@ (funcall (data-lens:• (data-lens:sorted '< :key 'car) (data-lens:sorted '< :key 'cdr)) (alexandria:hash-table-alist result)))))) + +(5am:def-test into (:suite :data-lens.transducers :depends-on mapping) + (5am:is (equal '(0 1 2) + (data-lens.transducers:into '() + (data-lens.transducers:taking 3) + (data-lens.transducers:iota)))) + + (5am:is (equal '(0 1 2) + (data-lens.transducers:into '(0 1 2) + (data-lens.transducers:taking 0) + (data-lens.transducers:iota)))) + + (5am:is (equal '() + (data-lens.transducers:into '() + (data-lens.transducers:taking 0) + (data-lens.transducers:iota)))) + + (5am:is (equal '() + (data-lens.transducers:into '() + (data-lens.transducers:mapping #'identity) + #()))) + + (5am:is (equalp (alexandria:plist-hash-table '(:p 0 :l 1 :i 2 :s 3 :t 4)) + (let ((count 0)) + (data-lens.transducers:into (make-hash-table) + (data-lens.transducers:mapping + (lambda (it) + (prog1 (list it count) + (incf count)))) + '(:p :l :i :s :t))))) + + (loop for type in '(vector list) + do (5am:is (equalp #(1 2 3 4 5 6) + (data-lens.transducers:into #(1 2 3) + (data-lens.transducers:mapping + (data-lens:inc 4)) + (coerce #(0 1 2) type)))) + (5am:is (equal '(1 2 3 4 5 6) + (data-lens.transducers:into '(1 2 3) + (data-lens.transducers:mapping + (data-lens:inc 4)) + (coerce #(0 1 2) type)))) + + (5am:is (equal '(1 2 3 4 5 6) + (data-lens.transducers:into '(1 2 3) + (data-lens.transducers:mapping + (data-lens:inc 4)) + (coerce #(0 1 2) type)))) + (5am:is (equal '(1 2 3 4 5 6) + (data-lens.transducers:into '(1 2 3) + (data-lens:• + (data-lens.transducers:taking 3) + (data-lens.transducers:mapping + (data-lens:inc 4))) + (data-lens.transducers:iota)))) + (5am:is (equalp #(1 2 3 4 5 6) + (data-lens.transducers:into #(1 2 3) + (data-lens:• + (data-lens.transducers:taking 3) + (data-lens.transducers:mapping + (data-lens:inc 4))) + (data-lens.transducers:iota)))))) diff --git a/transducer-protocol.lisp b/transducer-protocol.lisp index b9872bd..5c8cc38 100644 --- a/transducer-protocol.lisp +++ b/transducer-protocol.lisp @@ -16,10 +16,19 @@ seq) acc))) +#+(or) +(defun document (&rest strings) + (serapeum:string-join strings #.(format nil "~2%"))) + (defgeneric init (client)) (defgeneric stepper (client)) (defgeneric unwrap (client obj) (:method (client obj) obj)) +(defgeneric builder-for-input (seq) + (:documentation + "Take a transducible sequence, return a builder and an init value for that builder. + +CONSTRAINT: SEQ should be copied, not modified")) (defun exit-early (acc) (throw 'done acc)) @@ -36,10 +45,29 @@ transducer (init build))))))) -#+(or) +(defun into (to xf from) + (multiple-value-bind (builder init) (builder-for-input to) + (let* ((xf (etypecase xf + (list (apply 'alexandria:compose xf)) + ((or function symbol) xf))) + (transducer (funcall xf (stepper builder)))) + (unwrap builder + (funcall transducer + (catch 'done + (reduce-generic from + transducer + init))))))) + +(defmacro defdocumentation (name &body doc-specs) + name doc-specs + nil) + (defdocumentation transducer-protocol - (:function transduce (xf build seq) - ) + (:function transduce (xf builder seq) + "Run a transducer XF over sequence SEQ using BUILDER to accumulate results. + +Uses the generic function REDUCE-GENERIC so transducers work over lazy +sequences and hash tables.") (:generic-function unwrap (client obj) ) (:generic-function unwrap (client obj) diff --git a/transducers.lisp b/transducers.lisp index 3efd537..0fa02a1 100644 --- a/transducers.lisp +++ b/transducers.lisp @@ -155,6 +155,9 @@ (destructuring-bind (k v) next (setf (gethash k acc) v)) acc))) +(defmethod data-lens.transducers.internals:builder-for-input ((inp hash-table)) + (values 'hash-table-builder + (alexandria:copy-hash-table inp))) (defmethod init ((it (eql 'vector-builder))) (make-array 0 :fill-pointer t :adjustable t)) @@ -163,6 +166,12 @@ ((acc next) (vector-push-extend next acc) acc))) +(defmethod data-lens.transducers.internals:builder-for-input ((inp vector)) + (values 'vector-builder + (make-array (array-dimensions inp) + :initial-contents inp + :fill-pointer t))) + (defmethod init ((it (eql 'list-builder))) (declare (optimize (speed 3))) @@ -180,6 +189,13 @@ acc))) (defmethod unwrap ((it (eql 'list-builder)) obj) (cdr (elt obj 0))) +(defmethod data-lens.transducers.internals:builder-for-input ((inp list)) + (let ((builder 'list-builder)) + (values builder + (if inp + (let ((inp (cons nil (copy-list inp)))) + (vector inp (last inp))) + (init builder))))) (defmacro comment (&body body) (declare (ignore body))