├── .github └── workflows │ ├── Generate-Docs.yml │ ├── Run-Tests.yml │ └── Update-Docs.yml ├── .gitignore ├── LICENSE.md ├── README.md ├── picl.asd ├── src ├── combinatoric.lisp ├── default-iterators.lisp ├── interface.lisp ├── iterate-driver.lisp ├── itertools.lisp ├── package.lisp └── utils.lisp ├── staple.ext.lisp └── tests ├── package.lisp ├── test-combinatoric.lisp └── test-itertools.lisp /.github/workflows/Generate-Docs.yml: -------------------------------------------------------------------------------- 1 | # This is pretty much duplicated / stripped down from the "build and push" 2 | # workflow 3 | 4 | name: Test Documentation generation 5 | 6 | on: 7 | pull_request: 8 | branches: [ master ] 9 | 10 | workflow_dispatch: 11 | 12 | jobs: 13 | test-doc-generation: 14 | runs-on: ubuntu-latest 15 | 16 | steps: 17 | - uses: actions/checkout@v2 18 | - name: Do-Everything 19 | run: | 20 | set -e 21 | # Actually generate the documentation 22 | docker run -v $(pwd):/tmp/picl -w /tmp/picl \ 23 | daewok/lisp-devel:ql "sbcl" \ 24 | --disable-debugger \ 25 | --eval '(ql:quickload :staple)' \ 26 | --eval '(push #P"/tmp/" ql:*local-project-directories*)' \ 27 | --eval '(ql:quickload :picl)' \ 28 | --eval '(ql:quickload :picl/tests)' \ 29 | --eval '(ql:quickload :picl/iterate)' \ 30 | --eval '(staple:generate :picl :if-exists :supersede)' 31 | -------------------------------------------------------------------------------- /.github/workflows/Run-Tests.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: Run-Tests 4 | 5 | on: 6 | push: 7 | branches: [ master ] 8 | pull_request: 9 | branches: [ master ] 10 | 11 | workflow_dispatch: 12 | 13 | jobs: 14 | run-tests: 15 | runs-on: ubuntu-latest 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | - name: Run the tests using FiveAM 20 | run: | 21 | set -e 22 | docker run -v $(pwd):/tmp/picl -w /tmp/picl \ 23 | daewok/lisp-devel:ql "sbcl" \ 24 | --disable-debugger \ 25 | --eval '(push #P"/tmp/" ql:*local-project-directories*)' \ 26 | --eval '(ql:quickload :picl/tests)' \ 27 | --eval '(setf fiveam:*verbose-failures* t)' \ 28 | --eval '(unless (fiveam:run! (quote picl/tests:suite)) (error "Tests failed"))' 29 | -------------------------------------------------------------------------------- /.github/workflows/Update-Docs.yml: -------------------------------------------------------------------------------- 1 | # Action to build the docs and subsequently update the website. 2 | # Generate-Docs is pretty much a complete subset of this... I wonder how I'm 3 | # supposed to factor out the common functionality? 4 | 5 | name: Update-Doc-Website 6 | 7 | on: 8 | push: 9 | branches: [ master ] 10 | 11 | workflow_dispatch: 12 | 13 | jobs: 14 | build-and-push-documentation: 15 | runs-on: ubuntu-latest 16 | 17 | # Maybe I should actually split this up into logical steps 18 | steps: 19 | - uses: actions/checkout@v2 20 | 21 | - name: Do-Everything 22 | env: 23 | GITHUB_USERNAME: anlsh 24 | GITHUB_DOC_REPO_NAME: anlsh.github.io.git 25 | DEST_FOLDER: /tmp/anlsh.github.io 26 | PICL_DOC_FOLDER: picl 27 | DOC_REPO_PAT: ${{ secrets.DOC_REPO_PAT }} 28 | run: | 29 | set -e 30 | # Actually generate the documentation 31 | docker run -v ${DEST_FOLDER}:${DEST_FOLDER} -v $(pwd):/tmp/picl -w /tmp/picl \ 32 | daewok/lisp-devel:ql "sbcl" \ 33 | --disable-debugger \ 34 | --eval '(ql:quickload :staple)' \ 35 | --eval '(push #P"/tmp/" ql:*local-project-directories*)' \ 36 | --eval '(ql:quickload :picl)' \ 37 | --eval '(ql:quickload :picl/tests)' \ 38 | --eval '(ql:quickload :picl/iterate)' \ 39 | --eval '(staple:generate :picl :if-exists :supersede)' 40 | 41 | # Now upload it to the doc website 42 | 43 | sudo rm -rf ${DEST_FOLDER} 44 | sudo git clone https://github.com/${GITHUB_USERNAME}/${GITHUB_DOC_REPO_NAME} ${DEST_FOLDER} 45 | sudo rm -rf ${DEST_FOLDER}/${PICL_DOC_FOLDER} 46 | sudo mv docs/ ${DEST_FOLDER}/${PICL_DOC_FOLDER} 47 | cd ${DEST_FOLDER} 48 | sudo git add ${PICL_DOC_FOLDER} 49 | 50 | # Git stuff (eww) (the author flag doesnt work wtf) 51 | sudo git config user.name "DocBot" 52 | sudo git config user.email "<>" 53 | sudo git commit --allow-empty -m "Generate docs for picl:${GITHUB_SHA}" 54 | sudo git push https://${GITHUB_USERNAME}:${DOC_REPO_PAT}@github.com/${GITHUB_USERNAME}/${GITHUB_DOC_REPO_NAME} 55 | exit 0 56 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) [2020] [Anish Moorthy] 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # picl [![Run-Tests Actions Status](https://github.com/anlsh/picl/workflows/Run-Tests/badge.svg)](https://github.com/anlsh/picl/actions) 2 | #### _Anish Moorthy _ 3 | 4 | *Python Itertools in Common Lisp (v1.0.0). Pronounced like "pickle"* 5 | 6 | A (very nearly) complete port of Python's 7 | [itertools](https://docs.python.org/3.8/library/itertools.html) package, 8 | complete with laziness where applicable. 9 | 10 | This project currently lives [on Github](https://github.com/anlsh/picl). 11 | Pull requests welcome! 12 | 13 | ### Objectives and Rationale 14 | 15 | PICL aims to provide a complete port of itertools, complete with laziness, 16 | without any reliance on `cl-cont`. 17 | 18 | [cl-itertools](https://github.com/mabragor/cl-itertools) 19 | and [snakes](https://github.com/BnMcGn/snakes), provide similar functionality. 20 | Unfortunately both libraries rely on `cl-cont`, meaning they wont always play 21 | nice with the condition system, and `cl-itertools` remains very incomplete on 22 | top of that 23 | 24 | 25 | ### Installation 26 | 27 | PICL is in Quicklisp, and can be installed as follows 28 | 29 | ``` common-lisp 30 | (ql:quickload :picl) 31 | ``` 32 | 33 | Do not `:use` this package: it might export new symbols in the future. You have 34 | been forewarned. 35 | 36 | ### Documentation 37 | Thanks to [Staple](https://github.com/Shinmera/staple) you can 38 | [read the documentation online](https://anlsh.github.io/picl) or build it 39 | yourself like so 40 | 41 | ``` common-lisp 42 | (staple:generate :picl :if-exists :supersede) 43 | ``` 44 | If you don't have PICL's dependencies loaded into your image yet, you'll get 45 | some harmless warnings about invalid definitions 46 | 47 | ### Testing 48 | A fairly comprehensive test suite written with 49 | [FiveAM](https://common-lisp.net/project/fiveam/) is provided. You can run it 50 | yourself either manually or through asdf 51 | 52 | ``` common-lisp 53 | ;; The easy way 54 | (asdf:test-system :picl) 55 | ;; The slightly less easy way 56 | (ql:quickload :picl/tests) 57 | (fiveam:run! 'picl/tests:suite) 58 | ``` 59 | 60 | ### Concepts and How-To 61 | 62 | An "iterator" in PICL is simply a 63 | [thunk](https://wiki.c2.com/?ProcedureWithNoArguments) producing two values: the 64 | payload and the alive-indicator. The alive-indicator should be truthy until 65 | *after* the iterator is consumed. 66 | 67 | By example 68 | 69 | ```common-lisp 70 | (let ((it (make-iterator '(1 2)))) 71 | (next it) ;; (values 1 t) 72 | (next it) ;; (values 2 t) 73 | (next it)) ;; (values nil nil) 74 | ``` 75 | After returning `nil`, all further `next` calls should also produce `nil` as 76 | quickly as possible. Furthermore when the alive indicator is `nil`, the payload 77 | should be ignored. 78 | 79 | To create iterators over your own objects, specialize the `make-iterator` 80 | generic function appropriately. For instance, the `make-iterator` definition for 81 | lists is 82 | 83 | ``` common-lisp 84 | (defmethod make-iterator ((obj list)) 85 | (lambda () 86 | (if obj 87 | (values (prog1 (car obj) (setf obj (cdr obj))) t) 88 | (values nil nil)))) 89 | ``` 90 | Specializations for lists and vectors are predefined. A universal `in-it` 91 | driver is also provided for [Iterate](https://common-lisp.net/project/iterate/) 92 | through the `picl/iterate` system. 93 | 94 | ``` common-lisp 95 | (ql:quickload '(:picl :picl/iterate)) 96 | ;; The "iterate" package has been :use'd here 97 | (iterate 98 | (for i in-it (picl:permutations '(1 2 3))) 99 | (collect i)) 100 | ;; (#(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)) 101 | ``` 102 | *Note:* All of the combinatoric iterators produce vectors, which can be 103 | annoying because those are second-class citizens in CL (you can't destructure 104 | them, for instance). To get around this, you can wrap the iterator in 105 | `(picl:map #'iter-to-list <>)` 106 | 107 | ``` common-lisp 108 | (picl:iter-to-list (picl:map #'picl:iter-to-list (picl:permutations '(1 2 3)))) 109 | ;; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) 110 | ``` 111 | It's a bit clunky for sure, so in the future I might extend the `in-it` 112 | clause to perform conversions like this when specified 113 | 114 | ### Future Work 115 | Functions still missing from Python's itertools (due to laziness: if you need 116 | these drop an issue/PR and I'll get around to implementing them) 117 | - [groupby](https://docs.python.org/3.8/library/itertools.html#itertools.groupby) 118 | - [accumulate](https://docs.python.org/3.8/library/itertools.html#itertools.accumulate) 119 | 120 | Extensions to library 121 | - Port the more-itertools recipes found at bottom of the Python itertools 122 | package 123 | - Port the [more-iterools](https://pypi.org/project/more-itertools/) package 124 | (seems like a big job) 125 | - Some sort of integration with [fset](https://common-lisp.net/project/fset/)'s 126 | sequence type? 127 | 128 | ## License 129 | 130 | This project is provided under the MIT License (see LICENSE.md) 131 | -------------------------------------------------------------------------------- /picl.asd: -------------------------------------------------------------------------------- 1 | ;;;; picl.asd 2 | 3 | (asdf:defsystem #:picl 4 | :description "Python Itertools in Common Lisp" 5 | :author "Anish Moorthy " 6 | :homepage "https://anlsh.github.io/picl/" 7 | :license "MIT" 8 | :version "1.0.1" 9 | :serial t 10 | :depends-on (#:defclass-std #:alexandria) 11 | :components 12 | ((:module "src" 13 | :components ((:file "package") 14 | (:file "interface" :depends-on ("package")) 15 | (:file "default-iterators" :depends-on ("interface")) 16 | (:file "utils" :depends-on ("interface")) 17 | (:file "itertools" :depends-on ("utils")) 18 | (:file "combinatoric" :depends-on ("utils"))))) 19 | :in-order-to ((test-op (test-op #:picl/tests)))) 20 | 21 | 22 | (asdf:defsystem #:picl/iterate 23 | :description "Iterate driver for PICL" 24 | :serial t 25 | :depends-on (#:picl #:alexandria #:iterate) 26 | :components 27 | ((:module "src" 28 | :components ((:file "iterate-driver"))))) 29 | 30 | ;; Tests 31 | (asdf:defsystem #:picl/tests 32 | :description "Tests for PICL" 33 | :serial t 34 | :depends-on (#:picl #:picl/iterate #:fiveam #:generic-cl #:alexandria #:iterate) 35 | :components 36 | ((:module "tests" 37 | :components ((:file "package") 38 | (:file "test-itertools" :depends-on ("package")) 39 | (:file "test-combinatoric" :depends-on ("package"))))) 40 | :perform (test-op (op system) 41 | (funcall (read-from-string "fiveam:run!") 42 | (read-from-string "picl/tests:suite")))) 43 | -------------------------------------------------------------------------------- /src/combinatoric.lisp: -------------------------------------------------------------------------------- 1 | ;; The source code for all of these is translated from the example 2 | ;; implementations from Python's Standard library 3 | ;; https://docs.python.org/3.9/library/itertools.html 4 | 5 | (in-package :picl) 6 | 7 | (def-iter iterator-product (item-vec indices lengths stopped) 8 | 9 | (product (&rest iterables) 10 | "Cartesian product of input iterables, returned as vectors in lexicographic order. 11 | 12 | Due to the awkwardness in mixing `&rest` and `&key` parameters in lambda lists, this function 13 | does not implement the `repeat` argument supported in 14 | [Python's version](https://docs.python.org/3/library/itertools.html#itertools.product). 15 | Use `picl:nfold-product` instead. 16 | 17 | ``` 18 | (product '(1 2) '(3 4)) 19 | ;; #(1 3), #(1 4), #(2 3), #(2 4) 20 | ```" 21 | (loop with item-vec = (make-array (length iterables)) 22 | with lengths = (make-array (length iterables)) 23 | for i below (length item-vec) 24 | for iter in iterables 25 | do (setf (aref item-vec i) (iter-to-vec iter)) 26 | (setf (aref lengths i) (length (aref item-vec i))) 27 | minimizing (aref lengths i) into min-len 28 | finally 29 | (return (if (zerop min-len) 30 | (empty-iterator) 31 | (init-state item-vec 32 | lengths 33 | (indices (make-array (length item-vec) 34 | :initial-element 0))))))) 35 | (if stopped 36 | (values nil nil) 37 | (multiple-value-prog1 38 | (loop with product = (make-array (length indices)) 39 | for i below (length indices) 40 | for ii = (aref indices i) 41 | do (setf (aref product i) (aref (aref item-vec i) ii)) 42 | finally (return (values product t))) 43 | (labels ((next-combo (i) 44 | (if (< i 0) 45 | (setf stopped t) 46 | (progn 47 | (incf (aref indices i)) 48 | (when (>= (aref indices i) (aref lengths i)) 49 | (setf (aref indices i) 0) 50 | (next-combo (1- i))))))) 51 | (next-combo (1- (length indices))))))) 52 | 53 | (def-iter iterator-nfold-product (iterable-length product-length item-vec indices stopped) 54 | (nfold-product (n iterable) 55 | "Computes the n-fold Cartesian product of an iterable with itself. 56 | 57 | Essentially equivalent to `(apply #'product (iter-to-list (tee n iterable))`, but with 58 | much better memory usage 59 | 60 | ``` 61 | (nfold-product 3 '(1 2)) 62 | ;; #(1 1 1), #(1 1 2), #(1 2 1), #(1 2 2), #(2 1 1), #(2 1 2), #(2 2 1), #(2 2 2) 63 | ``` 64 | " 65 | (let* ((item-vec (iter-to-vec iterable)) 66 | (iterable-length (length item-vec))) 67 | (if (zerop iterable-length) 68 | (empty-iterator) 69 | (init-state iterable-length item-vec (product-length n) 70 | (indices (make-array n :initial-element 0)))))) 71 | (if stopped 72 | (values nil nil) 73 | (multiple-value-prog1 74 | (loop with product = (make-array product-length) 75 | for i below product-length 76 | for ii = (aref indices i) 77 | do (setf (aref product i) (aref item-vec ii)) 78 | finally (return (values product t))) 79 | (labels ((next-combo (i) 80 | (if (< i 0) 81 | (setf stopped t) 82 | (progn 83 | (incf (aref indices i)) 84 | (when (>= (aref indices i) iterable-length) 85 | (setf (aref indices i) 0) 86 | (next-combo (1- i))))))) 87 | (next-combo (1- product-length)))))) 88 | 89 | ;; Permutations 90 | 91 | (def-iter iterator-permutations (r n pool indices stopped cycles) 92 | 93 | (permutations (s0 &optional (s1 'no-arg)) 94 | "`r`-permutations of input iterable, returned as vectors in lexicographic order. 95 | 96 | When a single argument is given, it should be an iterable and `r` will default to its length. 97 | 98 | When two arguments are given, the first corresponds to `r` and the second to the iterable 99 | 100 | 101 | ``` 102 | (permutations '(1 2 3)) 103 | ;; #(1 2 3), #(1 3 2), #(2 1 3), #(2 3 1), #(3 1 2), #(3 2 1) 104 | (permutations 2 '(1 2 3)) 105 | ;; #(1 2), #(1 3), #(2 1), #(2 3), #(3 1), #(3 2) 106 | ```" 107 | (labels ((helper (ivec r) 108 | (let ((n (length ivec))) 109 | (if (> r n) 110 | (empty-iterator) 111 | (init-state r n (pool ivec) 112 | (indices (iter-to-vec (range 0 (length ivec) 1))) 113 | (cycles (iter-to-vec (range n (- n r) -1)))))))) 114 | (if (equalp s1 'no-arg) 115 | (let* ((ivec (iter-to-vec s0)) 116 | (r (length ivec))) 117 | (helper ivec r)) 118 | (let* ((ivec (iter-to-vec s1)) 119 | (r s0)) 120 | (helper ivec r))))) 121 | 122 | (if stopped 123 | (values nil nil) 124 | (multiple-value-prog1 125 | (loop with ret = (make-array r) 126 | for i below r 127 | do (setf (aref ret i) (aref pool (aref indices i))) 128 | finally (return (values ret t))) 129 | (loop for i from (1- r) downto 0 130 | do (decf (aref cycles i)) 131 | (if (zerop (aref cycles i)) 132 | (progn (loop with curr = (aref indices i) 133 | for j from i below (1- n) 134 | do (setf (aref indices j) (aref indices (1+ j))) 135 | finally (setf (aref indices (1- n)) curr)) 136 | (setf (aref cycles i) (- n i))) 137 | (let ((j (aref cycles i))) 138 | (rotatef (aref indices i) (aref indices (- n j))) 139 | (return))) 140 | finally (setf stopped t))))) 141 | 142 | ;; Combinations 143 | (def-iter iterator-combinations (indices pool stopped r n) 144 | 145 | (combinations (r iterable) 146 | "r-combinations of input iterable, returned as vectors in lexicographic order. 147 | 148 | ``` 149 | (combinations 2 '(1 2 3)) 150 | ;; #(1 2), #(1 3), #(2 3) 151 | ```" 152 | (let ((ivec (iter-to-vec iterable))) 153 | (if (> r (length ivec)) 154 | (empty-iterator) 155 | (init-state r (n (length ivec)) (pool ivec) 156 | (indices (iter-to-vec (range 0 r 1))))))) 157 | 158 | (if stopped 159 | (values nil nil) 160 | (multiple-value-prog1 161 | (loop with ret-vec = (make-array r) 162 | for i below r 163 | do (setf (aref ret-vec i) (aref pool (aref indices i))) 164 | finally (return (values ret-vec t))) 165 | (loop for i from (1- r) downto 0 166 | when (/= (aref indices i) (+ i n (- r))) 167 | do (incf (aref indices i)) 168 | (loop for j from (1+ i) to (1- r) 169 | do (setf (aref indices j) (1+ (aref indices (1- j))))) 170 | (return) 171 | finally (setf stopped t))))) 172 | 173 | (def-iter iterator-combinations-with-rep (indices pool stopped r n) 174 | 175 | (combinations-with-rep (r iterable) 176 | "r-combinations with replacement of input iterable, returned as vectors in lexicographic 177 | order 178 | 179 | ``` 180 | (combinations 2 '(1 2 3)) 181 | ;; #(1 1), #(1 2), #(1 3), #(2 1), #(2 2), #(2 3), #(3 1), #(3 2), #(3 3) 182 | ```" 183 | (let ((pool (iter-to-vec iterable))) 184 | (init-state r 185 | (n (length pool)) 186 | (pool pool) 187 | (indices (iter-to-vec (repeat r 0)))))) 188 | 189 | (if stopped 190 | (values nil nil) 191 | (multiple-value-prog1 192 | (loop with ret-vec = (make-array r) 193 | for i below r 194 | do (setf (aref ret-vec i) (aref pool (aref indices i))) 195 | finally (return (values ret-vec t))) 196 | (loop for i from (1- r) downto 0 197 | when (/= (aref indices i) (1- n)) 198 | do 199 | (loop for j from i below r 200 | with el = (1+ (aref indices i)) 201 | do (setf (aref indices j) el)) 202 | (return) 203 | finally (setf stopped t))))) 204 | -------------------------------------------------------------------------------- /src/default-iterators.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl) 2 | 3 | (defmethod make-iterator ((obj list)) 4 | "Returns an iterator which traverses elements of a list in sequential order" 5 | (lambda () 6 | (if obj 7 | (values (prog1 (car obj) (setf obj (cdr obj))) t) 8 | (values nil nil)))) 9 | 10 | (defmethod make-iterator ((obj vector)) 11 | "Returns an iterator which traverses elements of a vector in sequential order" 12 | (let ((curr 0) 13 | (length (length obj))) 14 | (lambda () 15 | (if (< curr length) 16 | (values (prog1 (aref obj curr) (incf curr)) t) 17 | (values nil nil))))) 18 | -------------------------------------------------------------------------------- /src/interface.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl) 2 | 3 | (defgeneric make-iterator (iterable) 4 | (:documentation 5 | "Creates an iterator from `iterable`: an iterator is simply anything which can be passed 6 | as an argument to `next`")) 7 | 8 | (defmethod make-iterator ((obj function)) 9 | obj) 10 | 11 | (defun next (iterator) 12 | "Produces two values, the payload and the alive-indicator 13 | 14 | While iterator is not yet exhausted, calling next will yield its next item and a 15 | truthy alive-indicator 16 | 17 | After iterator has been exhausted all further calls should yield an alive-indicator 18 | of nil, and the payload should be ignored by the callee" 19 | (funcall iterator)) 20 | 21 | 22 | (defmacro def-iter (name state-vars (constructor-name constructor-params &body constructor-body) 23 | &body next-body) 24 | "An anaphoric convenience macro which can be re-implemented to change how iterators are 25 | structured. Exposes the local `init-state` macro within `constructor-body` 26 | 27 | If you don't want to-use this macro (which I totally understand) just write constructors for your 28 | iterators returning 0-argument closures representing the `next` function and you'll be fine. This 29 | macro just helped me get through a lot of waffling during development 30 | 31 | Parameters 32 | ---------- 33 | `name` is a synbol naming the iterator's backing state. However it's actually 34 | ignored, since PICL doesn't currently expose iterators' backing state 35 | 36 | `state-vars` is a list of symbols naming the iterator's state variables. 37 | 38 | The `constructor-name/params/body` will be `defun`'d to create the user-facing constructor 39 | function. In `constructor-body`, the return value should be an iterator or a call to local 40 | `init-state` macro 41 | 42 | `next-body` The definition of the `next` function for this iterator, which will be run in a 43 | lexical environment consisting of the state vars 44 | 45 | Both `constructor-body` and `next-body` are defined in the lexical environment of the `def-iter` 46 | form, and as such can access any lexical bindings not shadowed by the `constructor-params` and 47 | `state-vars` respectively 48 | 49 | The local `init-state` macro. 50 | ---------------------------- 51 | The arguments to `init-state` should be of the form `(statevar-symbol value-form)`or 52 | `statevar-symbol`. In the first case, the value of `value-form` will be used to initialize the 53 | state variable named by `symbol`. In the second case, `statevar-symbol` is also used as the 54 | corresponding `value-form` 55 | 56 | Example 57 | ------- 58 | What follows is a sample implementation of the `count` iterator using this macro 59 | ``` 60 | (def-iter ignored-backing-name (curr-val step) 61 | (count (start step) 62 | (init-state (curr-val start) step)) 63 | (prog1 curr-val (incf curr-val step)))) 64 | ````" 65 | 66 | (declare (ignore name)) 67 | (alexandria:with-gensyms (next-fname) 68 | (let ((docstring "Function had no docstring, so this one was inserted")) 69 | (when (and (cdr constructor-body) (stringp (car constructor-body))) 70 | (setf docstring (car constructor-body) 71 | constructor-body (cdr constructor-body))) 72 | `(labels ((,next-fname (&key ,@state-vars) 73 | (labels ((self () ,@next-body)) #'self))) 74 | (defun ,constructor-name ,constructor-params 75 | ,docstring 76 | (macrolet 77 | ((init-state (&rest argspecs) 78 | (list 'apply '#',next-fname 79 | (apply #'append 80 | '(list ) 81 | (mapcar (lambda (aspec) 82 | (if (symbolp aspec) 83 | (list (alx:make-keyword aspec) aspec) 84 | (destructuring-bind (aname adef) aspec 85 | (list (alx:make-keyword aname) adef)))) 86 | argspecs))))) 87 | ,@constructor-body)))))) 88 | -------------------------------------------------------------------------------- /src/iterate-driver.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:picl/iterate 2 | (:use #:cl)) 3 | 4 | (in-package :picl/iterate) 5 | 6 | (iterate:defmacro-driver (iterate:FOR var IN-IT iterable) 7 | ;; Example usage 8 | ;; (iterate:iter (iterate:for i in-it (picl-iterate:permutations '(1 2 3))) (print i)) 9 | (alexandria:with-gensyms (g curr alive) 10 | (let ((kwd (if iterate:generate 'iterate:generate 'iterate:for))) 11 | `(progn 12 | (iterate:with ,g = (picl:make-iterator ,iterable)) 13 | (,kwd ,var next (multiple-value-bind (,curr ,alive) (funcall #'picl:next ,g) 14 | (if ,alive ,curr (iterate:terminate)))))))) 15 | -------------------------------------------------------------------------------- /src/itertools.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl) 2 | 3 | 4 | (def-iter iterator-count (curr step) 5 | (count (&optional (start 0) (step 1)) 6 | "Yields the elements `start, start + 1*step, start + 2*step, etc 7 | 8 | ``` 9 | (count 2 4) 10 | ;; 2, 6, 10, 14, etc 11 | ```" 12 | (init-state (curr start) step)) 13 | 14 | (values (prog1 curr (incf curr step)) t)) 15 | 16 | 17 | (def-iter iterator-range (curr stop step) 18 | (range (s0 &optional s1 (step 1)) 19 | "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) 20 | but produces an iterator (as defined by PICL) instead of a Python-esque range object 21 | 22 | ``` 23 | (range 5) 24 | ;; 0, 1, 2, 3, 4 25 | (range 2 5) 26 | ;; 2, 3, 4 27 | (range -2) 28 | ;; 0, -1 29 | (range 1 7 2) 30 | ;; 1, 3, 5 31 | ```" 32 | (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step)) 33 | 34 | (if (or (and (> step 0) (< curr stop)) 35 | (and (< step 0) (> curr stop))) 36 | (values (prog1 curr (incf curr step)) t) 37 | (values nil nil))) 38 | 39 | 40 | (def-iter iterator-enumerate (iterator curr) 41 | (enumerate (iterable &optional (curr 0)) 42 | "Yield two-element lists of indices (beginning at curr) and their corresponding elements in 43 | `iterable` 44 | 45 | ``` 46 | (enumerate '(a b c d)) 47 | ;; (0 a), (1 b), (2 c), (3 d) 48 | (enumerate '(a b c d) 3) 49 | ;; (3 a), (4 b), (5 c), (6 d) 50 | ```" 51 | (init-state (iterator (make-iterator iterable)) curr)) 52 | (multiple-value-bind (item alive) (next iterator) 53 | (if alive 54 | (multiple-value-prog1 55 | (values (list curr item) t) 56 | (incf curr)) 57 | (values nil nil)))) 58 | 59 | (def-iter iterator-repeat (max curr item) 60 | 61 | (repeat (s0 &optional s1) 62 | "If a single argument is given, yields `s0` repeatedly forever 63 | 64 | If two arguments are given, then yields `s1` `s0` times 65 | 66 | ``` 67 | (repeat t) 68 | ;; t, t, etc 69 | (repeat 4 t) 70 | ;; t, t, t, t 71 | ```" 72 | (init-state (item (or s1 s0)) 73 | (max (and s1 s0)) 74 | (curr 0))) 75 | 76 | (if max 77 | (if (< curr max) 78 | (values (progn (incf curr) item) t) 79 | (values nil nil)) 80 | (values item t))) 81 | 82 | 83 | (def-iter iterator-cycle (base-iter stopped results tail) 84 | 85 | (cycle (iterable) 86 | "Continually yields the elements of its argument in order, starting over when the end is 87 | reached 88 | 89 | If the base iterator is empty, the result of iterator-cycle will be too 90 | 91 | ``` 92 | (cycle '(1 2 3 4)) 93 | ;; 1, 2, 3, 4, 1, 2, 3, 4, etc 94 | (iter-to-list (cycle '())) 95 | ;; nil 96 | ```" 97 | (init-state (base-iter (make-iterator iterable)))) 98 | 99 | (if stopped 100 | (values (prog1 (car tail) (setf tail (or (cdr tail) results))) 101 | t) 102 | (multiple-value-bind (next-item base-alive) (next base-iter) 103 | (if base-alive 104 | (values (progn (push next-item results) (car results)) t) 105 | (if results 106 | (progn (setf base-iter nil 107 | stopped t 108 | results (nreverse results) 109 | tail results) 110 | (self)) 111 | (values nil nil)))))) 112 | 113 | 114 | (def-iter iterator-chain-from-iter (curr-iter itail) 115 | 116 | (chain-from-iter (iterable-of-iterables) 117 | "Yields the elements of the first iterable in `iterable`, then the second, etc. 118 | 119 | Equivalent to python's chain.from_iterable(), and conceptually equivalent to 120 | `(picl:apply #'picl:chain iterable-of-iterables)`. 121 | 122 | ``` 123 | (chain-from-iter (picl:map (lambda (x) (picl:range x))) (picl:count)) 124 | ;; 0, 0, 1, 0, 1, 2, 0, 1, 2, 3, etc 125 | ```" 126 | (let ((iterable-of-iterables (make-iterator iterable-of-iterables))) 127 | (multiple-value-bind (curr-iter its-alive) (next iterable-of-iterables) 128 | (if its-alive 129 | (init-state (curr-iter (make-iterator curr-iter)) 130 | (itail iterable-of-iterables)) 131 | (empty-iterator))))) 132 | 133 | (multiple-value-bind (curr-item curr-alive) (next curr-iter) 134 | (if curr-alive 135 | (values curr-item t) 136 | (progn (multiple-value-bind (next-iter itail-alive) (next itail) 137 | (if itail-alive 138 | (progn (setf curr-iter (make-iterator next-iter)) 139 | (self)) 140 | (values nil nil))))))) 141 | 142 | (defun chain (&rest iterables) 143 | "Yields the elements of the first iterable in `iterable`, then the second, etc. 144 | 145 | ``` 146 | (chain '(1 2 3) '(4 5 6) (count 7)) 147 | ;; 1, 2, 3, 4, 5, 6, 7 etc 148 | ```" 149 | (chain-from-iter iterables)) 150 | 151 | 152 | (def-iter iterator-zip (iterator-vec n) 153 | 154 | (zip-from-itl (itl-of-itls) 155 | (let* ((itl-of-itls (iter-to-vec itl-of-itls)) 156 | (n (length itl-of-itls))) 157 | (loop for i below n 158 | do (setf (aref itl-of-itls i) 159 | (make-iterator (aref itl-of-itls i)))) 160 | (if (zerop n) 161 | (empty-iterator) 162 | (init-state (iterator-vec itl-of-itls) n)))) 163 | 164 | (loop with alive = t 165 | for i below n 166 | with ret-vec = (make-array n) 167 | while alive 168 | do 169 | (multiple-value-bind (iter-item iter-alive) (next (aref iterator-vec i)) 170 | (setf alive iter-alive) 171 | (setf (aref ret-vec i) iter-item)) 172 | finally (return (if alive 173 | (values ret-vec t) 174 | (values nil nil))))) 175 | 176 | (defun zip (&rest iterables) 177 | "Returns vectors consisting of the first elements from each iterable in `iterable`, then the 178 | second, etc until one is consumed 179 | 180 | ``` 181 | (zip '(1 2 3) '(a b c d)) 182 | ;; #(1 a). #(2 b), #(3 c) 183 | ```" 184 | (zip-from-itl iterables)) 185 | 186 | 187 | (def-iter iterator-zip-longest (iterator-vec fill-item n num-active active-vec) 188 | 189 | (zip-longest-from-itl (itl-of-itls &optional fill-item) 190 | (let* ((itl-of-itls (iter-to-vec itl-of-itls)) 191 | (num-active (length itl-of-itls))) 192 | (loop for i below num-active 193 | do (setf (aref itl-of-itls i) 194 | (make-iterator (aref itl-of-itls i)))) 195 | (if (zerop num-active) 196 | (empty-iterator) 197 | (init-state (iterator-vec itl-of-itls) (n num-active) num-active fill-item 198 | ;; TODO Maybe this should be a vit vector? 199 | (active-vec (make-array num-active :initial-element t)))))) 200 | 201 | (loop for i below n 202 | with ret-vec = (make-array n) 203 | do (if (aref active-vec i) 204 | (multiple-value-bind (iter-item iter-alive) (next (aref iterator-vec i)) 205 | (if iter-alive 206 | (setf (aref ret-vec i) iter-item) 207 | (progn (decf num-active) 208 | (setf (aref active-vec i) nil) 209 | (setf (aref ret-vec i) fill-item)))) 210 | (setf (aref ret-vec i) fill-item)) 211 | finally (return (if (zerop num-active) 212 | (values nil nil) 213 | (values ret-vec t))))) 214 | 215 | (defun zip-longest (fill-item &rest iterables) 216 | "Returns vectors consisting of the first elements from each iterable in `iterable`, then the 217 | second, etc until *all* are consumed. Once a constituent iterable has been exhausted, 218 | `fill-value` is used to pad the vector in its place. 219 | 220 | ``` 221 | (zip nil '(1 2 3) '(a b c d)) 222 | ;; #(1 a). #(2 b), #(3 c), #(nil d) 223 | ```" 224 | (zip-longest-from-itl iterables fill-item)) 225 | 226 | 227 | (def-iter iterator-compress (base-iter bool-iter) 228 | 229 | (compress (base-iterable bool-iterable) 230 | "Yields elements of `base-iterable` while the corresponding element in `bool-iterable` 231 | is truthy. 232 | 233 | Stops when either of its arguments is consumed 234 | 235 | ``` 236 | (iterator-compress (count) (t nil t nil t nil)) 237 | ;; 0 2 4 238 | ```" 239 | (init-state (base-iter (make-iterator base-iterable)) 240 | (bool-iter (make-iterator bool-iterable)))) 241 | 242 | (multiple-value-bind (curr-item curr-alive) (next base-iter) 243 | (multiple-value-bind (bool-item bool-alive) (next bool-iter) 244 | (if (and curr-alive bool-alive) 245 | (if bool-item 246 | (values curr-item t) 247 | (self)) 248 | (values nil nil))))) 249 | 250 | 251 | (def-iter iterator-dropwhile (base-iter pred been-false) 252 | 253 | (dropwhile (predicate iterable) 254 | "Drops all elements of `base-iter` until `pred` first returns false, then yields all further 255 | elements 256 | 257 | ``` 258 | (dropwhile (lambda (x) (< 3 x) (count))) 259 | ;; 3, 4, 5, etc 260 | ```" 261 | (init-state (pred predicate) (base-iter (make-iterator iterable)))) 262 | 263 | (if been-false 264 | (next base-iter) 265 | (multiple-value-bind (item base-alive) (next base-iter) 266 | (if base-alive 267 | (if (funcall pred item) 268 | (self) 269 | (progn (setf been-false t) 270 | (values item t))) 271 | (values nil nil))))) 272 | 273 | 274 | (def-iter iterator-filter (base-iter pred) 275 | 276 | (filter (predicate iterable) 277 | "Yields elements of `iterable` for which `predicate` returns true 278 | 279 | ``` 280 | (filter (lambda (x) (evenp x) (count))) 281 | ;; 0, 2, 4, etc 282 | ```" 283 | (init-state (pred predicate) (base-iter (make-iterator iterable)))) 284 | 285 | (multiple-value-bind (base-item base-alive) (next base-iter) 286 | (if base-alive 287 | (if (funcall pred base-item) 288 | (values base-item t) 289 | (self)) 290 | (values nil nil)))) 291 | 292 | (defun filterfalse (predicate iterable) 293 | 294 | "Yields elements of `iterable` for which `predicate` returns false 295 | 296 | ``` 297 | (filterfalse (lambda (x) (evenp x) (count))) 298 | ;; 1, 3, 5, etc 299 | ```" 300 | (filter (lambda (x) (not (funcall predicate x))) iterable)) 301 | 302 | 303 | (def-iter iterator-starmap (base-iter fn) 304 | 305 | (starmap (fn iterable-of-iterables) 306 | "Applies `fn` to the first argument of `iterable-of-iterables`, then the second, etc 307 | 308 | ``` 309 | (starmap #'+ '(1 2) '(3 4)) 310 | ;; 3, 7 311 | ```" 312 | (init-state (base-iter (make-iterator iterable-of-iterables)) fn)) 313 | 314 | (multiple-value-bind (base-item base-alive) (next base-iter) 315 | (if base-alive 316 | (values (apply fn (iter-to-list base-item)) t) 317 | (values nil nil)))) 318 | 319 | (defun map (predicate &rest iterables) 320 | "Applies `fn` to the first elements of each iterable in `iterables`, then to the seconds, etc 321 | 322 | ``` 323 | (map #'+ '(1 2) '(3 4)) 324 | ;; 4, 6 325 | ```" 326 | (starmap predicate (apply #'zip iterables))) 327 | 328 | (def-iter iterator-takewhile (base-iter pred been-false) 329 | 330 | (takewhile (predicate iterable) 331 | "Yields elements of `iterable` for which `predicate` is truthy, terminating once it 332 | first returns nil 333 | 334 | ``` 335 | (takewhile (lambda (x) (< 3 x) (count))) 336 | ;; 0, 1, 2 337 | ```" 338 | (init-state (pred predicate) (base-iter (make-iterator iterable)))) 339 | 340 | (if been-false 341 | (values nil nil) 342 | (multiple-value-bind (base-item base-alive) (next base-iter) 343 | (if base-alive 344 | (values base-item (funcall pred base-item)) 345 | (values nil nil))))) 346 | 347 | 348 | (def-iter iterator-islice (base-iter start stop delta curr) 349 | 350 | (islice (iterable start stop delta) 351 | "Works like Python's 352 | [islice](https://docs.python.org/3.8/library/itertools.html#itertools.islice)" 353 | (unless (and (>= start 0) (>= stop 0) (> delta 0)) 354 | (error (format nil "Args must all be positive~%"))) 355 | (init-state (base-iter (make-iterator iterable)) 356 | start stop delta 357 | (curr 0))) 358 | 359 | (if (< curr start) 360 | (progn (loop for _ below start 361 | for (__ base-alive) = (multiple-value-list (next base-iter)) 362 | when (not base-alive) 363 | do (return-from self (values nil nil)) 364 | do (incf curr)) 365 | (when (< curr stop) 366 | (incf curr) 367 | (next base-iter))) 368 | (loop with base-item 369 | with base-alive = t 370 | 371 | for i below delta 372 | do 373 | (when (or (not base-alive) (>= curr stop)) 374 | (return (values nil nil))) 375 | (multiple-value-setq (base-item base-alive) 376 | (next base-iter)) 377 | (incf curr) 378 | finally (return-from self (values base-item t))))) 379 | 380 | 381 | (def-iter iterator-tee-item (q base-iter) 382 | 383 | (tee-item (iterable q) 384 | (init-state (base-iter (make-iterator iterable)) q)) 385 | 386 | (if (null (cdr q)) 387 | (multiple-value-bind (base-item base-alive) (next base-iter) 388 | (if base-alive 389 | (progn (setf (cdr q) (list base-item))) 390 | (return-from self (values nil nil))))) 391 | (setf q (cdr q)) (values (car q) t)) 392 | 393 | (defun tee (n iterable) 394 | "Returns a vector of `n` independent copies of `iterable`. `iterable` itself should not be used 395 | after it has been passed to `tee`, otherwise the tees will not be properly updated 396 | 397 | If the base iterable is large be careful not to advance any copy too far ahead of the others, 398 | so as to avoid memory issues 399 | 400 | ``` 401 | tees = (tee 2 '(1 2 3 4)) 402 | ;; tees[0] => 1, 2, 3, 4 403 | ;; tees[1] => 1, 2, 3, 4 404 | ```" 405 | (let ((base-iter (make-iterator iterable)) 406 | (q (cons nil nil))) 407 | (loop with tees = (make-array n) 408 | for i below n 409 | do (setf (aref tees i) (tee-item base-iter q)) 410 | finally (return tees)))) 411 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:picl 4 | (:use #:cl) 5 | (:local-nicknames (#:alx #:alexandria) (#:dcl #:defclass-std)) 6 | (:shadow #:map #:count #:apply) 7 | (:export 8 | ;; Interface 9 | #:make-iterator 10 | #:next 11 | 12 | ;; Itertools 13 | #:chain 14 | #:chain-from-iter 15 | #:combinations 16 | #:combinations-with-rep 17 | #:compress 18 | #:count 19 | #:cycle 20 | #:dropwhile 21 | #:empty-iterator 22 | #:empty-iterator 23 | #:enumerate 24 | #:filter 25 | #:filterfalse 26 | #:islice 27 | #:iter-to-list 28 | #:iter-to-vec 29 | #:map 30 | #:nfold-product 31 | #:permutations 32 | #:product 33 | #:range 34 | #:repeat 35 | #:starmap 36 | #:take 37 | #:takewhile 38 | #:tee 39 | #:zip 40 | #:zip-longest 41 | 42 | ;; Random other utils 43 | #:apply 44 | #:always 45 | #:never)) 46 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl) 2 | 3 | ;; Utilities 4 | (defun iter-to-list (iterable) 5 | "Reads `iterable` into a list 6 | 7 | ``` 8 | (iter-to-list (range 4)) 9 | ;; (0 1 2 3) 10 | (iter-to-list (count)) 11 | ;; Out of memory error! 12 | ```" 13 | (loop with iterator = (make-iterator iterable) 14 | collecting (multiple-value-bind (payload alive?) (next iterator) 15 | (if alive? payload (return result))) 16 | into result)) 17 | 18 | (defun iter-to-vec (iterable) 19 | "Reads `iterable` into a vector 20 | 21 | ``` 22 | (iter-to-list (range 4)) 23 | ;; #(0 1 2 3) 24 | (iter-to-list (count)) 25 | ;; Out of memory error! 26 | ```" 27 | (let ((ls (iter-to-list iterable))) 28 | (make-array (length ls) :initial-contents ls))) 29 | 30 | (defun empty-iterator () 31 | "Returns an empty iterator 32 | 33 | ``` 34 | (iter-to-list (empty-iterator)) 35 | ;; nil 36 | ```" 37 | (make-iterator nil)) 38 | 39 | (defun take (n iterable) 40 | "Returns a list consisting of the first `n` (or fewer, if the iterator runs out) items of iterable 41 | 42 | ``` 43 | (take 5 (count)) 44 | ;; (0 1 2 3 4) 45 | take 30 (range 4) 46 | ;; (0 1 2 3) 47 | ```" 48 | (loop with iterator = (make-iterator iterable) 49 | for i below n 50 | for (base-item base-alive) = (multiple-value-list (next iterator)) 51 | while base-alive 52 | collecting base-item into ls 53 | finally (return ls))) 54 | 55 | (defun always (iterable) 56 | "Truthy iff every element of the argument is truthy 57 | 58 | ``` 59 | (always '(1 2 3)) 60 | ;; t 61 | (always '(nil)) 62 | ;; nil 63 | (always nil) 64 | t 65 | ```" 66 | (labels ((always-helper (iterator) 67 | (multiple-value-bind (payload is-alive) (next iterator) 68 | (if is-alive 69 | (and payload (always-helper iterator)) 70 | t)))) 71 | (always-helper (make-iterator iterable)))) 72 | 73 | (defun never (iterable) 74 | "Truthy iff every element of the argument is nil 75 | 76 | ``` 77 | (never '(1 2 3)) 78 | ;; nil 79 | (never '(nil)) 80 | ;; t 81 | (never nil) 82 | t 83 | ```" 84 | (labels ((never-helper (iterator) 85 | (multiple-value-bind (payload is-alive) (next iterator) 86 | (if is-alive 87 | (and (not payload) (never-helper iterator)) 88 | t)))) 89 | (never-helper (make-iterator iterable)))) 90 | 91 | (defun apply (fn &rest args) 92 | "Like regular apply, except that the final argument can be an arbitrary 93 | iterable. 94 | 95 | ``` 96 | (picl:apply #'+ 1 #(2 3)) 97 | ;; 6 98 | ``` 99 | " 100 | (cl:apply fn (loop for (hd tl) on args 101 | appending (if tl (list hd) (picl:iter-to-list hd))))) 102 | -------------------------------------------------------------------------------- /staple.ext.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload :staple-markdown) 2 | 3 | (defclass my-page (staple:simple-page) ()) 4 | 5 | (defmethod staple:page-type ((system (eql (asdf:find-system :picl)))) 6 | 'my-page) 7 | 8 | (defmethod staple:packages ((system (eql (asdf:find-system :picl)))) 9 | (mapcar #'find-package '(:picl))) 10 | 11 | (defmethod staple:format-documentation ((docstring string) (page my-page)) 12 | (let ((*package* (first (staple:packages page)))) 13 | (staple:markup-code-snippets-ignoring-errors 14 | (staple:compile-source docstring :markdown)))) 15 | -------------------------------------------------------------------------------- /tests/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage picl/tests 2 | (:use :cl :picl) 3 | (:shadowing-import-from #:picl #:map #:count #:apply) 4 | (:local-nicknames (#:f #:fiveam) (#:gcl #:generic-cl) (#:alx #:alexandria)) 5 | (:export #:suite)) 6 | 7 | (in-package :picl/tests) 8 | (f:def-suite suite :description "Tests for Python Iterators in CL") 9 | 10 | (defun iter-makes (i0 i1) 11 | (f:is (equalp (iter-to-list (make-iterator i0)) 12 | (iter-to-list (make-iterator i1))))) 13 | -------------------------------------------------------------------------------- /tests/test-combinatoric.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl/tests) 2 | (f:in-suite suite) 3 | 4 | (defun lexic-lt (i l1 l2) 5 | (if (= i (length l1) (length l2)) 6 | t 7 | (if (= (aref l1 i) (aref l2 i)) 8 | (lexic-lt (1+ i) l1 l2) 9 | (< (aref l1 i) (aref l2 i))))) 10 | 11 | (defun enums-lexic (num-things thing-len ls) 12 | (loop with set = (gcl:make-hash-set) 13 | for l on ls 14 | do (if (gcl:memberp (car l) set) 15 | (return nil) 16 | (gcl:nadjoin (car l) set)) 17 | when (/= (length (car l)) thing-len) 18 | do (return nil) 19 | when (cdr l) 20 | do (unless (lexic-lt 0 (car l) (cadr l)) 21 | (return nil)) 22 | finally (return (= num-things (length (gcl:map-keys set)))))) 23 | 24 | ;; Algorithmic tests for the combinatorial iterators. These check to make sure 25 | ;; that the proper number of results are emitted and that they are in lexicographic 26 | ;; order (which is transitive, thankfully) 27 | ;; This *should* ensure that the functions function properly (at least on the input 28 | ;; sizes where we check). However in case there are any bugs, we also have hardcoded 29 | ;; tests below 30 | 31 | (f:def-test test/product () 32 | (f:is (loop with num-sets = 3 33 | for setsize below 6 34 | always (enums-lexic (expt setsize num-sets) num-sets 35 | (iter-to-list (apply #'product (loop for _ below num-sets 36 | collect (range 0 setsize))))))) 37 | (f:is (loop for num-sets from 1 below 6 38 | with setsize = 3 39 | always (enums-lexic (expt setsize num-sets) num-sets 40 | (iter-to-list (apply #'product (loop for _ below num-sets 41 | collect (range 0 setsize)))))))) 42 | 43 | (f:def-test test/nfold-product () 44 | (let ((n 3) 45 | (iter-size 4)) 46 | (f:is (enums-lexic (expt iter-size n) n 47 | (iter-to-list (nfold-product n (range iter-size))))))) 48 | 49 | (f:def-test test/permutations () 50 | (f:is (loop for n below 7 51 | always (enums-lexic (alx:factorial n) n 52 | (iter-to-list (permutations (range 0 n))))))) 53 | 54 | (f:def-test test/combinations () 55 | (f:is (loop for n below 7 56 | always 57 | (loop for r upto n 58 | always (enums-lexic (alx:binomial-coefficient n r) r 59 | (iter-to-list (combinations r (range 0 n)))))))) 60 | 61 | (f:def-test test/combinations-with-rep () 62 | (f:is (loop for n below 7 63 | always 64 | (loop for r upto n 65 | always (enums-lexic (if (zerop n) 1 66 | (alx:binomial-coefficient (+ n r -1) r)) 67 | r 68 | (iter-to-list (combinations-with-rep r (range 0 n)))))))) 69 | 70 | ;; Hardcoded tests for the combinatoric iterators. Readable, but quickly become gigantic 71 | ;; when n gets bigger. Therefore the above 72 | 73 | (f:def-test test/product/hardcoded () 74 | (let ((a (make-iterator '(1 2 3 4))) 75 | (b (make-iterator nil)) 76 | (c (make-iterator '(5 6 7 8)))) 77 | (f:is (iter-makes nil (product a b c))) 78 | (f:is (and (iter-makes nil a) (iter-makes nil b) (iter-makes nil c))) 79 | (f:is (iter-makes (list #(1)) 80 | (product '(1)))) 81 | (f:is (iter-makes (list #(1 2)) 82 | (product '(1) '(2)))) 83 | (f:is (iter-makes (list #(1 2) #(1 3)) 84 | (product '(1) '(2 3)))) 85 | (f:is (iter-makes (list #(1 3) #(2 3)) 86 | (product '(1 2) '(3)))) 87 | (f:is (iter-makes (list #(1 10 100) #(1 10 200) #(1 10 300) 88 | #(1 20 100) #(1 20 200) #(1 20 300) 89 | #(1 30 100) #(1 30 200) #(1 30 300) 90 | #(2 10 100) #(2 10 200) #(2 10 300) 91 | #(2 20 100) #(2 20 200) #(2 20 300) 92 | #(2 30 100) #(2 30 200) #(2 30 300) 93 | #(3 10 100) #(3 10 200) #(3 10 300) 94 | #(3 20 100) #(3 20 200) #(3 20 300) 95 | #(3 30 100) #(3 30 200) #(3 30 300)) 96 | (product '(1 2 3) '(10 20 30) '(100 200 300)))))) 97 | 98 | (f:def-test test/nfold-product/hardcoded () 99 | (f:is (iter-makes (nfold-product 0 '(1 2)) 100 | (list #()))) 101 | (f:is (iter-makes (nfold-product 7 nil) 102 | (empty-iterator))) 103 | (f:is (iter-makes (nfold-product 2 '(1 2)) 104 | (list #(1 1) #(1 2) #(2 1) #(2 2)))) 105 | (f:is (iter-makes (nfold-product 3 '(1 2)) 106 | (list #(1 1 1) #(1 1 2) #(1 2 1) #(1 2 2) #(2 1 1) #(2 1 2) #(2 2 1) #(2 2 2))))) 107 | 108 | (f:def-test test/permutations/hardcoded () 109 | (f:is (iter-makes (list #()) (permutations nil))) 110 | (f:is (iter-makes (list #(1)) (permutations '(1)))) 111 | (f:is (iter-makes (list #(1 2) #(2 1)) 112 | (permutations '(1 2)))) 113 | (f:is (iter-makes (list #(1 2 3) #(1 3 2) 114 | #(2 1 3) #(2 3 1) 115 | #(3 1 2) #(3 2 1)) 116 | (permutations '(1 2 3)))) 117 | (f:is (iter-makes (list #(1 2 3 4) #(1 2 4 3) #(1 3 2 4) #(1 3 4 2) #(1 4 2 3) #(1 4 3 2) 118 | #(2 1 3 4) #(2 1 4 3) #(2 3 1 4) #(2 3 4 1) #(2 4 1 3) #(2 4 3 1) 119 | #(3 1 2 4) #(3 1 4 2) #(3 2 1 4) #(3 2 4 1) #(3 4 1 2) #(3 4 2 1) 120 | #(4 1 2 3) #(4 1 3 2) #(4 2 1 3) #(4 2 3 1) #(4 3 1 2) #(4 3 2 1)) 121 | (permutations '(1 2 3 4)))) 122 | (let ((5p (iter-to-list (permutations '(1 2 3 4 5))))) 123 | (f:is (= (* 5 4 3 2 1) (length 5p))) 124 | (f:is (equalp #(5 4 3 2 1) (car (last 5p))))) 125 | (f:is (iter-makes (list #(1) #(2) #(3) #(4) #(5)) 126 | (permutations 1 '(1 2 3 4 5)))) 127 | (f:is (iter-makes (list #(1 2) #(1 3) #(1 4) 128 | #(2 1) #(2 3) #(2 4) 129 | #(3 1) #(3 2) #(3 4) 130 | #(4 1) #(4 2) #(4 3)) 131 | (permutations 2 '(1 2 3 4)))) 132 | (f:is (iter-makes (list #(1 2 3) #(1 2 4) #(1 3 2) #(1 3 4) #(1 4 2) #(1 4 3) 133 | #(2 1 3) #(2 1 4) #(2 3 1) #(2 3 4) #(2 4 1) #(2 4 3) 134 | #(3 1 2) #(3 1 4) #(3 2 1) #(3 2 4) #(3 4 1) #(3 4 2) 135 | #(4 1 2) #(4 1 3) #(4 2 1) #(4 2 3) #(4 3 1) #(4 3 2)) 136 | (permutations 3 '(1 2 3 4))))) 137 | 138 | (f:def-test test/combinations/hardcoded () 139 | (f:is (iter-makes (list #(1) #(2) #(3) #(4) #(5)) 140 | (combinations 1 '(1 2 3 4 5)))) 141 | (f:is (iter-makes (list #(1 2) #(1 3) #(1 4) #(1 5) 142 | #(2 3) #(2 4) #(2 5) 143 | #(3 4) #(3 5) 144 | #(4 5)) 145 | (combinations 2 '(1 2 3 4 5)))) 146 | (f:is (iter-makes (list #(1 2 3) #(1 2 4) #(1 2 5) #(1 3 4) #(1 3 5) #(1 4 5) 147 | #(2 3 4) #(2 3 5) #(2 4 5) 148 | #(3 4 5)) 149 | (combinations 3 '(1 2 3 4 5)))) 150 | (f:is (iter-makes (list #(1 2 3 4) #(1 2 3 5) #(1 2 4 5) #(1 3 4 5) 151 | #(2 3 4 5)) 152 | (combinations 4 '(1 2 3 4 5)))) 153 | (f:is (iter-makes (list #(1 2 3 4 5)) 154 | (combinations 5 '(1 2 3 4 5))))) 155 | -------------------------------------------------------------------------------- /tests/test-itertools.lisp: -------------------------------------------------------------------------------- 1 | (in-package :picl/tests) 2 | (f:in-suite suite) 3 | 4 | (f:def-test test/iterate-driver () 5 | (f:is (equalp (iterate:iter 6 | (iterate:for i in-it (permutations '(1 2 3))) 7 | (iterate:collect i)) 8 | (list #(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1))))) 9 | 10 | (f:def-test test/list-iterator () 11 | (let ((ls1 '(1 2 3 4))) 12 | (f:is (iter-makes ls1 ls1)) 13 | (f:is (iter-makes nil nil)))) 14 | 15 | (f:def-test test/vector-iterator () 16 | (f:is (iter-makes #(1 2 3 4 5) 17 | '(1 2 3 4 5))) 18 | (f:is (iter-makes #() nil))) 19 | 20 | (f:def-test test/empty-iterator () 21 | (f:is (iter-makes nil nil))) 22 | 23 | (f:def-test test/apply () 24 | (f:is (picl:apply #'+ 1 #(2 3)) 25 | 6)) 26 | 27 | (f:def-test test/enumerate () 28 | (f:is (iter-makes (enumerate '(:a :b :c)) 29 | '((0 :a) (1 :b) (2 :c))))) 30 | 31 | (f:def-test test/range () 32 | ;; Empty range checks 33 | (f:is (iter-makes nil (range 0 -2))) 34 | (f:is (iter-makes nil (range -2 0 -1))) 35 | (f:is (iter-makes nil (range -2 0 -1))) 36 | ;; Going upwards 37 | (f:is (iter-makes '(-2 -1) (range -2 0))) 38 | (f:is (iter-makes '(0 1 2 3 4) (range 0 5))) 39 | (f:is (iter-makes '(1 2 3 4) (range 1 5))) 40 | (f:is (iter-makes '(0 2 4 6 8) (range 0 10 2))) 41 | (f:is (iter-makes '(0 2 4 6 8) (range 0 9 2))) 42 | 43 | (f:is (iter-makes '(0 -1 -2 -3 -4) (range 0 -5 -1))) 44 | (f:is (iter-makes '(0 -2 -4) (range 0 -5 -2))) 45 | (f:is (iter-makes '(0 -2 -4) (range 0 -6 -2)))) 46 | 47 | (f:def-test test/take () 48 | (f:is (equalp '(1 2 3) (take 12 '(1 2 3)))) 49 | (let ((it (make-iterator '(1 2 3 4 5 6 7 8)))) 50 | (f:is (iter-makes (take 8 it) (range 1 9))) 51 | (f:is (iter-makes nil (take 1 it))))) 52 | 53 | (f:def-test test/repeat () 54 | (let ((num-repeats 10) 55 | (repeat-el t)) 56 | (f:is (equalp (loop for _ below num-repeats collect repeat-el) 57 | (take num-repeats (repeat repeat-el))))) 58 | (f:is (iter-makes (repeat 4 t) 59 | '(t t t t)))) 60 | 61 | (f:def-test test/count () 62 | (f:is (equalp (iter-to-list (range 0 10)) 63 | (take 10 (count 0 1)))) 64 | (f:is (equalp (iter-to-list (range 0 8 2)) 65 | (take 4 (count 0 2))))) 66 | 67 | (f:def-test test/cycle () 68 | (f:is (equalp '(1 2 3 4 1 2 3 4) 69 | (take 8 (cycle '(1 2 3 4)))))) 70 | 71 | (f:def-test test/islice () 72 | (f:is (iter-makes (range 10 20 2) 73 | (islice (count) 10 20 2))) 74 | (f:is (iter-makes (range 113 257 7) 75 | (islice (count) 113 257 7)))) 76 | 77 | (f:def-test test/map () 78 | (f:is (iter-makes (range 0 18 6) 79 | (map #'+ (count) (range 0 6 2) (range 0 9 3))))) 80 | 81 | (f:def-test test/compress () 82 | (f:is (iter-makes '(1 2 3 4 5 6) 83 | (compress '(1 2 3 4 5 6) (repeat t)))) 84 | (f:is (iter-makes '(1 3 5) 85 | (compress '(1 2 3 4 5) (cycle '(t nil))))) 86 | (f:is (iter-makes '(1 3 5) 87 | (compress '(1 2 3 4 5 6) (cycle '(t nil)))))) 88 | 89 | (f:def-test test/chain () 90 | (f:is (iter-makes '() (chain nil nil nil))) 91 | (f:is (iter-makes '() (chain nil))) 92 | (f:is (iter-makes '(1 2 3 4 5 6) (chain '(1 2 3) '(4 5 6)))) 93 | (f:is (iter-makes '(1 2 3 4 5 6) (chain '() '(1 2 3) '() '(4 5 6) '())))) 94 | 95 | (f:def-test test/chain-from-iter () 96 | (f:is (iter-makes '(0 0 1 0 1 2 0 1 2 3) 97 | (take 10 (chain-from-iter (picl:map (lambda (x) (range x)) (count))))))) 98 | 99 | (f:def-test test/zip () 100 | (f:is (iter-makes (list #(1 2 nil)) 101 | (zip '(1) '(2 3 nil) '(nil 4)))) 102 | (f:is (iter-makes nil (zip '() '(1 2 3 4)))) 103 | (f:is (iter-makes (list #(1 3) #(2 4)) 104 | (zip '(1 2) '(3 4))))) 105 | 106 | (f:def-test test/zip-longest () 107 | (f:is (iter-makes (list #(1 2 nil) #(nil 3 4) #(nil nil nil)) 108 | (zip-longest nil '(1) '(2 3 nil) '(nil 4)))) 109 | (f:is (iter-makes nil (zip-longest nil '() '()))) 110 | (f:is (iter-makes (list #(1 :a) #(2 :a) #(3 :a)) 111 | (zip-longest :a '(1 2 3) nil))) 112 | (f:is (iter-makes (list #(1) #(2)) 113 | (zip-longest :a '(1 2))))) 114 | 115 | (f:def-test test/dropwhile () 116 | (f:is (iter-makes '(3 4 5 6) 117 | (dropwhile (lambda (x) (< x 3)) 118 | '(1 2 3 4 5 6)))) 119 | (f:is (iter-makes '(1 2 3 4 5 6) 120 | (dropwhile (lambda (x) (declare (ignore x)) nil) 121 | '(1 2 3 4 5 6)))) 122 | (f:is (iter-makes '() (dropwhile (lambda (x) (declare (ignore x)) t) 123 | '(1 2 3 4 5 6))))) 124 | 125 | (f:def-test test/takewhile () 126 | (f:is (iter-makes '(1 2) 127 | (takewhile (lambda (x) (< x 3)) 128 | '(1 2 3 4 5 6)))) 129 | (f:is (iter-makes '(0 1 2 3 4 5 6) 130 | (takewhile (lambda (x) (<= x 6)) 131 | (count 0 1)))) 132 | (f:is (iter-makes '() (takewhile (lambda (x) (declare (ignore x)) nil) 133 | (count 0 1))))) 134 | 135 | (f:def-test test/filter () 136 | ;; Also serves to test filterfalse 137 | (f:is (iter-makes '(1 2 3 4 5 6) 138 | (filter (lambda (x) (declare (ignore x)) t) 139 | '(1 2 3 4 5 6)))) 140 | (f:is (iter-makes '() 141 | (filter (lambda (x) (declare (ignore x)) nil) 142 | '(1 2 3 4 5 6)))) 143 | (f:is (iter-makes '(1 3 5) 144 | (filter (lambda (x) (oddp x)) '(-2 0 1 2 3 4 5 6 8)))) 145 | (f:is (iter-makes '(-2 0 2 4 6 8) 146 | (filterfalse (lambda (x) (oddp x)) '(-2 0 1 2 3 4 5 6 8))))) 147 | 148 | (f:def-test test/starmap () 149 | (f:is (iter-makes '() (starmap #'+ nil))) 150 | (f:is (iter-makes '(4 5 10 2) 151 | (starmap #'+ '((1 2 1) (5) (1 2 3 4) (0 0 0 0 0 2 )))))) 152 | 153 | (f:def-test test/tee () 154 | (let* ((tees (tee 2 (make-iterator '(1 2 3 4 5 6 7 8 9 10)))) 155 | (t0 (aref tees 0)) 156 | (t1 (aref tees 1))) 157 | (f:is (equalp '(1 2 3) 158 | (take 3 t0))) 159 | (f:is (equalp '(1 2) 160 | (take 2 t1))) 161 | (f:is (equalp '(3 4 5 6) 162 | (take 4 t1))) 163 | (f:is (equalp '(4 5 6 7 8 9 10) 164 | (take 7 t0))) 165 | (f:is (iter-makes nil (iter-to-list t0))) 166 | (f:is (iter-makes '(7 8 9 10) 167 | (iter-to-list t1))))) 168 | 169 | (f:def-test test/always () 170 | (f:is (equalp t (always '(1 2 3)))) 171 | (f:is (equalp nil (always '(nil)))) 172 | (f:is (equalp t (always nil)))) 173 | 174 | (f:def-test test/never () 175 | (f:is (equalp nil (never '(1 2 3)))) 176 | (f:is (equalp t (never '(nil)))) 177 | (f:is (equalp t (never nil)))) 178 | --------------------------------------------------------------------------------