Color Matching in GAS

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

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

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

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

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 * _

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
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
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 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
```

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