; run length encoding
(define (uniq-c eql? xs)
(if (null? xs) xs
(let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
(cond ((null? xs) (reverse (cons (cons prev k) result)))
((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
(else (loop (cdr xs) (car xs) 1
(cons (cons prev k) result)))))))
(define (f str) (uniq-c char=? (string->list str)))
(display (f "aaaabbbcca")) (newline)
(define (group-by eql? xs)
(let loop ((xs xs) (ys '()) (zs '()))
(cond ((null? xs)
(reverse (if (null? ys) zs (cons (reverse ys) zs))))
((null? (cdr xs))
(reverse (cons (reverse (cons (car xs) ys)) zs)))
((eql? (car xs) (cadr xs))
(loop (cdr xs) (cons (car xs) ys) zs))
(else (loop (cddr xs) (list (cadr xs))
(cons (reverse (cons (car xs) ys)) zs))))))
(define (chop-chop str)
(let ((xs (group-by char=? (string->list str))))
(map list (map (compose string car) xs)
(map length xs))))
(display (chop-chop "aaaabbbcca")) (newline)
(define (rle str)
(let loop ((cs (string->list str))
(prev #f) (count 0)
(output (list)))
(cond ((not prev) ; start input
(if (null? cs) output
(loop (cdr cs) (car cs) 1 output)))
((null? cs) ; end of input
(reverse (cons (cons prev count) output)))
((char=? (car cs) prev) ; continue current run
(loop (cdr cs) prev (+ count 1) output))
(else ; end current run, start another
(loop (cdr cs) (car cs) 1
(cons (cons prev count) output))))))
(display (rle "aaaabbbcca")) (newline)