Generating Unique Contrasting Colors (in VB.NET)

Gregory Morse

5.00/5 (2 votes)

Mar 9, 2015

CPOL

3 min read

19971

Generating Unique Contrasting Colors

Introduction

Sometimes, it is useful for writing text or graphs to have a sequence of N generated unique contrasting colors. For reading, the background color and contrast not only to the background but to the other colors is important making this even more difficult than a general graph use.

A color search and comparison algorithm must be used which generally also requires an alternate color coordinate system. This example will use the CMC I:c color measurement algorithm with LAB color space as it is far more accurate than RGB (red green blue) which the system uses to draw to the screen or HSV (hue saturation value). Searching is an even more problematic subject as the threshold of comparison requires an exponential matches squared amount of comparisons and finding the optimal closed sequence would ultimately amount to a P=NP coloring problem so using an incremental heuristical searching strategy is required.

Background

Taken from Wikipedia

A Lab color space is a color-opponent space with dimension L for lightness and a and b for the color-opponent dimensions, based on nonlinearly compressed (e.g. CIE XYZ color space) coordinates. The terminology originates from the three dimensions of the Hunter 1948 color space, which are L, a, and b.

CMC l:c (1984)[edit]

In 1984, the Colour Measurement Committee of the Society of Dyers and Colourists defined a difference measure, also based on the L*C*h color model. Named after the developing committee, their metric is called CMC l:c. The quasimetric has two parameters: lightness (l) and chroma (c), allowing the users to weight the difference based on the ratio of l:c that is deemed appropriate for the application. Commonly used values are 2:1^[15] for acceptability and 1:1 for the threshold of imperceptibility.

The distance of a color $(L^*_2,C^*_2,h_2)$ to a reference $(L^*_1,C^*_1,h_1)$ is:^[16]

\Delta E^*_{CMC} = \sqrt{ \left( \frac{L^*_2-L^*_1}{l S_L} \right)^2 + \left( \frac{C^*_2-C^*_1}{c S_C} \right)^2 + \left( \frac{\Delta H^*_{ab}}{S_H} \right)^2 }

$S_L=\begin{cases} 0.511 & L^*_1 < 16 \\ \frac{0.040975 L^*_1}{1+0.01765 L^*_1} & L^*_1 \geq 16 \end{cases} \quad S_C=\frac{0.0638 C^*_1}{1+0.0131 C^*_1} + 0.638 \quad S_H=S_C (FT+1-F)$

$F = \sqrt{\frac{C^{*^4}_1}{C^{*^4}_1+1900}} \quad T=\begin{cases} 0.56 + |0.2 \cos (h_1+168^\circ)| & 164^\circ \leq h_1 \leq 345^\circ \\ 0.36 + |0.4 \cos (h_1+35^\circ) | & \mbox{otherwise} \end{cases}$

CMC l:c is designed to be used with D65 and the CIE Supplementary Observer.^[17]

Using the Code

Using the code:

'Call like this for 10 colors, with a minimum threshold of 15 and interleaving of 5
GenerateNDistinctColors(10, 15, 5)

The code:

    Public Structure XYZColor
        Public X As Double
        Public Y As Double
        Public Z As Double
    End Structure
    Public Shared WhiteReference As New XYZColor With {.X = 95.047, .Y = 100.0, .Z = 108.883}
    Public Const Epsilon As Double = 0.008856 'Intent is 216/24389
    Public Const Kappa As Double = 903.3 'Intent is 24389/27
    Public Shared Function PivotRGB(N As Double) As Double
        Return If(N > 0.04045, Math.Pow((N + 0.055) / 1.055, 2.4), N / 12.92) * 100.0
    End Function
    Public Shared Function ToRGB(N As Double) As Double
        Dim Result As Double = N * 255.0
        If Result < 0 Then Return 0
        If Result > 255 Then Return 255
        Return Result
    End Function
    Public Shared Function RGBToXYZ(clr As Color) As XYZColor
        Dim r As Double = PivotRGB(clr.R / 255.0)
        Dim g As Double = PivotRGB(clr.G / 255.0)
        Dim b As Double = PivotRGB(clr.B / 255.0)
        Return New XYZColor With {.X = r * 0.4124 + g * 0.3576 + b * 0.1805, _
                                  .Y = r * 0.2126 + g * 0.7152 + b * 0.0722, _
                                  .Z = r * 0.0193 + g * 0.1192 + b * 0.9505}
    End Function
    Public Shared Function XYZToRGB(clr As XYZColor) As Color
        Dim x As Double = clr.X / 100.0
        Dim y As Double = clr.Y / 100.0
        Dim z As Double = clr.Z / 100.0
        Dim r As Double = x * 3.2406 + y * -1.5372 + z * -0.4986
        Dim g As Double = x * -0.9689 + y * 1.8758 + z * 0.0415
        Dim b As Double = x * 0.0557 + y * -0.204 + z * 1.057
        r = If(r > 0.0031308, 1.055 * Math.Pow(r, 1 / 2.4) - 0.055, 12.92 * r)
        g = If(g > 0.0031308, 1.055 * Math.Pow(g, 1 / 2.4) - 0.055, 12.92 * g)
        b = If(b > 0.0031308, 1.055 * Math.Pow(b, 1 / 2.4) - 0.055, 12.92 * b)
        Return Color.FromArgb(CInt(ToRGB(r)), CInt(ToRGB(g)), CInt(ToRGB(b)))
    End Function
    Public Structure LABColor
        Public L As Double
        Public A As Double
        Public B As Double
    End Structure
    Public Shared Function PivotXYZ(N As Double) As Double
        Return If(N > Epsilon, Math.Pow(N, 1.0 / 3.0), (Kappa * N + 16) / 116)
    End Function
    Public Shared Function RGBToLAB(clr As Color) As LABColor
        Dim XYZCol As XYZColor = RGBToXYZ(clr)
        Dim x As Double = PivotXYZ(XYZCol.X / WhiteReference.X)
        Dim y As Double = PivotXYZ(XYZCol.Y / WhiteReference.Y)
        Dim z As Double = PivotXYZ(XYZCol.Z / WhiteReference.Z)
        Return New LABColor With {.L = Math.Max(0, 116 * y - 16), .A = 500 * (x - y), .B = 200 * (y - z)}
    End Function
    Public Shared Function LABToRGB(clr As LABColor) As Color
        Dim y As Double = (clr.L + 16.0) / 116.0
        Dim x As Double = clr.A / 500.0 + y
        Dim z As Double = y - clr.B / 200.0
        Dim X3 As Double = x * x * x
        Dim Z3 As Double = z * z * z
        Return XYZToRGB(New XYZColor With {.X = WhiteReference.X * _
        If(X3 > Epsilon, X3, (x - 16.0 / 116.0) / 7.787), _
                                         .Y = WhiteReference.Y * _
                                         If(clr.L > (Kappa * Epsilon), _
                                         Math.Pow((clr.L + 16.0) / 116.0, 3), _
                                         clr.L / Kappa), _
                                         .Z = WhiteReference.Z * If(Z3 > _
                                         Epsilon, Z3, (z - 16.0 / 116.0) / 7.787)})
    End Function
    Public Shared Function CMCCompareColors_
    (ColorA As LABColor, ColorB As LABColor, Lightness As Double, Chroma As Double) As Double
        Dim deltaL As Double = ColorA.L - ColorB.L
        Dim h As Double = Math.Atan2(ColorB.B, ColorA.A)
        Dim C1 As Double = Math.Sqrt(ColorA.A * ColorA.A + ColorA.B * ColorA.B)
        Dim C2 As Double = Math.Sqrt(ColorB.A * ColorB.A + ColorB.B * ColorB.B)
        Dim deltaC As Double = C1 - C2
        Dim deltaH As Double = Math.Sqrt((ColorA.A - ColorB.A) * _
        (ColorA.A - ColorB.A) + (ColorA.B - ColorB.B) * (ColorA.B - ColorB.B) - deltaC * deltaC)
        Dim C1_4 As Double = C1 * C1
        C1_4 *= C1_4
        Dim t As Double = If(164 <= h Or h >= 345, 0.56 + _
        Math.Abs(0.2 * Math.Cos(h + 168.0)), 0.36 + Math.Abs(0.4 * Math.Cos(h + 35.0)))
        Dim f As Double = Math.Sqrt(C1_4 / (C1_4 + 1900.0))
        Dim sL As Double = If(ColorA.L < 16, 0.511, _
        (0.040975 * ColorA.L) / (1.0 + 0.01765 * ColorA.L))
        Dim sC As Double = (0.0638 * C1) / (1 + 0.0131 * C1) + 0.638
        Dim sH As Double = sC * (f * t + 1 - f)
        Return Math.Sqrt(deltaL * deltaL / (Lightness * Lightness * sL * sL) + _
        deltaC * deltaC / (Chroma * Chroma * sC * sC) + deltaH * deltaH / (sH * sH))
    End Function
    Public Shared Function GCD(A As Integer, B As Integer) As Integer 'Euclid's algorithm
        If B = 0 Then Return A
        Return GCD(B, A Mod B)
    End Function
    Public Shared Function GenerateNDistinctColors_
    (N As Integer, Threshold As Integer, Interleave As Integer) As Color()
        'To best support individuals with colorblindness _
        (deuteranopia or protanopia) keep a set to 0; vary only L and b.
        Dim LABColors As New List(Of LABColor)
        Dim LowThresholds As New List(Of Double)
        LABColors.Add(RGBToLAB(Color.Black)) 'Start with pivot forecolor
        LowThresholds.Add(100)
        LABColors.Add(RGBToLAB(Color.White)) 'Start with background color
        LowThresholds.Add(100)
        For A = 0 To 200 'Pivot around 0 and move towards 100/-100
            For L = 0 To 100 / 2 'dark to light yet for readability do not exceed half of the spectrum
                For B = 0 To 200 'Pivot around 0 and move towards 100/-100
                    Dim CurColCount As Integer
                    Dim LowThreshold As Double = 100
                    For CurColCount = 0 To LABColors.Count - 1
                        LowThreshold = Math.Min(LowThreshold, CMCCompareColors_
                        (LABColors(CurColCount), New LABColor With {.L = L, .A = ((A \ 2) + _
                        If((A Mod 2) = 1, 1, 0)) * If((A Mod 2) = 1, 1, -1), .B = ((B \ 2) + _
                        If((B Mod 2) = 1, 1, 0)) * If((B Mod 2) = 1, 1, -1)}, 1.0, 1.0))
                        If LowThreshold < Threshold Then Exit For
                    Next
                    If CurColCount = LABColors.Count Then
                        Dim Idx As Integer = LowThresholds.BinarySearch(LowThreshold)
                        If Idx < 0 Then Idx = Idx Xor -1
                        If Idx <> 0 Or LowThresholds.Count <> N + 1 Then
                            LABColors.Insert(Idx, New LABColor With {.L = L, .A = ((A \ 2) + _
                            If((A Mod 2) = 1, 1, 0)) * If((A Mod 2) = 1, 1, -1), .B = ((B \ 2) + _
                            If((B Mod 2) = 1, 1, 0)) * If((B Mod 2) = 1, 1, -1)})
                            LowThresholds.Insert(Idx, LowThreshold)
                            If LowThresholds.Count > N + 1 Then
                                LABColors.RemoveAt(0)
                                LowThresholds.RemoveAt(0)
                            End If
                        End If
                    End If
                Next
            Next
            If LABColors.Count >= N + 1 Then Exit For
        Next
        LABColors.RemoveAt(N) 'Remove background color
        'if less than N colors found then try with lower threshold
        If LABColors.Count < N Then Return GenerateNDistinctColors(N, Threshold - 1, Interleave)
        Dim Cols(N - 1) As Color
        For Count As Integer = 0 To N - 1
            'Least Common Multiple LCM = a * b \ GCD(A, B)
            Cols((Count * Interleave) \ (N * Interleave \ GCD(N, Interleave)) + _
            (Count * Interleave) Mod N) = LABToRGB(LABColors(Count))
        Next
        Return Cols
    End Function

Example Colorizing Regular Expressions

This topic may be worthy of a separate article but provides a good example of how readability for debugging complex regular expressions would use such a coloring algorithm and the need for it in terms of readability when most uses are for graphing.

Public Class RenderArray
    Enum RenderDisplayClass
        eNested
        eArabic
        eTransliteration
        eLTR
        eRTL
        eContinueStop
        eRanking
        eList
        eTag
        eLink
        ePassThru
    End Enum
    Structure RenderText
        Public DisplayClass As RenderDisplayClass
        Public Clr As Color
        Public Text As Object
        Public Font As String
        Sub New(ByVal NewDisplayClass As RenderDisplayClass, ByVal NewText As Object)
            DisplayClass = NewDisplayClass
            Text = NewText
            Clr = Color.Black 'default
            Font = String.Empty
        End Sub
    End Structure
End Class
    Public Shared Function ColorizeList(Strs As String(), _
    bArabic As Boolean) As RenderArray.RenderText()
        Dim Cols As Color() = GenerateNDistinctColors(Strs.Length + 1, 15, 5)
        Dim Renderers As New List(Of RenderArray.RenderText)
        For Count As Integer = 0 To Strs.Length - 1
            Renderers.Add(New RenderArray.RenderText(If(bArabic, _
            RenderArray.RenderDisplayClass.eArabic, RenderArray.RenderDisplayClass.eLTR), _
            Strs(Count) + If(Not bArabic And (Strs(Count) = String.Empty Or _
            Strs(Count) = CStr(ArabicData.LeftToRightMark)), "NULL" + _
            CStr(Count), String.Empty)) With {.Clr = Cols(Count + 1)})
            If Not bArabic And Count <> Strs.Length - 1 _
            Then Renderers.Add(New RenderArray.RenderText_
            (RenderArray.RenderDisplayClass.eLTR, ";"))
        Next
        Return Renderers.ToArray()
    End Function
    Public Shared Function ColorizeRegExGroups(Str As String, _
    bReplaceGroup As Boolean) As RenderArray.RenderText()
        'Define an numeric partial ordering of groups that 
        'is non-contiguous based on their nearest parent parenthesis
        Dim ParenPos As New List(Of Integer)
        For Count As Integer = 0 To Str.Length - 1
            ParenPos.Add(0)
        Next
        Dim CurNum As Integer = 0
        Dim NumStack As New Stack(Of Integer())
        Dim Matches As System.Text.RegularExpressions.MatchCollection = _
        System.Text.RegularExpressions.Regex.Matches(Str, If(bReplaceGroup, _
        "(\\\$)?(\$\d+)", "(\\\(|\\\))?(\(\??|\))"))
        For MatchCount As Integer = 0 To Matches.Count - 1
            If Matches(MatchCount).Groups(2).Value.Chars(0) = "$" Then
                Dim Num As Integer = Integer.Parse(Matches(MatchCount).Groups(2).Value.Substring(1))
                CurNum = Math.Max(CurNum, Num)
                For Count As Integer = Matches(MatchCount).Groups(2).Index _
                To Matches(MatchCount).Groups(2).Index + Matches(MatchCount).Groups(2).Length - 1
                    ParenPos(Count) = Num
                Next
            ElseIf Matches(MatchCount).Groups(2).Value.Chars(0) = "("c Then
                If Matches(MatchCount).Groups(2).Value.Length = 1 Then CurNum += 1
                NumStack.Push(New Integer() {CurNum, _
                If(Matches(MatchCount).Groups(2).Value.Length = 1, _
                Matches(MatchCount).Groups(2).Index, Str.Length)})
            Else
                Debug.Assert(NumStack.Count <> 0) 'Misbalance parenthesis is exception
                Dim Nums As Integer() = NumStack.Pop()
                For Count As Integer = Nums(1) To Matches(MatchCount).Groups(2).Index
                    If Nums(0) > ParenPos(Count) Then ParenPos(Count) = Nums(0)
                Next
            End If
        Next
        Debug.Assert(NumStack.Count = 0) 'Misbalance parenthesis is exception
        'Proper coloring requires that parent-child and neighboring siblings have different colors
        'yet the current partial ordering does not define either of those relationships
        'must maintain neighbor and color list to properly color
        Dim Base As Integer = 0
        Dim Cols As Color() = GenerateNDistinctColors(CurNum + 1, 15, 5)
        Dim Renderers As New List(Of RenderArray.RenderText)
        For Count As Integer = 0 To ParenPos.Count - 1
            If Count = ParenPos.Count - 1 Then
                Renderers.Add(New RenderArray.RenderText(RenderArray.RenderDisplayClass.eLTR, _
                Str.Substring(Base)) With {.Clr = Cols(ParenPos(Count))})
            ElseIf ParenPos(Count) <> ParenPos(Count + 1) Then
                Renderers.Add(New RenderArray.RenderText(RenderArray.RenderDisplayClass.eLTR, _
                Str.Substring(Base, Count - Base + 1)) With {.Clr = Cols(ParenPos(Count))})
                Base = Count + 1
            End If
        Next
        Return Renderers.ToArray()
    End Function

Sample View

Points of Interest

Color searching is a P=NP problem. Incremental heuristical searching can make it feasible. Finding the absolute best most contrasting colors is very time consuming and requires an exhaustive brute force search. It also requires a multiple color comparison judgement as one of colors may have a higher average threshold but individually have some weak links. Multiple color comparison algorithms are not explored.

Color comparison needs to use a good algorithm and can ideally take into account color blindness to start searching with universally easy to decipher colors.

Unique contrasting colors for reading is different than for graphing as the background color must be more strongly contrasted as reading is different from other color usages.

Several coordinate systems from RGB, LAB, XYZ and HSV and conversion between them are useful to have wrapped in a library to make comparison easy.

History

Version 1.0