fork download
copy 
  1. ; run length encoding
  2.  
  3. (define (uniq-c eql? xs)
  4.   (if (null? xs) xs
  5.     (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
  6.       (cond ((null? xs) (reverse (cons (cons prev k) result)))
  7.             ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
  8.             (else (loop (cdr xs) (car xs) 1
  9.                         (cons (cons prev k) result)))))))
  10.  
  11. (define (f str) (uniq-c char=? (string->list str)))
  12.  
  13. (display (f "aaaabbbcca")) (newline)
  14.  
  15. (define (group-by eql? xs)
  16.   (let loop ((xs xs) (ys '()) (zs '()))
  17.     (cond ((null? xs)
  18.             (reverse (if (null? ys) zs (cons (reverse ys) zs))))
  19.           ((null? (cdr xs))
  20.             (reverse (cons (reverse (cons (car xs) ys)) zs)))
  21.           ((eql? (car xs) (cadr xs))
  22.             (loop (cdr xs) (cons (car xs) ys) zs))
  23.           (else (loop (cddr xs) (list (cadr xs))
  24.                       (cons (reverse (cons (car xs) ys)) zs))))))
  25.  
  26. (define (chop-chop str)
  27.   (let ((xs (group-by char=? (string->list str))))
  28.     (map list (map (compose string car) xs)
  29.               (map length xs))))
  30.  
  31. (display (chop-chop "aaaabbbcca")) (newline)
  32.  
  33. (define (rle str)
  34.   (let loop ((cs (string->list str))
  35.              (prev #f) (count 0)
  36.              (output (list)))
  37.     (cond ((not prev) ; start input
  38.             (if (null? cs) output
  39.               (loop (cdr cs) (car cs) 1 output)))
  40.           ((null? cs) ; end of input
  41.             (reverse (cons (cons prev count) output)))
  42.           ((char=? (car cs) prev) ; continue current run
  43.             (loop (cdr cs) prev (+ count 1) output))
  44.           (else ; end current run, start another
  45.             (loop (cdr cs) (car cs) 1
  46.                   (cons (cons prev count) output))))))
  47.  
  48. (display (rle "aaaabbbcca")) (newline)
Success #stdin #stdout 0.01s 7880KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((a . 4) (b . 3) (c . 2) (a . 1))
((a 4) (b 3) (c 2) (a 1))
((a . 4) (b . 3) (c . 2) (a . 1))
https://ideone.com/gpOaZy
language:
Scheme (chicken 4.13)
created:
2 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!