Racket/RLE

Från Täpp-Anders
Hoppa till navigeringHoppa till sök

#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)