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

feat(transducers): add DATA-LENS.TRANSDUCERS:INTO, with tests

Browse Source
This commit is contained in:
Edward
2021-01-09 03:19:38 -08:00
parent 47d7f624ad
commit bd9ef2fba3
4 changed files with 113 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
package.lisp
View File

@ -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))

62
t/transducers.lisp
View File

@ -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))))))

34
transducer-protocol.lisp
View File

@ -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)

16
transducers.lisp
View File

@ -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))