Merge branch 'working'

* working:
  refunct zippers code

diff --git a/code/refunctionalizing_zippers.rkt b/code/refunctionalizing_zippers.rkt
new file mode 100644 (file)
index 0000000..3b51ce9
--- /dev/null
+++ b/code/refunctionalizing_zippers.rkt
@@ -0,0 +1,107 @@
+#lang racket
+(require racket/control)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; solutions to the "abSdS" etc task                                   ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; using a list zipper
+(define (tz1 z)
+  (define (saved z) (car z))
+  (define (nextchar z) (cadr z))
+  (define (rest z) (cddr z))
+  (define pair cons)
+  (cond
+    [(null? (cdr z)) (reverse (saved z))]
+    [(eqv? #\S (nextchar z)) (tz1 (pair (append (saved z) (saved z)) (rest z)))]
+    [else (tz1 (pair (cons (nextchar z) (saved z)) (rest z)))]))
+
+; using explicit continuations
+(define (tc1 l k)
+  (cond
+    [(null? l) (reverse (k '()))]
+    [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))]
+    [else (tc1 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
+
+; using implicit continuations (reset/shift)
+(define (tr1 l)
+  (shift k
+    (cond
+      [(null? l) (reverse (k '()))]
+      [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))]
+      [else ((lambda (tail) (cons (car l) (k tail))) (tr1 (cdr l)))])))
+
+; wrapper functions, there's a (test) function at the end
+
+(define (tz2 s)
+  (list->string (tz1 (cons '() (string->list s)))))
+
+(define (tc2 s)
+  (list->string (tc1 (string->list s) identity)))
+
+(define (tr2 s)
+  (list->string (reset (tr1 (string->list s)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; here are variants that only repeat from S back to the most recent # ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; using a list zipper
+(define (tz3 z)
+  (define (saved z) (car z))
+  (define (nextchar z) (cadr z))
+  (define (rest z) (cddr z))
+  (define (pair x y) (cons x y))
+  (cond
+    [(null? (cdr z)) (reverse (saved z))]
+    [(eqv? #\# (nextchar z)) (append (reverse (saved z)) (tz3 (pair '() (rest z))))]
+    [(eqv? #\S (nextchar z)) (tz3 (pair (append (saved z) (saved z)) (rest z)))]
+    [else (tz3 (pair (cons (nextchar z) (saved z)) (rest z)))]))
+
+; using explicit continuations
+; there are several working solutions
+; but it's a bit tricky to get the reverses in the right place, and the order of appending right
+(define (tc3 l k)
+  (cond
+    [(null? l) (reverse (k '()))]
+    [(eqv? #\# (car l)) (append (reverse (k '())) (tc3 (cdr l) identity))]
+    [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))]
+    [else (tc3 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
+
+; using implicit continuations (reset/shift)
+(define (tr3 l)
+  (shift k
+    (cond
+      [(null? l) (reverse (k '()))]
+      [(eqv? #\# (car l)) (append (reverse (k '())) (reset (tr3 (cdr l))))]
+      [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))]
+      [else ((lambda (tail) (cons (car l) (k tail))) (tr3 (cdr l)))])))
+
+(define (tz4 s)
+  (list->string (tz3 (cons '() (string->list s)))))
+
+(define (tc4 s)
+  (list->string (tc3 (string->list s) identity)))
+
+(define (tr4 s)
+  (list->string (reset (tr3 (string->list s)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (test)
+  (define (cmp t1 t2 inp)
+    (equal? (t1 inp) (t2 inp)))
+  (and
+   (equal? (tz2 "abSd") "ababd")
+   (cmp tc2 tz2 "abSd")
+   (cmp tr2 tz2 "abSd")
+   (equal? (tz2 "aSbS") "aabaab")
+   (cmp tc2 tz2 "aSbS")
+   (cmp tr2 tz2 "aSbS")
+   (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")
+   (cmp tc4 tz4 "ab#ceSfSd")
+   (cmp tr4 tz4 "ab#ceSfSd")
+   (equal? (tz4 "ab#ceS#fSd") "abceceffd")
+   (cmp tc4 tz4 "ab#ceS#fSd")
+   (cmp tr4 tz4 "ab#ceS#fSd")
+   ))