2 (require racket/control)
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 ;; solutions to the "abSdS" etc task ;;
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10 (define (saved z) (car z))
11 (define (nextchar z) (cadr z))
12 (define (rest z) (cddr z))
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)))]))
19 ; using explicit continuations
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))))]))
26 ; improvement: if we flip the order of cons and k in the last line, we can avoid the need to reverse
30 [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))]
31 [else (tc1 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
33 ; using implicit continuations (reset/shift)
38 [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))]
39 [else ((lambda (tail) (k (cons (car l) tail))) (tr1 (cdr l)))])))
41 ; wrapper functions, there's a (test) function at the end
44 (list->string (tz1 (cons '() (string->list s)))))
47 (list->string (tc1 (string->list s) identity)))
50 (list->string (reset (tr1 (string->list s)))))
52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 ;; here are variants that only repeat from S back to the most recent # ;;
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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))
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)))]))
68 ; using explicit continuations
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))))]))
77 ; using implicit continuations (reset/shift)
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)))])))
88 (list->string (tz3 (cons '() (string->list s)))))
91 (list->string (tc3 (string->list s) identity)))
94 (list->string (reset (tr3 (string->list s)))))
96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
99 (define (cmp t1 t2 inp)
100 (equal? (t1 inp) (t2 inp)))
102 (equal? (tz2 "abSd") "ababd")
103 (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd")
106 (equal? (tz2 "aSbS") "aabaab")
107 (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) 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")