; run-length encoding
(define (compress in-port out-port)
(define (n->char n) (integer->char (+ 64 n)))
(define (show-run prev n)
(display #\~ out-port)
(display (n->char n) out-port)
(display prev out-port))
(define (put-run prev n)
(cond ((char=? prev #\~) (show-run #\~ n))
((< n 4) (display (make-string n prev) out-port))
((< n 27) (show-run prev n))
(else (show-run prev 26) (put-run prev (- n 26)))))
(let loop ((c (read-char in-port)) (prev #f) (n 0))
(cond ((eof-object? c) (if prev (put-run prev n)))
((and prev (char=? c prev))
(loop (read-char in-port) prev (+ n 1)))
(prev (put-run prev n) (loop (read-char in-port) c 1))
(else (loop (read-char in-port) c 1)))))
(define (expand in-port out-port)
(define (char->n c) (- (char->integer c) 64))
(let loop ((c (read-char in-port)))
(unless (eof-object? c)
(if (char=? c #\~)
(let* ((n (char->n (read-char in-port)))
(c (read-char in-port)))
(display (make-string n c) out-port))
(display c out-port))
(loop (read-char in-port)))))
(with-input-from-string "ABBB~CDDDDDEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE"
(lambda () (compress (current-input-port) (current-output-port))))
ABBB~A~C~ED~ZE~DE
(with-input-from-string "ABBB~A~C~ED~ZE~DE"
(lambda () (expand (current-input-port) (current-output-port))))
ABBB~CDDDDDEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE