src/utilities.lisp @ 84fa1724b747
default tip
More work on the Huffman encoder and basic project skeleton
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 26 Jul 2020 16:49:17 -0400 |
parents |
716d1110c12f |
children |
(none) |
(in-package :tdcb)
(define-modify-macro ashf (count) ash "Arithmetic shift in place")
(define-modify-macro logiorf (&rest integers) logior "Logical inclusive or in place")
(deftype u8 () '(unsigned-byte 8))
(defun random-bytes (length &aux (result (make-array length)))
(dotimes (i length)
(setf (aref result i) (random 256)))
result)
(defun compress-octets (function data)
(let* ((in (flexi-streams:make-in-memory-input-stream data))
(out (flexi-streams:make-in-memory-output-stream)))
(with-bits-output (out out)
(funcall function in out))
(let ((result (flexi-streams:get-output-stream-sequence out)))
(values result
(list :data (length data)
:result (length result)
:ratio (coerce (/ (length result) (length data))
'double-float))))))
(defun compress-string (function string)
(compress-octets function (flexi-streams:string-to-octets string :external-format :utf-8)))
(defun extract-octets (function data)
(let ((in (flexi-streams:make-in-memory-input-stream data))
(out (flexi-streams:make-in-memory-output-stream)))
(with-bits-input (in in)
(funcall function in out))
(flexi-streams:get-output-stream-sequence out)))
(defun extract-string (function data)
(flexi-streams:octets-to-string (extract-octets function data)
:external-format :utf-8))
(defun roundtrip-octets (compress extract octets)
(multiple-value-bind (data stats) (compress-octets compress octets)
(let ((result (extract-octets extract data)))
(assert (equal octets result))
stats)))
(defun roundtrip-string (compress extract string)
(multiple-value-bind (data stats) (compress-string compress string)
(let ((result (extract-string extract data)))
(assert (string= string result))
stats)))
(defun stress-test (compress extract)
(iterate
(for length :from 2 :below 200 :by 3)
(format t "Testing random vectors of length ~D…~%" length)
(dotimes (_ 1000)
(roundtrip-octets compress extract (random-bytes length)))))