#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 (tc0 l k) (cond [(null? l) (reverse (k '()))] [(eqv? #\S (car l)) (tc0 (cdr l) (compose k k))] [else (tc0 (cdr l) (lambda (tail) (cons (car l) (k tail))))])) ; improvement: if we flip the order of cons and k in the last line, we can avoid the need to reverse (define (tc1 l k) (cond [(null? l) (k '())] [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))] [else (tc1 (cdr l) (lambda (tail) (k (cons (car l) tail))))])) ; using implicit continuations (reset/shift) (define (tr1 l) (shift k (cond [(null? l) (k '())] [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))] [else ((lambda (tail) (k (cons (car l) 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 (define (tc3 l k) (cond [(null? l) (k '())] ; [(eqv? #\# (car l)) (append (k '()) (tc3 (cdr l) identity))] [(eqv? #\# (car l)) (k (tc3 (cdr l) identity))] [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))] [else (tc3 (cdr l) (lambda (tail) (k (cons (car l) tail))))])) ; using implicit continuations (reset/shift) (define (tr3 l) (shift k (cond [(null? l) (identity (k '()))] ; [(eqv? #\# (car l)) (append (k '()) (reset (tr3 (cdr l))))] [(eqv? #\# (car l)) (k (reset (tr3 (cdr l))))] [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))] [else ((lambda (tail) (k (cons (car l) 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 (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd") (cmp tc2 tz2 "abSd") (cmp tr2 tz2 "abSd") (equal? (tz2 "aSbS") "aabaab") (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "aSbS") (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") ))