How to resolve the algorithm Color quantization step by step in the Common Lisp programming language
How to resolve the algorithm Color quantization step by step in the Common Lisp programming language
Table of Contents
Problem Statement
Color quantization is the process of reducing number of colors used in an image while trying to maintain the visual appearance of the original image. In general, it is a form of cluster analysis, if each RGB color value is considered as a coordinate triple in the 3D colorspace. There are some well know algorithms [1], each with its own advantages and drawbacks. Task: Take an RGB color image and reduce its colors to some smaller number (< 256). For this task, use the frog as input and reduce colors to 16, and output the resulting colors. The chosen colors should be adaptive to the input image, meaning you should not use a fixed palette such as Web colors or Windows system palette. Dithering is not required. Note: the funny color bar on top of the frog image is intentional.
Let's start with the solution:
Step by Step solution about How to resolve the algorithm Color quantization step by step in the Common Lisp programming language
Source code in the common programming language
(defpackage #:quantize
(:use #:cl
#:opticl))
(in-package #:quantize)
(defun image->pixels (image)
(check-type image 8-bit-rgb-image)
(let (pixels)
(do-pixels (y x) image
(push (pixel* image y x) pixels))
pixels))
(defun greatest-color-range (pixels)
(loop for (r g b) in pixels
minimize r into r-min
minimize g into g-min
minimize b into b-min
maximize r into r-max
maximize g into g-max
maximize b into b-max
finally
(return (let* ((r-range (- r-max r-min))
(g-range (- g-max g-min))
(b-range (- b-max b-min))
(max-range (max r-range g-range b-range)))
(cond ((= r-range max-range) 0)
((= g-range max-range) 1)
(t 2))))))
(defun median-cut (pixels target-num-colors)
(assert (zerop (mod (log target-num-colors 2) 1)))
(if (or (= target-num-colors 1) (null (rest pixels)))
(list pixels)
(let* ((channel (greatest-color-range pixels))
(sorted (sort pixels #'< :key (lambda (pixel) (nth channel pixel))))
(half (floor (length sorted) 2))
(next-target (/ target-num-colors 2)))
(nconc (median-cut (subseq sorted 0 half) next-target)
(median-cut (subseq sorted half) next-target)))))
(defun quantize-colors (pixels target-num-colors)
(let ((color-map (make-hash-table :test #'equal)))
(dolist (bucket (median-cut pixels target-num-colors) color-map)
(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 (let ((average (list (round r-sum num-pixels)
(round g-sum num-pixels)
(round b-sum num-pixels))))
(dolist (pixel bucket)
(setf (gethash pixel color-map) average)))))))
(defun quantize-image (input-file output-file target-num-colors)
(let* ((image (read-png-file input-file))
(pixels (image->pixels image))
(color-map (quantize-colors pixels target-num-colors))
(result-image (with-image-bounds (height width) image
(make-8-bit-rgb-image height width :initial-element 0))))
(set-pixels (y x) result-image
(let* ((original (multiple-value-list (pixel image y x)))
(quantized (gethash original color-map)))
(values-list quantized)))
(write-png-file output-file result-image)))
You may also check:How to resolve the algorithm De Polignac numbers step by step in the Python programming language
You may also check:How to resolve the algorithm Compiler/lexical analyzer step by step in the Prolog programming language
You may also check:How to resolve the algorithm Radical of an integer step by step in the Java programming language
You may also check:How to resolve the algorithm Sort using a custom comparator step by step in the JavaScript programming language
You may also check:How to resolve the algorithm Text processing/1 step by step in the OCaml programming language