 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.


 
; ColorQuantization.pb
 
Structure bestA_ ; table for our histogram
nn.i ; 16,32,...
rc.i ; red   count within (0,1,...,255)/(number of colors)
gc.i ; green count within (0,1,...,255)/(number of colors)
bc.i ; blue  count within (0,1,...,255)/(number of colors)
EndStructure
 
; these two functions appear to be rather self-explanatory
UsePNGImageDecoder()
UsePNGImageEncoder()
 
Procedure.i ColorQuantization(Filename$,ncol)
Protected x,y,c
 
; load our original image or leave the procedure
If not LoadImage(0,Filename$)      :ProcedureReturn 0:endif
 
; we are not going to actually draw on the original image...
; but we need to use the drawing library to load up
; the pixel information into our arrays...
; if we can't do that, what's the point of going any further?
; so then we would be wise to just leave the procedure [happy fred?]
If not StartDrawing(ImageOutput(0)):ProcedureReturn 0:endif
 
iw=ImageWidth(0)
ih=ImageHeight(0)
 
dim cA(iw,ih) ; color array to hold at a given (x,y)
dim rA(iw,ih) ; red   array to hold at a given (x,y)
dim gA(iw,ih) ; green array to hold at a given (x,y)
dim bA(iw,ih) ; blue  array to hold at a given (x,y)
dim tA(iw,ih) ; temp  array to hold at a given (x,y)
 
; map each pixel from the original image to our arrays
; don't overrun the ranges ie. use {ih-1,iw-1}
for y=0 to ih-1
  for x=0 to iw-1
  c = Point(x,y)
  cA(x,y)=c
  rA(x,y)=Red(c)
  gA(x,y)=Green(c)
  bA(x,y)=Blue(c)
  next 
next 
 
StopDrawing() ; don't forget to... StopDrawing()
 
N=ih*iw
; N is the total number if pixels
if not N:ProcedureReturn 0:endif ; to avoid a division by zero
 
; stuctured array ie. a table to hold the frequency distribution
dim bestA.bestA_(ncol)
 
; the "best" red,green,blue based upon frequency 
dim rbestA(ncol/3)
dim gbestA(ncol/3)
dim bbestA(ncol/3)
 
; split the (0..255) range up
xoff=256/ncol   ;256/16=16
xrng=xoff       ;xrng=16
 
; store these values in our table: bestA(i)\nn= 16,32,...
for i=1 to ncol
xrng+xoff
bestA(i)\nn=xrng
next 
 
; scan by row [y] 
for y=0 to ih-1
; scan by col [x] 
for x=0 to iw-1
 
; retrieve the rgb values from each pixel 
r=rA(x,y)
g=gA(x,y)
b=bA(x,y)
 
; sum up the numbers that fall within our subdivisions of (0..255)
for i=1 to ncol
if r>=bestA(i)\nn and r<bestA(i+1)\nn:bestA(i)\rc+1:endif
if g>=bestA(i)\nn and g<bestA(i+1)\nn:bestA(i)\gc+1:endif
if b>=bestA(i)\nn and b<bestA(i+1)\nn:bestA(i)\bc+1:endif
next 
next 
next 
 
; option and type to: Sort our Structured Array
opt=#PB_Sort_Descending
typ=#PB_Sort_Integer
 
; sort to get most frequent reds
off=OffsetOf(bestA_\rc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)
 
; save the best [ for number of colors =16 this is int(16/3)=5 ] reds
for i=1 to ncol/3
rbestA(i)=bestA(i)\nn
next
 
; sort to get most frequent greens
off=OffsetOf(bestA_\gc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)
 
; save the best [ for number of colors =16 this is int(16/3)=5 ] greens
for i=1 to ncol/3
gbestA(i)=bestA(i)\nn
next
 
; sort to get most frequent blues
off=OffsetOf(bestA_\bc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)
 
; save the best [ for number of colors =16 this is int(16/3)=5 ] blues
for i=1 to ncol/3
bbestA(i)=bestA(i)\nn
next
 
; reset the best low value to 15 and high value to 240
; this helps to ensure there is some contrast when the statistics bunch up
; ie. when a single color tends to predominate... such as perhaps green?
rbestA(1)=15:rbestA(ncol/3)=240
gbestA(1)=15:gbestA(ncol/3)=240
bbestA(1)=15:bbestA(ncol/3)=240
 
; make a copy of our original image or leave the procedure
If not CopyImage(0,1)              :ProcedureReturn 0:endif
 
; draw on that copy of our original image or leave the procedure
If not StartDrawing(ImageOutput(1)):ProcedureReturn 0:endif
 
for y=0 to ih-1
for x=0 to iw-1
c = Point(x,y)
 
; get the rgb value from our arrays
rt=rA(x,y)
gt=gA(x,y)
bt=bA(x,y)
 
; given a particular red value say 123 at point x,y
; which of our rbestA(i's) is closest?
; then for green and blue?
; ==============================
r=255
for i=1 to ncol/3
rdiff=abs(rbestA(i)-rt)
if rdiff<=r:ri=i:r=rdiff:endif
next
 
g=255
for i=1 to ncol/3
gdiff=abs(gbestA(i)-gt)
if gdiff<=g:gi=i:g=gdiff:endif
next
 
b=255
for i=1 to ncol/3
bdiff=abs(bbestA(i)-bt)
if bdiff<=b:bi=i:b=bdiff:endif
next
; ==============================
 
 
; get the color value so we can plot it at that pixel
Color=RGB(rbestA(ri),gbestA(gi),bbestA(bi))
 
; plot it at that pixel
Plot(x,y,Color)
 
; save that info to tA(x,y) for our comparison image 
tA(x,y)=Color
 
next 
next 
StopDrawing() ; don't forget to... StopDrawing()
 
; create a comparison image of our original vs 16-color or leave the procedure
If not CreateImage(2,iw*2,ih)      :ProcedureReturn 0:endif
; draw on that image both our original image and our 16-color image or leave the procedure
If not StartDrawing(ImageOutput(2)):ProcedureReturn 0:endif
 
; plot original image
; 0,0 .... 511,0
; .
; .
; 511,0 .. 511,511
for y=0 to ih-1
  for x=0 to iw-1
  c = cA(x,y)
  Plot(x,y,c)
  next 
  next 
 
; plot 16-color image to the right of original image
; 512,0 .... 1023,0
; .
; .
; 512,511 .. 1023,511
for y=0 to ih-1
  for x=0 to iw-1
  c = tA(x,y)
  Plot(x+iw,y,c)
  next 
  next 
 
StopDrawing() ; don't forget to... StopDrawing()
 
; save the single 16-color image
SaveImage(1, "_single_"+str(ncol)+"_"+Filename$,#PB_ImagePlugin_PNG )
 
; save the comparison image
SaveImage(2, "_compare_"+str(ncol)+"_"+Filename$,#PB_ImagePlugin_PNG )
ProcedureReturn 1
EndProcedure
 
ColorQuantization("Quantum_frog.png",16)
 
 
 