codepad

Language:

; 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

Private [?]

Run code