(untagged)

Generating Unique Contrasting Colors (in VB.NET)

Gregory Morse

0.00/5 (No votes)

8 Mar 2015

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:

C++

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

The code:

VB.NET

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.

VB.NET

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

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here