Color Matching in GAS - Desktop Liberation

Random blog posts

I covered the mathematics of color matching in the VBA implementation in Find nearest color match. This is the Google Apps Script implementation. I’ll be using the CIEDE2000 algorithm to measure the distance between colors.

One thing I discovered was that GAS is rather slow compared to plain javaScript or VBA for these compute intensive tasks so I can achieve a lot less before I run out of allocated compute time.

The source and data are the heatMap workbook described in Playing around with GAS color, and much use is made of a shared library, see – Using the mcpher library in your code

Page Content hide

1 Color Table matching

2 The gory details

Color Table matching

In Looking up color table I’ve built up a table of schemes such as Pantone, dulux etc through various web scraping sessions, and now have getting on for 10,000 named colors in that library. Here’s the GAS attempt at finding the closest matches to some random colors in a couple of the color schemes.

The gory details

These are implemented in Playing around with GAS color. Here’s the color match algorithm section.

Private Function computeH(a As Double, b As Double) As Double
    If (a = 0 And b = 0) Then
        computeH = 0
    ElseIf (b >= 0) Then
        computeH = Application.WorksheetFunction.Degrees(Application.WorksheetFunction.Atan2(a, b))
    Else
        computeH = Application.WorksheetFunction.Degrees(Application.WorksheetFunction.Atan2(a, b)) + 360
    End If
End Function

Private Function computeH(a As Double, b As Double) As Double

If (a = 0 And b = 0) Then

computeH = 0

ElseIf (b >= 0) Then

computeH = Application.WorksheetFunction.Degrees(Application.WorksheetFunction.Atan2(a, b))

Else

computeH = Application.WorksheetFunction.Degrees(Application.WorksheetFunction.Atan2(a, b)) + 360

End If

End Function

Public Function cieDe2000(p1 As colorProps, p2 As colorProps) As Double
' calculates the distance between 2 colors using CIEDE200
' see http://www.ece.rochester.edu/~gsharma/cieDe2000/cieDe2000noteCRNA.pdf
Dim c1 As Double, c2 As Double, _
c As Double, g As Double, a1 As Double, b1 As Double, _
a2 As Double, b2 As Double, c1Tick As Double, c2Tick As Double, _
h1 As Double, h2 As Double, dh As Double, dl As Double, dc As Double, _
lTickAvg As Double, cTickAvg As Double, hTickAvg As Double, l50 As Double, sl As Double, _
sc As Double, t As Double, sh As Double, dTheta As Double, kp As Double, _
rc As Double, kl As Double, kc As Double, kh As Double, dlk As Double, _
dck As Double, dhk As Double, rt As Double, dBigH As Double

kp = 25 ^ 7
kl = 1
kc = 1
kh = 1

' calculate c &amp;amp;amp; g values
c1 = Sqr(p1.aStar ^ 2 + p1.bStar ^ 2)
c2 = Sqr(p2.aStar ^ 2 + p2.bStar ^ 2)
c = (c1 + c2) / 2
g = 0.5 * (1 - Sqr(c ^ 7 / (c ^ 7 + kp)))

' adjusted ab*
a1 = (1 + g) * p1.aStar
a2 = (1 + g) * p2.aStar

' adjusted cs
c1Tick = Sqr(a1 ^ 2 + p1.bStar ^ 2)
c2Tick = Sqr(a2 ^ 2 + p2.bStar ^ 2)

' adjusted h
h1 = computeH(a1, p1.bStar)
h2 = computeH(a2, p2.bStar)

' deltas
If (h2 - h1 &amp;amp;gt; 180) Then '1
dh = h2 - h1 - 360
ElseIf (h2 - h1 &amp;amp;lt; -180) Then ' 2
dh = h2 - h1 + 360
Else '0
dh = h2 - h1
End If

dl = p2.LStar - p1.LStar
dc = c2Tick - c1Tick
dBigH = (2 * Sqr(c1Tick * c2Tick) * sIn(toRadians(dh / 2)))

' averages
lTickAvg = (p1.LStar + p2.LStar) / 2
cTickAvg = (c1Tick + c2Tick) / 2

If (c1Tick * c2Tick = 0) Then '3
hTickAvg = h1 + h2

ElseIf (Abs(h2 - h1) &amp;amp;lt;= 180) Then '0
hTickAvg = (h1 + h2) / 2

ElseIf (h2 + h1 &amp;amp;lt; 360) Then '1
hTickAvg = (h1 + h2) / 2 + 180

Else '2
hTickAvg = (h1 + h2) / 2 - 180
End If

l50 = (lTickAvg - 50) ^ 2
sl = 1 + (0.015 * l50 / Sqr(20 + l50))
sc = 1 + 0.045 * cTickAvg
t = 1 - 0.17 * Cos(toRadians(hTickAvg - 30)) + 0.24 * _
Cos(toRadians(2 * hTickAvg)) + 0.32 * _
Cos(toRadians(3 * hTickAvg + 6)) - 0.2 * _
Cos(toRadians(4 * hTickAvg - 63))

sh = 1 + 0.015 * cTickAvg * t

dTheta = 30 * Exp(-1 * ((hTickAvg - 275) / 25) ^ 2)
rc = 2 * Sqr(cTickAvg ^ 7 / (cTickAvg ^ 7 + kp))
rt = -sIn(toRadians(2 * dTheta)) * rc
dlk = dl / sl / kl
dck = dc / sc / kc
dhk = dBigH / sh / kh
cieDe2000 = Sqr(dlk ^ 2 + dck ^ 2 + dhk ^ 2 + rt * dck * dhk)

End Function

Public Function cieDe2000(p1 As colorProps, p2 As colorProps) As Double

' calculates the distance between 2 colors using CIEDE200

' see http://www.ece.rochester.edu/~gsharma/cieDe2000/cieDe2000noteCRNA.pdf

Dim c1 As Double, c2 As Double, _

c As Double, g As Double, a1 As Double, b1 As Double, _

a2 As Double, b2 As Double, c1Tick As Double, c2Tick As Double, _

h1 As Double, h2 As Double, dh As Double, dl As Double, dc As Double, _

lTickAvg As Double, cTickAvg As Double, hTickAvg As Double, l50 As Double, sl As Double, _

sc As Double, t As Double, sh As Double, dTheta As Double, kp As Double, _

rc As Double, kl As Double, kc As Double, kh As Double, dlk As Double, _

dck As Double, dhk As Double, rt As Double, dBigH As Double

kp = 25 ^ 7

kl = 1

kc = 1

kh = 1

' calculate c &amp;amp; g values

c1 = Sqr(p1.aStar ^ 2 + p1.bStar ^ 2)

c2 = Sqr(p2.aStar ^ 2 + p2.bStar ^ 2)

c = (c1 + c2) / 2

g = 0.5 * (1 - Sqr(c ^ 7 / (c ^ 7 + kp)))

' adjusted ab*

a1 = (1 + g) * p1.aStar

a2 = (1 + g) * p2.aStar

' adjusted cs

c1Tick = Sqr(a1 ^ 2 + p1.bStar ^ 2)

c2Tick = Sqr(a2 ^ 2 + p2.bStar ^ 2)

' adjusted h

h1 = computeH(a1, p1.bStar)

h2 = computeH(a2, p2.bStar)

' deltas

If (h2 - h1 &amp;gt; 180) Then '1

dh = h2 - h1 - 360

ElseIf (h2 - h1 &amp;lt; -180) Then ' 2

dh = h2 - h1 + 360

Else '0

dh = h2 - h1

End If

dl = p2.LStar - p1.LStar

dc = c2Tick - c1Tick

dBigH = (2 * Sqr(c1Tick * c2Tick) * sIn(toRadians(dh / 2)))

' averages

lTickAvg = (p1.LStar + p2.LStar) / 2

cTickAvg = (c1Tick + c2Tick) / 2

If (c1Tick * c2Tick = 0) Then '3

hTickAvg = h1 + h2

ElseIf (Abs(h2 - h1) &amp;lt;= 180) Then '0

hTickAvg = (h1 + h2) / 2

ElseIf (h2 + h1 &amp;lt; 360) Then '1

hTickAvg = (h1 + h2) / 2 + 180

Else '2

hTickAvg = (h1 + h2) / 2 - 180

End If

l50 = (lTickAvg - 50) ^ 2

sl = 1 + (0.015 * l50 / Sqr(20 + l50))

sc = 1 + 0.045 * cTickAvg

t = 1 - 0.17 * Cos(toRadians(hTickAvg - 30)) + 0.24 * _

Cos(toRadians(2 * hTickAvg)) + 0.32 * _

Cos(toRadians(3 * hTickAvg + 6)) - 0.2 * _

Cos(toRadians(4 * hTickAvg - 63))

sh = 1 + 0.015 * cTickAvg * t

dTheta = 30 * Exp(-1 * ((hTickAvg - 275) / 25) ^ 2)

rc = 2 * Sqr(cTickAvg ^ 7 / (cTickAvg ^ 7 + kp))

rt = -sIn(toRadians(2 * dTheta)) * rc

dlk = dl / sl / kl

dck = dc / sc / kc

dhk = dBigH / sh / kh

cieDe2000 = Sqr(dlk ^ 2 + dck ^ 2 + dhk ^ 2 + rt * dck * dhk)

End Function

Private Function rgbToLab(rgbColor As Long) As colorProps
    ' adapted from // http://www.easyrgb.com/
    Dim x As Double, y As Double, z As Double, _
        p As colorProps

    p = rgbToXyz(rgbColor)
    
    x = xyzCIECorrection(p.x / refWhiteX)
    y = xyzCIECorrection(p.y / refWhiteY)
    z = xyzCIECorrection(p.z / refWhiteZ)

    p.LStar = (116 * y) - 16
    p.aStar = 500 * (x - y)
    p.bStar = 200 * (y - z)

    rgbToLab = p
End Function

Private Function rgbToLab(rgbColor As Long) As colorProps

' adapted from // http://www.easyrgb.com/

Dim x As Double, y As Double, z As Double, _

p As colorProps

p = rgbToXyz(rgbColor)

x = xyzCIECorrection(p.x / refWhiteX)

y = xyzCIECorrection(p.y / refWhiteY)

z = xyzCIECorrection(p.z / refWhiteZ)

p.LStar = (116 * y) - 16

p.aStar = 500 * (x - y)

p.bStar = 200 * (y - z)

rgbToLab = p

End Function

Private Function rgbToXyz(rgbColor As Long) As colorProps
    ' adapted from // http://www.easyrgb.com/
    Dim r As Double, g As Double, b As Double, _
        p As colorProps
    
    r = xyzCorrection(rgbRed(rgbColor) / 255) * 100
    g = xyzCorrection(rgbGreen(rgbColor) / 255) * 100
    b = xyzCorrection(rgbBlue(rgbColor) / 255) * 100
    
    p.x = r * 0.4124 + g * 0.3576 + b * 0.1805
    p.y = r * 0.2126 + g * 0.7152 + b * 0.0722
    p.z = r * 0.0193 + g * 0.1192 + b * 0.9505

    rgbToXyz = p
End Function

Private Function rgbToXyz(rgbColor As Long) As colorProps

' adapted from // http://www.easyrgb.com/

Dim r As Double, g As Double, b As Double, _

p As colorProps

r = xyzCorrection(rgbRed(rgbColor) / 255) * 100

g = xyzCorrection(rgbGreen(rgbColor) / 255) * 100

b = xyzCorrection(rgbBlue(rgbColor) / 255) * 100

p.x = r * 0.4124 + g * 0.3576 + b * 0.1805

p.y = r * 0.2126 + g * 0.7152 + b * 0.0722

p.z = r * 0.0193 + g * 0.1192 + b * 0.9505

rgbToXyz = p

End Function

Private Function xyzCIECorrection(v As Double) As Double
    If (v > 0.008856) Then
        xyzCIECorrection = (v ^ (1 / 3))
    Else
        xyzCIECorrection = (7.787 * v) + (16 / 116)
    End If
End Function

Private Function xyzCIECorrection(v As Double) As Double

If (v > 0.008856) Then

xyzCIECorrection = (v ^ (1 / 3))

Else

xyzCIECorrection = (7.787 * v) + (16 / 116)

End If

End Function

Private Function xyzCorrection(v As Double) As Double
    If (v > 0.04045) Then
        xyzCorrection = ((v + 0.055) / 1.055) ^ 2.4
    Else
        xyzCorrection = v / 12.92
    End If
End Function

Private Function xyzCorrection(v As Double) As Double

If (v > 0.04045) Then

xyzCorrection = ((v + 0.055) / 1.055) ^ 2.4

Else

xyzCorrection = v / 12.92

End If

End Function

and here’ the test procedure that generated the above

Public Function compareColors(rgb1 As Long, rgb2 As Long, _
            Optional compareType As eCompareColor = eCompareColor.eccieDe2000) As Double
    Dim p1 As colorProps, p2 As colorProps
    p1 = makeColorProps(rgb1)
    p2 = makeColorProps(rgb2)
    Select Case compareType
        Case eCompareColor.eccieDe2000
            compareColors = cieDe2000(p1, p2)
            
        Case Else
            Debug.Assert False
    
    End Select
    
End Function

Public Function compareColors(rgb1 As Long, rgb2 As Long, _

Optional compareType As eCompareColor = eCompareColor.eccieDe2000) As Double

Dim p1 As colorProps, p2 As colorProps

p1 = makeColorProps(rgb1)

p2 = makeColorProps(rgb2)

Select Case compareType

Case eCompareColor.eccieDe2000

compareColors = cieDe2000(p1, p2)

Case Else

Debug.Assert False

End Select

End Function

More color related topics? Return to VBA to Apps Script topics here

All formats are available from O'Reilly, Amazon and all good bookshops. You can also read a preview on O'Reilly

A video course over about 8 hours and 70 lessons taking you through the basics of Apps Script and JavaScript. Available at O'Reilly, Amazon, Infinite Skills & all good media outlets

Google Apps Script for Beginners: A video course over about 8 hours and 70 lessons taking you through the basics of Apps Script and JavaScript. Available from O'Reilly, Infinite Skills and all good media outlets

bruce mcpherson is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License. Based on a work at http://www.mcpher.com. Permissions beyond the scope of this license may be available at code use guidelines