Rosetta Code

Color quantization: Difference between revisions

Page Discussion

Color quantization (view source)

Revision as of 20:44, 28 February 2017

219 bytes removed ,  7 years ago
m
Don't deduplicate colors/pixels
(Add Common Lisp implementation)
m (Don't deduplicate colors/pixels)
Line 139:
(defun image->pixels (image)
(check-type image 8-bit-rgb-image)
(let ((pixels (make-hash-table :test #'equal)))
(do-pixels (y x) image
(setf (gethashpush (pixel* image y x) pixels) t))
(loop for p being the hash-key of pixels))
collect p)))
 
(defun greatest-color-range (pixels)
Line 164 ⟶ 163:
(defun median-cut (pixels target-num-colors)
(assert (zerop (mod (log target-num-colors 2) 1)))
(if (or (= target-num-colors 1) (<=null (lengthrest pixels) target-num-colors))
(list pixels)
(let* ((channel (greatest-color-range pixels))
Line 174 ⟶ 173:
 
(defun quantize-colors (pixels target-num-colors)
(loop withlet ((color-map = (make-hash-table :test #'equal)))
(dolist for (bucket in (median-cut pixels target-num-colors) color-map)
do (loop for (r g b) in bucket
sum r into r-sum
sum g into g-sum
sum b into b-sum
count t into num-pixels
finally (loop withlet ((average = (list (round r-sum num-pixels)
(round g-sum num-pixels)
(round b-sum num-pixels))))
(dolist for (pixel in bucket)
do (setf (gethash pixel color-map) average)))))))
finally (return color-map)))
 
(defun quantize-image (input-file output-file target-num-colors)
Jaydub
68

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/197894"