added a few more combinators and and an example

2 files changed, 50 insertions, 1 deletions

diff --git a/examples.lisp b/examples.lisp
index 221c78e..df50a23 100644
--- a/examples.lisp
+++ b/examples.lisp
@@ -118,4 +118,33 @@ vector VEC, one at a time."
            (zip! (range) (file-lines file))))
 
 
-;; find all export expressions in my bashrc file
+
+;;; Silly Scrambler ;;; 
+
+
+(defun pad (str len &optional (pad-char #\Space]))
+  (let ((i 0))
+    (with-output-to-string (out)
+      (loop :for c :across str :do (incf i) (princ c out))
+      (loop :while (< i len) :do (incf i) (princ pad-char out)))))
+
+(defun scramble (n str)
+  (assert (< n (length str)))
+  (let ((str (pad str (* n (ceiling (/ (length str) n))))))
+    (concatenate 'string 
+                 (apply #'nconc
+                        (mapcar #'collect
+                                (disperse! n (seq str)))))))
+
+(defun chunk (n str)
+  (assert (zerop (mod (length str) n)))
+  (let ((size (/ (length str) n)))
+    (loop
+       :for i :below (length str) :by size
+       :collect (subseq str i (+ i size)) )))
+
+(defun descramble (n str)
+  (concatenate 'string
+               (collect 
+                   (apply #'intersperse!
+                          (mapcar #'seq (chunk n str))))))
diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index 3cf1871..5e954ee 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -629,6 +629,26 @@ Caveat:
     (list (filter! pred gen1)
           (filter! (complement pred) gen2))))
 
+(defun intersperse! (gen1 gen2 &rest gens)
+  (inflate! #'seq (apply #'zip! gen1 gen2 gens)))
+
+(defun truncate! (n gen)
+  (map! #'first (zip! gen (times n))))
+
+(defun inject! (fn gen)
+  (map! (lambda (x) (funcall fn x) x) gen))
+
+(defun disperse! (n gen)
+  (loop
+     :for i :below n
+     :for cloned :in  (nfurcate! n gen)
+     :collect
+       (let ((j i))
+         (map! #'second
+               (filter! (lambda (pair) (= j (mod (first pair) n)))
+                        (indexed! cloned))))))
+
+
 ;;; CONSUMERS
 
 (defmacro for (var-exp gen &body body)