Packed Ascii

May 6, 2014

This is easier than it looks, since bit-twiddling is ugly in Scheme. We start with compression:

(define (pack str)
  (define (compress c) (bitwise-and c #x3F))
  (define (c cs n) (let ((xs (drop n cs))) (if (null? xs) 32 (car xs))))
  (define (b n) (bitwise-and n #xFF))
  (let loop ((cs (map char->integer (string->list str))) (out (list)))
    (if (null? cs) (list->string (map integer->char (reverse out)))
      (let* ((p (+ (ash (compress (c cs 0)) 18) (ash (compress (c cs 1)) 12)
                   (ash (compress (c cs 2)) 6) (compress (c cs 3))))
             (out1 (b (ash p -16))) (out2 (b (ash p -8))) (out3 (b p)))
        (loop (drop 4 cs) (cons* out3 out2 out1 out))))))

The internal c function returns space characters if needed for padding, and the internal b function performs a bitwise-and with 11111111b. The loop processes blocks of four characters, building up the 6-bit representations of the characters in an integer p, then splitting p eight bits at a time. Expansion is the opposite:

(define (unpack str)
  (define (expand p) (+ (ash (bitwise-xor 1 (ash p -5)) 6) p))
  (define (b n) (bitwise-and n #x3F))
  (let loop ((cs (map char->integer (string->list str))) (out (list)))
    (if (null? cs) (list->string (map integer->char (reverse out)))
      (let* ((p (+ (ash (car cs) 16) (ash (cadr cs) 8) (caddr cs)))
             (out1 (expand (b (ash p -18)))) (out2 (expand (b (ash p -12))))
             (out3 (expand (b (ash p -6)))) (out4 (expand (b p))))
        (loop (cdddr cs) (cons* out4 out3 out2 out1 out))))))

It’s easy to check that our functions work:

> (unpack (pack "PROGRAMMING PRAXIS"))

We used drop and cons* from the Standard Prelude, and the new bitwise- functions from R7RS. You can run the program at, where you will also see implementations of the bitwise- functions if your Scheme doesn’t yet provide them.


Pages: 1 2

One Response to “Packed Ascii”

  1. chmllr said

    I feel a little bit like cheater using Java’s Integer methods for parsing and generating bit strings, but in the end, this is why my choice is Clojure :)

    (defn compress [input]
      (let [pad (repeat (mod (count input) 4) \ )
            padded-input (concat input pad)
            truncated (map #(bit-and 63 (int %)) padded-input)
            bit-strings (map #(Integer/toString % 2) truncated)
            prefixed (map #(str (apply str (repeat (- 6 (count %)) "0")) %) bit-strings)
            compressed (map #(apply str %) (partition 8 (apply str prefixed)))
            bytes (map #(char (Integer/parseInt % 2)) compressed)]
        (apply str bytes)))
    (defn expand [input]
      (let [bit-strings (map #(Integer/toString (int %) 2) input)
            prefixed (map #(str (apply str (repeat (- 8 (count %)) "0")) %) bit-strings)
            merged (apply str prefixed)
            ints (map #(Integer/parseInt (apply str %) 2) (partition 6 merged))
            expanded (map #(if (= 32 %) % (bit-or 64 %)) ints)]
          (apply str (map char expanded)))))

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: