Find the best 8 bit palette for an RGB image

[xlucas]

I believe this is a popular problem. Many programs do it, but it seems each does it their own way and the results are not always satisfying. Indexed graphics modes are not very used today, but 8 bit indexed images could be considered a very effective and simple way of lossy image compression, so I've been researching on it.

The problem: given a true colour RGB image of a certain size, possibly containing tens of thousands of colours or more, find the most suitable 256-colour palette in the shortest amount of time so that an approximation to the image made by indexing the values in the palette looks mostly the same as the original.

I've thought of the following possible solutions:

1 - Scan the image, save the first 256 distinct colours to the palette, then approximate all other colours with those. Quick, but dirty. Some images will look awful.
2 - Use a fixed palette that contains a little bit of everything. Quickest, result is often better than with option one, but the difference is always noticeable.
3 - Use a library of different fixed palettes (maybe 16 of them), try them each one by one and choose the one that looks better. This can be measured by adding the "distances" between the pixels RGB values and the resulting pixel colours for every point in the image, for each palette (distance being square root of the sum of the squares of the differences of R, G and B... or simplified, the sum of absolute values of the three differences; same thing, for the sake of ordering). This is a little bit better.
4 - Define a number of "buckets". One for white, another one for black and then for red, green, blue, magenta, cyan and yellow. Count the number of pixels that approximate better to each of these colours. Create a palette with more points for the most common ones. Yes, but how?
5 - Scan the image to find the most repeated colour and add it to the palette. Then scan again to look for the next and so on. Other colours will be approximated. This is good for very simple images, but photos and like have almost as many colours as pixels, so almost all colours appear only one in the image. It doesn't work.
6 - Scale down the image so that it contains fewer than 256 pixels and use cubic interpolation. Add the pixel colours to the palette. Then approximate the actual pixel colours with those colours. This sounds clever on first thought, but doesn't work well. brighter and darker colours are not well represented in the palette. Everything is "too average".
7 - Finally, I've thought of this idea. Seems great. Only problem is that it's too slow: Start with a palette that contains only pure black, one colour. Then iterate. On each iteration, scan the image looking for the pixel whose colour is farthest from all the colours currently in the palette. That is, add all distances. After the scan, add this colour to the palette and clear it from the image. Continue until either 256 colours have been added to the palette or the image has no more colours. Then approximate each pixel with the closest colour in the generated palette. The problem with this is that the whole image has to be scanned for each colour. In my computer, for an image about 640x480, this is taking about 10 seconds. Maybe if the code is optimised, I get it a little better. But I know procedures exist that can solve this in 3 to 5 seconds on a 386, because I had programs that did it in the 90s.

Any ideas? Anybody knows a better one?

[dafhi]

a worthy challenge :-)

[dodicat]

step 1
get the 256 colours from 8 bit screen to 32 bit values.

step 2
treat r,g,b as a point in 3D space.

step 3
The distance between colours is the distance between their r,g,b values as points in 3D space.

step 4
Get the closest distance and you get the closest colour.

Code: Select all

'8 bit to 32 bit
Sub set(clr() as ulong)
   ReDim As ULong tmp(101*101)
for i as integer = 0 to 255
   ScreenRes 100,100,8,,-1
   Dim As Any Ptr im=ImageCreate(100,100,,8)
   Paint im,(5,5),i
   BSave("tmp.bmp",im)
   ScreenRes 100,100,32,,-1
   BLoad("tmp.bmp",@tmp(0))
    clr(i)=tmp(50)
   ImageDestroy im:im=0
Next i
Kill "tmp.bmp"
End Sub


dim as ulong clr(255)

set(clr()) 'set colours 0 to 255 8 bit into 32 bit.

type pt  'simulate 3D space
as single x,y,z
end type

dim shared as pt a(255)
'set colours 0 to 255 as rgb (vectors)
for n as long=0 to 255
    '                  red                            green                       blue
        a(n)=type(Cptr(Ubyte Ptr,@clr(n))[2],Cptr(Ubyte Ptr,@clr(n))[1],Cptr(Ubyte Ptr,@clr(n))[0])
next
    
function closest(c() as ulong,v as ulong) as ulong
    dim as ulong res
     #define dist(p1,p2) (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y) + (p1.z-p2.z)*(p1.z-p2.z)
     'get r,g,b of v
    dim as pt pv=type(Cptr(Ubyte Ptr,@v)[2],Cptr(Ubyte Ptr,@v)[1],Cptr(Ubyte Ptr,@v)[0])
    dim as single dt=1e20
    for n as long=0 to 255
        var distance=dist(a(n),pv)
        if dt> distance then dt = distance:res=c(n) 'catch the smallest
    next n
    return res
end function

screen 19,32
'create an image with circles
dim as ulong col
dim as any ptr i=imagecreate(300,600,0)
for n as long=0 to 2000
    circle i,(rnd*300,rnd*600),2+rnd*20,rgb(rnd*255,rnd*255,rnd*255),,,,f
next

put(0,0),i,pset
draw string(10,2),"rgb colours"

'second image to hold the 256 colours
dim as any ptr im2=imagecreate(300,600,0)

for x as long=0 to 299
    for y as long=0 to 599
        col=closest(clr(),point(x,y,i))
        pset im2,(x,y),col
    next
next

put(400,0),im2,pset
draw string(400,2),"256 colours"
sleep
imagedestroy i
imagedestroy im2

 

[dafhi]

I did a rgb(rnd*255,0,0) on your circles, and it looks like the 8 bit pal has 4 shades of red. Which looks surprisingly good tbh.

But what I was looking to do in my previous attempts, and probably what xlucas wants as well, is a tailored palette.

[xlucas]

Dodicat: Yes, that's the easy part. It's not what I'm trying to do. I am not trying to adapt a 32bit RGB image to a specific palette. I'm trying to find the best palette to convert the 32bit image to 8bit indexed.

Formally, what I am trying to do is find any set of 256 RGB colours, composed each of a red, a green, and a blue component 8 bit each (alpha channel not to be considered) for a given image whose pixels are 24 bit deep (that is, the same structure as that of the palette colours), so that the total sum of all colour distances (defined like we both described, as a standard 3D distance, or square root of the sum of the squares of the differences of each component) for all pixels between the source image and the resulting 8bit indexed image is minimum.

I understand that squaring three times and then getting a square root is a slow process and in general, so what I do is optimise this. Since both square root and square power are strictly growing functions, I use the sum of the absolute values of the differences instead because, while the result will be very different, the order of the distances will be the same and the calculation will be a lot faster (perhaps 10 times). But that's just an optimisation. We can just reason making as if we were going to perform actual distance measuring.

Dafhi: Yes, I want the best palette for the image, not adapting the image to a given palette.

[dodicat]

This code was too slow,
Superceded below.

[bluatigro]

there are several options :

calculate image to grayscale
result : no colors

calculate 8r8g8b to 2r2g2b
result : 4 shades / color

1 count colors
if <= 255 ones you are done
2 sort colors on times there
take the most 255 ones in palete
problem :
wat do i do whit the lesser ones

[dodicat]

The 256 colours constituting 0 to 255 on an 8 bit screen give a good range for 32 bits.

Palette get using seems to get poor results.
However, it is an interesting topic, I am sure there will be other ideas put forward.
You should code up yours bluatigro, and let's have a look.

[dodicat]

Here is the simplest of my tries, yet the most effective.
Simply get 256 colours from the image pointer at regular intervals.
Colours shown on the console.
Bitmap option at the top of the code.

Code: Select all

#include "crt.bi"
#include "file.bi"

dim as string file="bob.bmp"

type pt  'simulate 3D space
as single x,y,z
end type

dim shared as pt a(255)
redim shared as ulong clr(255)

function spread256(i as ulong ptr) as long 'equidistant points
    dim as integer w,h,ctr
    imageinfo i,w,h
    dim as long sz=w*h
    for n as long=0 to sz step sz/256
        if ctr>255 then exit for
      clr(ctr)=i[n]
      ctr+=1
  next
  return 0
    end function
    
function closest(clr() as ulong,v as ulong) as ulong
    dim as ulong res
     '#define dist(p1,p2) (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y) + (p1.z-p2.z)*(p1.z-p2.z)
     #define dist(p1,p2) abs(p1.x-p2.x)+abs(p1.y-p2.y) + abs(p1.z-p2.z)
     'get r,g,b of v
    dim as pt pv=type(Cptr(Ubyte Ptr,@v)[2],Cptr(Ubyte Ptr,@v)[1],Cptr(Ubyte Ptr,@v)[0])
    dim as single dt=1e20
    for n as long=0 to 255
        var distance=dist(a(n),pv)
        if dt> distance then dt = distance:res=clr(n) 'catch the smallest
    next n
    return res
end function

function GetBmpSize(bmp as string,byref w as long,byref h as long) as long
    dim as long f = FreeFile()
    if fileexists(bmp) then
    open bmp for binary as #f
    get #f, 19,w
    get #f, 23,h
    close #f
    return w*h
   else
    print bmp; "  not found ... using degault image"
    return 0
    end if
end function
   
'===================== bitmap  ==================
screen 20,32
dim as ulong col
dim as long x,y
dim as any ptr i,im2

var v=getbmpsize(file,x,y)

if v then
    i=imagecreate(x,y)
    bload file,i
    im2=imagecreate(x,y)

cls
put(0,50),i,pset
draw string(10,2),"rgb colours  "

spread256(i)

'print to console
puts "Frequency             rgb colours"
for n as long=0 to ubound(clr)
   puts str((n)) + "                " + str(Cptr(Ubyte Ptr,@clr(n))[2])+"  " +str(Cptr(Ubyte Ptr,@clr(n))[1])+"   "+str(Cptr(Ubyte Ptr,@clr(n))[0])
next
'set colours  as rgb (vectors)
for n as long=0 to ubound(clr)
    '                  red                            green                       blue
        a(n)=type(Cptr(Ubyte Ptr,@clr(n))[2],Cptr(Ubyte Ptr,@clr(n))[1],Cptr(Ubyte Ptr,@clr(n))[0])
next

for xx as long=0 to x-1
    for yy as long=0 to y-1
        col=closest(clr(),point(xx,yy,i))
        pset im2,(xx,yy),col
    next
next

put(500,50),im2,pset
draw string(500,2),str(ubound(clr)+1) + " colours"

    else

'======================== no bitmap ========================

 i=imagecreate(300,600,0)
for n as long=0 to 50000
    circle i,(rnd*300,rnd*600),2+rnd*10,rgb(rnd*200,0,rnd*5),,,,f
next

cls
put(0,50),i,pset
draw string(10,2),"rgb colours,  "' &tot


spread256(i)

'print to console
puts "Frequency             rgb colours"
for n as long=0 to ubound(clr)
   puts str((n)) + "                " + str(Cptr(Ubyte Ptr,@clr(n))[2])+"  " +str(Cptr(Ubyte Ptr,@clr(n))[1])+"   "+str(Cptr(Ubyte Ptr,@clr(n))[0])
next


'set colours 0 to 255 as rgb (vectors)
for n as long=0 to 255
    '                  red                            green                       blue
        a(n)=type(Cptr(Ubyte Ptr,@clr(n))[2],Cptr(Ubyte Ptr,@clr(n))[1],Cptr(Ubyte Ptr,@clr(n))[0])
next


'second image to hold the 256 colours
 im2=imagecreate(300,600,0)

for x as long=0 to 299
    for y as long=0 to 599
        col=closest(clr(),point(x,y,i))
        pset im2,(x,y),col
    next
next

put(500,50),im2,pset
draw string(500,2),"256 colours"
end if


sleep
imagedestroy i
imagedestroy im2

 

  

[vdecampo]

I would resample the 888 RGB 24bit to 323 RGB 8Bit. At work right now but I could give it a try this evening.

-Vince

[xlucas]

Bluatigro: That is a clever idea. The problem, when I wanted to try something similar, is that most images you can download from the web, say, random images, both drawings and photos, contain colours in the order of tens of thousands to around a million. This means repetition of colours tends to be very low. Most colours are there only once. What I mean is, while only a few colours are "frequent", if you add all the pixels whose colour is there only once, you'll see they represent the image better than the ones that do have high frequency. Yet, if you try it and optimise it your own way, you may find tricks I haven't found.

Dodicat: I tried your code and I changed the colours of the circles to be more random and still seems to give nice results. I'm currently at work, so when I finish, I'll give it a closer inspection. My guess is that your method must be most effective with images that have many colours, but don't use gradients. Still, there is a chance even they work well because you pick equally spaced pixels, so the odds are that few of them will fall on the same small gradient, which should maximise "colour diversity". Also, your code is reasonably fast :)

Vince: What you suggest works. I've already done that. It's the fastest way to get a decent palette, but it doesn't give optimal results, especially for photos. Instead of 323, I'd suggest 332 because the human eye can detect green shades better than red shades and red shades better than blue shades. But even that won't be enough. Suppose you have an image that have tons of greens and blues, but little to no reds (a field in the day), then it would make sense for that picture to use 143 instead. Also, some pics may use a lot of, say, red, but all reds are average, not too dark, not too bright. Then lower and higher values should not be assigned. Just thinking.

I wrote the following code, but I've made a mistake at some point and it goes out with segmentation fault unless I disable the part that starts drawing the new image. It's incomplete, because it's not returning a palette. It was supposed to return the 8bit image. I'll modify it and post it again, but so far, here it is:

Code: Select all

Function Image32to8(img As Any Ptr, pal As Any Ptr) As Any Ptr
	Dim As Short i, j, n
	Dim As Integer w, h, bypp, spitch, dpitch
	Dim img2 As Any Ptr
	Dim As UByte Ptr dstart, dlin
	Dim As ULong Ptr sstart, slin
	Dim bpal As UByte Ptr
	Dim col(0 To 255) As ULong, test As ULong
	Dim maxdif As LongInt, maxcol As ULong
	Dim As UByte r1, r2, g1, g2, b1, b2
	Dim curcol As UByte = 0
	
	bpal = pal
	
	ImageInfo img, w, h, bypp, spitch, sstart
	If bypp <> 4 Then Return 0
	
	img2 = ImageCreate(w, h, 0, 8)
	ImageInfo img2, , , , dpitch, dstart
	
	'Black colour always pushed into the palette
	col(0) = &HFF000000
	
	Do
		slin = sstart
		dlin = dstart
		maxdif = 0
		For j = 0 To h - 1
			slin += spitch
			dlin += dpitch
			For i = 0 To w - 1
				test = slin[i]
				
				If test = col(curcol) Then
					slin[i] = &HFF000000
					'dlin[i] = curcol   '<-- This thing is acting up, so I've commented it out
				ElseIf test <> &HFF000000 Then
					Dim dif As LongInt
					
					dif = 0
					r1 = (test ShR 16) And 255
					g1 = (test ShR 8) And 255
					b1 = test And 255
					For n = 0 To curcol
						r2 = (col(n) ShR 16) And 255
						g2 = (col(n) ShR 8) And 255
						b2 = col(n) And 255
						dif += Abs(r2 - r1) + Abs(g2 - g1) + Abs(b2 - b1)
					Next n
					If dif > maxdif Then
						maxdif = dif
						maxcol = test
					End If
				End If
			Next i
		Next j
		
		If maxdif = 0 Then Exit Do
		curcol += 1
		col(curcol) = maxcol
		
		Locate , 1
		Print curcol;
	Loop Until curcol = 255
	
	Return img2
End Function

What this thing is doing is what I described at the end of my last message. It rescans the image over and over in search for the colour that's the furthest from all present colours in the palette. I'll work more on it and repost it. I expect it to be pretty good, but slow, and will have one problem: for images that contain noise, it will concentrate on the noise and the image itself will lose quality.

[BasicCoder2]

I added two lines to the end of dodicat's program to save the two images.

Code: Select all

sleep
bsave "image1.bmp",i
bsave "image2.bmp",im2
imagedestroy i
imagedestroy im2

Then I used this program to compare the changes by tapping the space bar.
Indeed I think this is the easiest way to compare the difference between two image.
Perhaps an algorithm could use the same test and correct for the largest variations found.

Code: Select all

screenres 300,600,32
dim as any ptr image1,image2
image1 = imagecreate(300,600)
image2 = imagecreate(300,600)
bload "image1.bmp",image1
bload "image2.bmp",image2
do
    screenlock
    cls
    put (0,0),image1
    screenunlock
    while inkey="":wend
    while inkey<>"":wend
    screenlock
    cls
    put (0,0),image2
    screenunlock
    while inkey="":wend
    while inkey<>"":wend
loop until multikey(&H01)

Also I would suggest that the human visual system could be taken into account for grouping rgb values that we find different vs. those that look much the same?
The color stripes in the rainbow are created in the brain as a result of how we group the color spectrum, they do not actually exist in the rainbow itself which is a continuous change in color (wave length).
Another thought is that the darker the color the less important it is. Two dark colors may look more alike than a brighter version of the same two colors?
.

[D.J.Peters]

I self use a RGB 3:3:2 256 color table and dithering.

Joshy

Left full RGB right only 256 colors :-)

Code: Select all

' Copyright D.J.Peters (Joshy) 

dim shared as integer rtab(1,15) = { _
  {-16,  4, -1, 11,-14,  6, -3,  9,-15,  5, -2, 10,-13,  7, -4,  8}, _
  { 15, -5,  0,-12, 13, -7,  2,-10, 14, -6,  1,-11, 12, -8,  3, -9}} 
dim shared as integer gtab(1,15) = { _
  { 11,-15,  7, -3,  8,-14,  4, -2, 10,-16,  6, -4,  9,-13,  5, -1}, _
  {-12, 14, -8,  2, -9, 13, -5,  1,-11, 15, -7,  3,-10, 12, -6,  0}} 
dim shared as integer btab(1,15) = { _
  { -3,  9,-13,  7, -1, 11,-15,  5, -4,  8,-14,  6, -2, 10,-16,  4}, _
  {  2,-10, 12, -8,  0,-12, 14, -6,  3, -9, 13, -7,  1,-11, 15, -5}} 

' create RGB 3:3:2 Palette (rrrgggbb) 
sub Palette332() 
  dim as integer i,r,g,b 
  for i = 0 to 255 
    r=(((i shr 5) and &H07) * 255) / 7 
    g=(((i shr 2) and &H07) * 255) / 7 
    b=(((i shr 0) and &H03) * 255) / 3 
    palette i,r,g,b 
  next 
end sub 

'r,g,b dithering to rrrgggbb 
sub dither332(byval x as single, _
              byval y as single, _
              byval r as integer, _
              byval g as integer, _
              byval b as integer) 
  dim as integer i,j 
  i=int(y) mod 16:j=int(x) mod 2 
  r+=rtab(j,i)
  g+=gtab(j,i)
  b+=btab(j,i) 
  if (r > 255) then 
    r=224 ' &HE0 
  elseif r>0 then 
    r=r and &HE0 
  else 
    r=0 
  end if 
  if (g > 255) then 
    g=28 ' &HE0 shr 3 
  elseif g>0 then 
    g=(g and &HE0) shr 3 
  else 
    g=0 
  end if 
  if (b > 255) then 
    b=3 ' &HC0 shr 6 
  elseif b>0 then 
    b=(b and &HC0) shr 6 
  else 
    b=0 
  end if 
  i=r or g or b 
  pset(x,y),i 
end sub 

union RGB32
  type field=1 
   as ubyte b,g,r,a
  end type
  as ulong col32
end union

''' main 
dim as RGB32   c
dim as integer pitch
dim as ulong ptr pixels,row

ScreenRes 360,520,32
var RGBimg = imagecreate(360,520)
imageinfo RGBimg,,,,pitch,pixels
pitch shr=2 ' bytes to ulong
bload "test.bmp",RGBimg
put (0,0),RGBimg,pset
ScreenRes 360,520,8
Palette332
row=pixels
for y as integer = 0 to 519
  for x as integer = 0 to 359
    c.col32=row[x]
    dither332(x,y,c.r,c.g,c.b) 
  next
  row+=pitch
next
bsave "256color.bmp",0
sleep

[UEZ]

The more interesting challenge is to convert an image to 16 colors. When I have some free time I will port my AutoIt code to FreeBasic. The result isn't that bad compared to e.g. IrfanView or to other methods (median cut color quantization, Wu color quantizer, etc.).

@D.J.Peters (Joshy): your code does not use the full 256 color spectrum - only 203 colors. ;-)

Sneak preview:

16 colors / 255 colors / 43344 colors


So long.

[BasicCoder2]

I self use a RGB 3:3:2 256 color table and dithering.

Horizontal lines appear?
Dodicat's version of your image produces color contours.
.