Racket/RLE
Från Täpp-Anders
#lang racket
;;;;;
;; RLE – Run Length Encoder
;;
;; I/O via stdio <infil >utfil
;;
;; Kodar data genom att räkna antal förekomster av samma tecken/byte i rad och
;; ersätter den med ett cons-par (antal . tecken) tills nästa förekomst finns.
;; Kan operera binärt men med begränsningen av max 255 bytes konsekutivt sedan
;; startas en ny ram.
;;
;; racket rle.rkt [ --encode | --decode | --help ] [ --binary ] < infil > utfil
;;
;; --encode kodar stdin till stdout lisp style om inte --binary används
;; --decode avkodar stdin till stdout lisp style om inte --binary används
;; --binary skriver kodad data binärt, läser binär data för avkodning
;; --help visar en enkel hjälptext
;; --test kör en enkel sån därn JOONIT TÄST di kallart
;;
;; Saker som kan göras bättre:
;;
;; Det finns ganska lite felkontroll och vad du kastar på dekodern kommer den försöka
;; tills det skiter sig.
;;
;; Man kan också tänka sig att använda mer än en byte för antal i binärt mode
;; men också en grej är ju att man aldrig kommer koda för 0 tecken så man kunde
;; ju lika gärna koda för 1-256 i stället för 0-255. Jag har struntat i det.
;;
;;;;;
;; --- Kärnlogik ---
;; Grupperar element
(define (pack-limited lst)
(cond [(empty? lst) '()]
[else
(let-values ([(prefix suffix) (splitf-at lst (lambda (x) (equal? x (first lst))))])
(if (> (length prefix) 255)
;; Om gruppen är för lång, hugg av vid 255 och fortsätt med resten
(cons (take prefix 255) (pack-limited (append (drop prefix 255) suffix)))
;; Annars, fortsätt som vanligt
(cons prefix (pack-limited suffix))))]))
(define (encode lst)
(map (lambda (group) (list (length group) (first group)))
(pack-limited lst)))
(define (decode lst)
(append-map (lambda (entry) (make-list (first entry) (second entry)))
lst))
;; --- Binär I/O ---
(define (write-binary encoded-data)
(for ([pair encoded-data])
(write-byte (first pair))
(write-byte (second pair))))
(define (read-binary)
(let ([count (read-byte)])
(if (eof-object? count)
'()
(let ([val (read-byte)])
(cons (list count val) (read-binary))))))
;; --- Körlägen ---
(define (run-encode binary?)
(let* ([input (port->bytes (current-input-port))]
[encoded (encode (bytes->list input))])
(if binary?
(write-binary encoded)
(write encoded)))) ; Använd write för att få korrekt läsbar listformat
(define (run-decode binary?)
(let* ([data (if binary? (read-binary) (read))]
[decoded (decode data)])
(display (list->bytes decoded))))
(define (run-test)
(let* ([input (port->bytes (current-input-port))]
[encoded (encode (bytes->list input))]
[decoded (list->bytes (decode encoded))])
(if (equal? input decoded)
(printf "Test lyckades! (~a bytes in, ~a noder skapade)\n"
(bytes-length input) (length encoded))
(error "Test misslyckades: Datat korrupt!"))))
;; --- CLI ---
(define (show-help)
(displayln "Användning: racket rle.rkt [FLAGGA] < infil > utfil")
(displayln " -e, --encode Koda (standard: text-listor)")
(displayln " -d, --decode Dekoda (standard: text-listor)")
(displayln " -b, --binary Kör i binärläge (1 byte antal, 1 byte värde)")
(displayln " -t, --test Verifiera att koda+dekoda bevarar data")
(displayln " -h, --help Visa denna hjälp"))
(define (main)
(let ([args (vector->list (current-command-line-arguments))])
(cond
[(member "-t" args) (run-test)]
[(and (member "-e" args) (or (member "-b" args) (member "--binary" args))) (run-encode #t)]
[(member "-e" args) (run-encode #f)]
[(and (member "-d" args) (or (member "-b" args) (member "--binary" args))) (run-decode #t)]
[(member "-d" args) (run-decode #f)]
[else (show-help)])))
(main)