Perl101: Red to Green Gradient

Note: the following technique is not friendly to the color-blind.

I sometimes find that I want to visual data with color. Specifically, I want to use red for "bad" and "green" for good, with a linear gradient in between. As I'm often building Web pages, that means I want:

Color codeResult
#FF0000Bad
#FFFF00Bad-Average
#FFFF00Average
#7FFF00Average-Good
#00FF00Good

In other words, I want a smooth, linear gradient from red to green for any number in a range. I'm always hitting a search engine for an example, so I figured other people could use this, too.

As you will remember for your HTML color codes, they're often RGB numbers in three two-digit hexadecimal numbers, ranging from 0 (00) to 255 (FF). Thus, red is "FF0000", green is "00FF00" and blue is "0000FF". If you look at the above, you'll see that we start with red, have yellow "FFFF00" as the average and green "00FF00" as the good. In other words, from the bottom to the midpoint, we have red as FF and slide the green from 00 to FF. Then once we hit the midpoint, we keep green at FF and slide the red from FF to 00. Here's one way to write that:

my ( $min, $max ) = ( 1, 11 );

my $middle = ( $min + $max ) / 2;
my $scale = 255 / ( $middle - $min );

for my $num ( 0 .. 12 ) {
    if ( $num <= $min ) {
        print "FF0000\n";
    }
    elsif ( $num >= $max ) {
        print "00FF00\n";
    }
    elsif ( $num < $middle ) {
        printf "FF%02X00\n" => int( ( $num - $min ) * $scale );
    }
    else {
        printf "%02XFF00\n" => 255 - int( ( $num - $middle ) * $scale );
    }
}

Basically, we figure out the $middle where we're going to stop counting up the green and start counting down the red. We also calculate the $scale to know how to scale any given number from 0 to 255.

In the for loop, if we're less than the minimum, we just have red. If we're greater than the maximum, we just have green. For any other number, we figure out which side of the $middle we're on and calculate the 0 to 255 value. The confusing bit, though, might be in the printf value. The %02X format is the magic here. The "X" ensures that we convert our number to an upper-case hex value, while the "02" prefix ensures that the number 12 will be printed as "0C" and not just "C".

That's all well and good, but it's not flexible. I want a subroutine for that. Here's how I don't want to write it:

for my $num ( 0 .. 12 ) {
    print gradient(1, 11, $num), "\n";
}

sub gradient {
    my ( $min, $max, $num ) = @_;

    my $middle = ( $min + $max ) / 2;
    my $scale = 255 / ( $middle - $min );

    return "FF0000" if $num <= $min; # lower boundry
    return "00FF00" if $num >= $max; # upper boundary

    if ( $num < $middle ) {
        return sprintf "FF%02X00" => int( ( $num - $min ) * $scale );
    }
    else {
        return sprintf "%02XFF00" => 255 - int( ( $num - $middle ) * $scale );
    }
}

That actually works and it's a touch cleaner to read (no if/elsif chain), but I don't like having to pass the upper and lower every time, particularly since the task I'm working on now has several potential ranges. Thus, I have this:

my $gradient = gradient( 1, 11 );
for my $num ( 0 .. 12 ) {
    print $gradient->($num), "\n";
}

sub gradient {
    my ( $min, $max ) = @_;

    my $middle = ( $min + $max ) / 2;
    my $scale = 255 / ( $middle - $min );

    return sub {
        my $num = shift;
        return "FF0000" if $num <= $min;    # lower boundry
        return "00FF00" if $num >= $max;    # upper boundary

        if ( $num < $middle ) {
            return sprintf "FF%02X00" => int( ( $num - $min ) * $scale );
        }
        else {
            return
              sprintf "%02XFF00" => 255 - int( ( $num - $middle ) * $scale );
        }
    };
}

Now, instead of recalculating the scale every time, I calculate it once and return an anonymous subroutine reference. Because the sub is generated in the same lexical scope as the data I calculated, we say that it closes over those lexical variables and the returned anonymous subroutine is a closure. It now has its own private state and I can easily make gradients for several ranges:

my $one_to_ten = gradient(1, 10);
print $one_to_ten->(7);
my $next_gradient = gradient( 20, 70 );
print $next_gradient->(33);

In short, we have a nice, flexible gradient generating routine, along with a simple demonstration of a closure.

More importantly, we have a red/green gradient I can easily find using Google :)

#FF0000
#FF1100
#FF2300
#FF3400
#FF4600
#FF5700
#FF6900
#FF7B00
#FF8C00
#FF9E00
#FFAF00
#FFC100
#FFD300
#FFE400
#FFF600
#F7FF00
#E5FF00
#D4FF00
#C2FF00
#B0FF00
#9FFF00
#8DFF00
#7CFF00
#6AFF00
#58FF00
#47FF00
#35FF00
#24FF00
#12FF00
#00FF00

If you want to have fun with this, try adding error checking or making the choice of colors more flexible.

8 Comments

This is quite a naive way to calculate colour gradients, since linear interpolation in the RGB space will yield colours that are not "between" the two limits neither in hue or in intensity. IIRC it's possible to get better results with the appropriate matrix multiplication related to the gamma of your display. Of course, being colour-blind, I'm not the most appropriate person to appreciate the quality of the result :)

It's a pure hue shift with no changes to saturation or value (aka intensity).

An accurate red to green gradient would lower the value (from 100 to 50 and back up to 100) as it adjusted the hue. This results in red to reddish orange to rust to a dirty yellow to green which is not as pleasant on the eyes.

I'll code up an accurate red to green gradient tool later today.

If you want a means of producing more accurate gradients (where the hue and value/intensity shift while leaving saturation alone) then you could try the following.

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( min max );

my $steps = $ARGV[0];

usage() unless $steps > 3;

my $first = [ 0xFF, 0x00, 0x00 ];
my $last = [ 0x00, 0xFF, 0x00 ];

my $step = [
    step( $first->[0], $last->[0], $steps ),
    step( $first->[1], $last->[1], $steps ),
    step( $first->[2], $last->[2], $steps ),
];

my $gradients = [ ( undef ) x $steps ];
for my $i ( 0 .. $#{ $gradients } )
{
    if ( $i == 0 )
    {
        $gradients->[$i] = $first;
    }
    elsif ( $i == $#{ $gradients } )
    {
        $gradients->[$i] = $last;
    }
    else
    {
        $gradients->[$i] = [
            $gradients->[ $i - 1 ][0] + $step->[0],
            $gradients->[ $i - 1 ][1] + $step->[1],
            $gradients->[ $i - 1 ][2] + $step->[2],
        ];
    }
    printf "%02X%02X%02X  [ %1\$3s, %2\$3s, %3\$3s ]  h: %3s, s: %3s, v: %3s\n", @{ $gradients->[ $i ] }, @{ to_hsv( $gradients->[ $i ] ) };
}

exit( 0 );

# Algorithm found at http://www.cs.rit.edu/~ncs/color/t_convert.html
sub to_hsv
{
    my $color = shift;
    my ( $h, $s, $v );

    my $min = min( @{ $color } );
    my $max = max( @{ $color } );

    $v = $max;

    my $delta = $max - $min;

    if ( $max != 0 )
    {
        $s = ( $delta / $max ) * 100;
    }
    else
    {
        # red = green = blue = 0
        # s = 0, v is undef
        $s = 0;
        $h = -1;
        return [ $h, $s, $v ];
    }

    if ( $color->[0] == $max )
    {
        $h = ( $color->[1] - $color->[2] ) / $delta; # between yellow & magenta
    }
    elsif ( $color->[1] == $max )
    {
        $h = 2 + ( $color->[2] - $color->[0] ) / $delta; # between cyan & yellow
    }
    else
    {
        $h = 4 + ( $color->[0] - $color->[1] ) / $delta; # between magenta & cyan
    }

    $h *= 60; # degrees

    if ( $h < 0 )
    {
        $h += 360;
    }

    return [ int( $h ), int( $s ), int( $v ) ];
}

sub step
{
    my ( $first, $last, $steps ) = @_;

    $steps -= 1;

    my $sign = $last <=> $first;
    my $step = int( ( $first + $last ) / $steps );

    return $sign == 0 ? $step : $sign * $step;
}

sub usage
{
    print "Usage: $0 steps\n";
    print "  Steps must be greater than 3.\n";
    exit( 1 );
}

I had to do this a while back. I ended up with a short javascript function which creates a gradient for any number of colours by doing linear interpolation of the HSV values: http://stackoverflow.com/questions/3997241/do-all-my-moose-classes-have-to-contain-namespaceautoclean-and-make-immutabl

oops the previous comment should have this link: http://stackoverflow.com/questions/2593832/how-to-interpolate-hue-values-in-hsv-colour-space

(I can't see how to edit it though)

When I needed to do this, I whipped up Color::Spectrum::Multi, which is a simple wrapper around Color::Spectrum which allows you to specify more than two colours.

It lets you do, e.g.:

my @colours = Color::Spectrum::Multi::generate(
    10, '#FF0000', '#00FF00', '#0000FF'
);

Leave a comment

About Ovid

user-pic Have Perl; Will Travel. Freelance Perl/Testing/Agile consultant. Photo by http://www.circle23.com/. Warning: that site is not safe for work. The photographer is a good friend of mine, though, and it's appropriate to credit his work.