name change
[lambda.git] / code / refunctionalizing_zippers.rkt
1 #lang racket
2 (require racket/control)
3
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 ;; solutions to the "abSdS" etc task                                   ;;
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7
8 ; using a list zipper
9 (define (tz1 z)
10   (define (saved z) (car z))
11   (define (nextchar z) (cadr z))
12   (define (rest z) (cddr z))
13   (define pair cons)
14   (cond
15     [(null? (cdr z)) (reverse (saved z))]
16     [(eqv? #\S (nextchar z)) (tz1 (pair (append (saved z) (saved z)) (rest z)))]
17     [else (tz1 (pair (cons (nextchar z) (saved z)) (rest z)))]))
18
19 ; using explicit continuations
20 (define (tc0 l k)
21   (cond
22     [(null? l) (reverse (k '()))]
23     [(eqv? #\S (car l)) (tc0 (cdr l) (compose k k))]
24     [else (tc0 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
25
26 ; improvement: if we flip the order of cons and k in the last line, we can avoid the need to reverse
27 (define (tc1 l k)
28   (cond
29     [(null? l) (k '())]
30     [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))]
31     [else (tc1 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
32
33 ; using implicit continuations (reset/shift)
34 (define (tr1 l)
35   (shift k
36     (cond
37       [(null? l) (k '())]
38       [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))]
39       [else ((lambda (tail) (k (cons (car l) tail))) (tr1 (cdr l)))])))
40
41 ; wrapper functions, there's a (test) function at the end
42
43 (define (tz2 s)
44   (list->string (tz1 (cons '() (string->list s)))))
45
46 (define (tc2 s)
47   (list->string (tc1 (string->list s) identity)))
48
49 (define (tr2 s)
50   (list->string (reset (tr1 (string->list s)))))
51
52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 ;; here are variants that only repeat from S back to the most recent # ;;
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55
56 ; using a list zipper
57 (define (tz3 z)
58   (define (saved z) (car z))
59   (define (nextchar z) (cadr z))
60   (define (rest z) (cddr z))
61   (define (pair x y) (cons x y))
62   (cond
63     [(null? (cdr z)) (reverse (saved z))]
64     [(eqv? #\# (nextchar z)) (append (reverse (saved z)) (tz3 (pair '() (rest z))))]
65     [(eqv? #\S (nextchar z)) (tz3 (pair (append (saved z) (saved z)) (rest z)))]
66     [else (tz3 (pair (cons (nextchar z) (saved z)) (rest z)))]))
67
68 ; using explicit continuations
69 (define (tc3 l k)
70   (cond
71     [(null? l) (k '())]
72     ; [(eqv? #\# (car l)) (append (k '()) (tc3 (cdr l) identity))]
73     [(eqv? #\# (car l)) (k (tc3 (cdr l) identity))]
74     [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))]
75     [else (tc3 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
76
77 ; using implicit continuations (reset/shift)
78 (define (tr3 l)
79   (shift k
80     (cond
81       [(null? l) (identity (k '()))]
82       ; [(eqv? #\# (car l)) (append (k '()) (reset (tr3 (cdr l))))]
83       [(eqv? #\# (car l)) (k (reset (tr3 (cdr l))))]
84       [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))]
85       [else ((lambda (tail) (k (cons (car l) tail))) (tr3 (cdr l)))])))
86
87 (define (tz4 s)
88   (list->string (tz3 (cons '() (string->list s)))))
89
90 (define (tc4 s)
91   (list->string (tc3 (string->list s) identity)))
92
93 (define (tr4 s)
94   (list->string (reset (tr3 (string->list s)))))
95
96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97
98 (define (test)
99   (define (cmp t1 t2 inp)
100     (equal? (t1 inp) (t2 inp)))
101   (and
102    (equal? (tz2 "abSd") "ababd")
103    (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd")
104    (cmp tc2 tz2 "abSd")
105    (cmp tr2 tz2 "abSd")
106    (equal? (tz2 "aSbS") "aabaab")
107    (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "aSbS")
108    (cmp tc2 tz2 "aSbS")
109    (cmp tr2 tz2 "aSbS")
110    (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")
111    (cmp tc4 tz4 "ab#ceSfSd")
112    (cmp tr4 tz4 "ab#ceSfSd")
113    (equal? (tz4 "ab#ceS#fSd") "abceceffd")
114    (cmp tc4 tz4 "ab#ceS#fSd")
115    (cmp tr4 tz4 "ab#ceS#fSd")
116    ))