;
; Copyright (c) 2003
;      Ali Onur Cinar &060;cinar&064;zdo.com&062;
;
; License:
;
;   Permission  to  use,  copy, modify, and  distribute  this software and its
;   documentation   for  educational   purposes  and  without  fee  is  hereby
;   granted,  provided  that the  above  copyright notice appear in all copies
;   and  that both  the  copyright  notice  and  this  permission  notice  and
;   warranty  disclaimer appear in supporting documentation, and that the name
;   of Ali Onur Cinar not be  used  in  advertising or publicity pertaining to
;   distribution of the software without specific, written prior permission.
;


(defun char-as-int (c)
 (- (char-int c) 48))

(defun is-integer (c)
 (let ((i (char-int c)))
  (and (> i 47) (< i 58))))

(defun expand (c n)
 (cond ((> n 0) (string-concat (format nil "~c" c) (expand c (- n 1))))
       ('t "")))

(defun pack (c n)
 (cond ((= n 1) (format nil "~c" c))
       ('t (format nil "~d~c" n c))))

(defun unpack (c n)
 (cond ((= n 0) (expand c 1))
       ('t (expand c n))))

(defun run-length-encoder (str)
 (let ((n 1) (c nil) (r ""))
  (dotimes (i (length str))
   (cond ((null c) (setq c (char str i)))
         ((char-equal (char str i) c) (setq n (+ n 1)))
         ('t (setq r (string-concat r (pack c n)))
             (setq c (char str i))
             (setq n 1))))
   (cond ((not (null c))
     (setq r (string-concat r (pack c n)))))
   r))

(defun run-length-decoder (str)
 (let ((n 0) (c nil) (d ""))
  (dotimes (i (length str))
   (setq c (char str i))
   (cond ((is-integer c) (setq n (+ (* n 10) (char-as-int c))))
         ('t (setq d (string-concat d (unpack c n)))
             (setq n 0))))
   d))

;
; Testing
;

(setq str1 "aaaabbcdeeeeefffffffffffffffffff")
(setq str2 (run-length-encoder str1))
(setq str3 (run-length-decoder str2))
(setq perc (/ (* (- (length str1) (length str2)) 100) (length str1)))

(format t "plain   -> ~s~%" str1)
(format t "encoded -> ~s (~f% compression) ~%" str2 perc)
(format t "decoded -> ~s~%" str3)

 plain   -> "aaaabbcdeeeeefffffffffffffffffff"
 encoded -> "4a2bcd5e19f" (65.625% compression)
 decoded -> "aaaabbcdeeeeefffffffffffffffffff"