#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") ))