From 4d6ded823b9680c08c27bfd5e50d94dc1209df1a Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 8 Jul 2020 16:22:43 -0500 Subject: moved examples to their own package --- examples.lisp | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ gtwiwtg.lisp | 51 +--------------------------------------------- 2 files changed, 66 insertions(+), 50 deletions(-) create mode 100644 examples.lisp diff --git a/examples.lisp b/examples.lisp new file mode 100644 index 0000000..2893447 --- /dev/null +++ b/examples.lisp @@ -0,0 +1,65 @@ +(defpackage #:gtwiwtg.examples + (:use #:cl #:gtwiwtg) + (:export #:perms #:all-primes)) + +(in-package :gtwiwtg.examples) + +;; permutations + + +(defun fill-and-insert (idx elem vec buffer) + "A utilty function that modifies BUFFER. + +The length of BUFFER is one greater than the length of VEC. + +This function fills the first IDX fields of BUFFER with the first IDX +fields of VEC. Fills the field of BUFFER at IDX with ELEM. Fills the +remaining fields of BUFFER with the remaining fields of VEC. +" + (loop :for i :below (length buffer) + :when (= i idx) :do (setf (aref buffer idx) elem) + :when (< i idx) :do (setf (aref buffer i) + (aref vec i)) + :when (> i idx) :do (setf (aref buffer i) + (aref vec (1- i)))) ) + +(defun thread-through (elem vec) + "Creates a generator that produces a series of N vectors of length +N, where N is one greater than the length of VEC. The vectors +produced by this generator have the same elements of VEC but have ELEM +inserted at each possible spot, N spots in all. + +Note: The generator reuses the memory that it returns on each step. If +you intend to collect to products of the generator, you should copy +them to somehow first. +" + (let ((buffer (concatenate 'vector vec (list elem)))) ;; reusable buffer + (map! (lambda (idx) + (fill-and-insert idx elem vec buffer) + buffer) + (range :from 0 :to (length vec) :inclusive t)))) + + +(defun perms (vec) + "Creates a generator that produces all of the permutations of the +vector VEC, one at a time." + (if (= 1 (length vec)) (seq (list vec)) + (let ((elem (elt vec 0)) + (subperms (perms (make-array (1- (length vec)) + :displaced-to vec + :displaced-index-offset 1 + :element-type (array-element-type vec))))) + (inflate! (lambda (subperm) (thread-through elem subperm)) subperms)))) + +;; primes + +(defun prime-p (n) + (loop + :for x :from 2 :upto (sqrt n) + :when (zerop (mod n x)) :do (return nil) + :finally (return t))) + +(defun all-primes () + (filter! #'prime-p (range :from 1))) + + diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp index fe0f679..5938065 100644 --- a/gtwiwtg.lisp +++ b/gtwiwtg.lisp @@ -592,7 +592,7 @@ Example: a usless calculation ((x y) (zip! (times 10) (range :by -1))) (sqrt (+ acc (* x y)))) -#C(0.4498776 9.987898) + #C(0.444279 8.986663) Example: building data @@ -684,52 +684,3 @@ is minimal among the values of GEN. VALUE is the value of (FUNCALL FN X)" am)))) -;;; EXAMPLES - - -;; permutations - -(defun fill-and-insert (idx elem vec buffer) - "A Utility function that inserts ELEM at IDX into BUFFER. For every -other space in BUFFER, the lements of VEC are inserted in order. - -Implicity expects (= (LENGTH BUFFER) (1+ (LENGTH VEC))) - -Not meant for general use. just a utility used by THREAD-THROUGH" - (loop :for i :below (length buffer) - :when (= i idx) :do (setf (aref buffer idx) elem) - :when (< i idx) :do (setf (aref buffer i) - (aref vec i)) - :when (> i idx) :do (setf (aref buffer i) - (aref vec (1- i)))) ) - -(defun thread-through (elem vec) - (let ((buffer (concatenate 'vector vec (list elem)))) ;; reusable buffer - (map! (lambda (idx) - (fill-and-insert idx elem vec buffer) - buffer) - (range :from 0 :to (length vec))))) - - -(defun perms (vec) - (if (= 1 (length vec)) (seq (list vec)) - (let ((elem (elt vec 0)) - (subperms (perms (make-array (1- (length vec)) - :displaced-to vec - :displaced-index-offset 1 - :element-type (array-element-type vec))))) - (inflate! (lambda (subperm) (thread-through elem subperm)) subperms)))) - - -;; primes - -(defun prime-p (n) - (loop - :for x :from 2 :upto (sqrt n) - :when (zerop (mod n x)) :do (return nil) - :finally (return t))) - -(defun all-primes () - (filter! #'prime-p (range :from 1))) - - -- cgit v1.2.3