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? #\S (car l)) (tc3 (cdr l) (compose k k))]
  74     [else (tc3 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
  75
  76 ; using implicit continuations (reset/shift)
  77 (define (tr3 l)
  78   (shift k
  79     (cond
  80       [(null? l) (identity (k '()))]
  81       [(eqv? #\# (car l)) (append (k '()) (reset (tr3 (cdr l))))]
  82       [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))]
  83       [else ((lambda (tail) (k (cons (car l) tail))) (tr3 (cdr l)))])))
  84
  85 (define (tz4 s)
  86   (list->string (tz3 (cons '() (string->list s)))))
  87
  88 (define (tc4 s)
  89   (list->string (tc3 (string->list s) identity)))
  90
  91 (define (tr4 s)
  92   (list->string (reset (tr3 (string->list s)))))
  93
  94 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95
  96 (define (test)
  97   (define (cmp t1 t2 inp)
  98     (equal? (t1 inp) (t2 inp)))
  99   (and
 100    (equal? (tz2 "abSd") "ababd")
 101    (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd")
 102    (cmp tc2 tz2 "abSd")
 103    (cmp tr2 tz2 "abSd")
 104    (equal? (tz2 "aSbS") "aabaab")
 105    (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "aSbS")
 106    (cmp tc2 tz2 "aSbS")
 107    (cmp tr2 tz2 "aSbS")
 108    (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")
 109    (cmp tc4 tz4 "ab#ceSfSd")
 110    (cmp tr4 tz4 "ab#ceSfSd")
 111    (equal? (tz4 "ab#ceS#fSd") "abceceffd")
 112    (cmp tc4 tz4 "ab#ceS#fSd")
 113    (cmp tr4 tz4 "ab#ceS#fSd")
 114    ))