 full color
 Example: Gimp 16 color
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.


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