Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Ordering Colours Problem

by merrymonk (Hermit)
on Mar 05, 2021 at 11:08 UTC ( [id://11129152]=perlquestion: print w/replies, xml ) Need Help??

merrymonk has asked for the wisdom of the Perl Monks concerning the following question:

This is a list of hexadecimal values of some colours.
#000000
#716373
#704A2B
#AF7E45
#963049
#AA2261
#B24551
#E6212E
#FF0000
#001200
#FFDE72
#F55B73
I do know the individual values of the red, green and blue values for each of them.
Does any Monk know how to order these so that they are in the same order as the colours found on a normal ‘colour wheel?

Replies are listed 'Best First'.
Re: Ordering Colours Problem
by choroba (Cardinal) on Mar 05, 2021 at 12:47 UTC
    Based on Math behind Colourspace Conversions, I was able to at least sort the colours:
    #!/usr/bin/perl use warnings; use strict; use feature qw{ say }; sub hue { my ($colour) = @_; my %rgb; @rgb{qw{ red green blue }} = map hex($_) / 255, $colour =~ /^#(..) +(..)(..)/; my @order = sort { $rgb{$a} <=> $rgb{$b} } keys %rgb; my $hue = {red => sub { 0 + $rgb{green} - $rgb{blue}}, green => sub { 2 + $rgb{blue} - $rgb{red} }, blue => sub { 4 + $rgb{red} - $rgb{green} } }->{ $order[2] }->(); my $d = $rgb{ $order[2] } - $rgb{ $order[0]}; return 0 if 0 == $d; $hue /= $d; $hue *= 60; $hue += 360 if $hue < 0; return $hue } my @colours = do { no warnings 'qw'; qw( #000000 #716373 #704A2B #AF7E45 #963049 #AA2261 #B24551 #E6212E #FF0000 #001200 #FFDE72 #F55B73 + ) }; my %hue = map { $_ => hue($_) } @colours; my @sorted = sort { $hue{$a} <=> $hue{$b} } keys %hue; say "@sorted";
    The black/white problem is not solved here, so feel free to expand as you need.
    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
Re: Ordering Colours Problem
by johngg (Canon) on Mar 05, 2021 at 12:10 UTC

    As LanX says, there's all kinds of colour wheels. This page has an interesting interactive colour wheel that, when played around with, illustrates how tricky your problem is. I'm guessing that some maths to convert RGB values into angular values based on proportion would be a starting point but you then have the white/black question to resolve, which adds the third dimension.

    Cheers,

    JohnGG

Re: Ordering Colours Problem
by vr (Curate) on Mar 06, 2021 at 18:18 UTC

    Colour value is a point in 3d space, how would you "order" these points along (which?) single axis? That said, the "ordering" can be considered as TSP, where simple greedy nearest neighbour algorithm and arbitrarily/heuristically chosen starting point (black) produce "good enough" result. (The fact that black is among source colours (moreover, first) is irrelevant -- root isn't included in solution)

    Here are 5 colour ramps:

    • Original (unordered)
    • Sorted just by hue, according to choroba. Not for any absurd competition, but for illustration only, since there's png generating code below, anyway. Black appearing second after red is puzzling, though
    • NN result, where metric is euclidean distance in HSV space. See code. See Convert::Color
    • NN result, where metric is euclidean distance in HSL space (s/hsv/hsl/g in code below)
    • Throw some hard science at the problem. HSV/HSL are not perceptually uniform. Assuming RGB is sRGB, map colours to Lab colour space (a). At the time of its introduction, this space was designed to be perceptually uniform, but practice revealed it isn't. Therefore, let metric be not euclidean distance in Lab (CIEdE), but adjusted CIEdE2000 (b). Conversion (a) and metric (b) are not too difficult to implement in Perl by hand, but we have PDL::Transform::Color and PDL::Graphics::ColorDistance, so why not use them. See addendum after __END__, add use statements and replace 1,2,3 fragments with their counterparts.

    Well, how much scientific ramp is more "pleasing" is in the eye of beholder :). Maybe dumb NN is limiting factor here.

    use strict; use warnings; use feature 'say'; use Imager; use Convert::Color; use Convert::Color::RGB8; my @colors = map tr/#//dr, split "\n", <<'END_OF_COLORS'; #000000 #716373 #704A2B #AF7E45 #963049 #AA2261 #B24551 #E6212E #FF0000 #001200 #FFDE72 #F55B73 END_OF_COLORS my $HEIGHT = 50; my $TILE_W = 50; my $WIDTH = $TILE_W * @colors; my $START = '000000'; my $c = Convert::Color::RGB8-> new( $START ) # -> convert_to( 'hsv' ); # 1 my @data = map [ $_, Convert::Color::RGB8-> new( $_ )-> convert_to( 'hsv' ), # 2 0 ], @colors; my @sorted; my $len = 0; while ( @data ) { $_-> [ 2 ] = $_-> [ 1 ]-> dst_hsv( $c ) # 3 for @data; @data = sort { $a-> [ 2 ] <=> $b-> [ 2 ] } @data; $len += $data[ 0 ][ 2 ]; ( my $str, $c ) = @{ shift @data }; push @sorted, $str; } say $len; my $im = Imager-> new( xsize => $WIDTH, ysize => $HEIGHT, model => 'rgb' ); my $x = 0; for ( @sorted ) { $im-> box( filled => 1, xmin => $x, color => $_ ); $x += $TILE_W } $im-> write( file => 'result.png' ); __END__ use PDL; use PDL::Transform::Color; use PDL::Graphics::ColorDistance; my $c = t_lab-> apply((!t_srgb)-> apply( # pdl [ Convert::Color::RGB8-> new( $START )-> rgb8 ])); # 1 t_lab-> apply((!t_srgb)-> apply( # pdl [ Convert::Color::RGB8-> new( $_ )-> rgb8 ])), # 2 $_-> [ 2 ] = delta_e_2000( $_-> [ 1 ], $c ) # 3

    Edit: s/Through/Throw/ :)

      > Black appearing second after red is puzzling, though

      If you run my code several times, you'll see the black and red are sometimes swapped. That's because black is in fact the darkest possible red :-)

      map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

        Oh, I see: sort is performed on keys of derived hash, not original list. Hence the unstable result.

        In the page you linked to one finds the HLS model visualized as a cylinder = 2d-circle x height. (A round cake )

        While height is (L)umidity, does the distance to the circles center represent (S)aturation.

        The axis of that cylinder, the circles center (S=0) is the gray-scale, with black at the bottom (L=0) and white at the top (L=1) and belongs to all "colors" of that wheel.

        I.e one point on the wheel represents all colors in the rectangle formed by axis and angle. (The side of a cakepiece)

        Crazy!

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Re: Ordering Colours Problem
by LanX (Saint) on Mar 05, 2021 at 11:50 UTC
    There is no obvious standard for colour wheel and the examples given are 3d and can't easily be cooked down to a simple 1d circle.°

    So use sort or put more effort into your questions

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

    °) eg there is no black on the wheel!!!!

Re: Ordering Colours Problem
by kcott (Archbishop) on Mar 07, 2021 at 13:55 UTC

    G'day merrymonk,

    I saw this on Friday and couldn't think of a better answer than ++choroba's post. However, today (Sunday) I saw a spectrum presented as various shades of:

    red -> yellow -> green -> cyan -> blue -> magenta -> greyscale(white - +> black)

    If something along those lines suits your purpose, you can pull out, and possibly modify, parts of the following code, to get your desired result.

    #!/usr/bin/env perl use strict; use warnings; use List::Util 'uniq'; my @input; { no warnings 'qw'; push @input, [qw{ #000000 #0000ff #ff0000 #ffffff #00ff00 #ffff00 #00ffff #ff00ff #000000 #00007f #7f0000 #7f7f7f #007f00 #7f7f00 #007f7f #7f007f }], [qw{ #000000 #716373 #704A2B #AF7E45 #963049 #AA2261 #B24551 #E6212E #FF0000 #001200 #FFDE72 #F55B73 }]; } for my $i (0 .. $#input) { my %data; $data{$_} = [ map hex, /(..)(..)(..)$/ ] for uniq @{$input[$i]}; my @ordered; for my $prime (qw{R G B}) { for my $type (qw{rgb ycm}) { push @ordered, sort_colours(\%data, $type, $prime); } } push @ordered, sort_colours(\%data, qw{grey R}); print_table(\@ordered); } sub sort_colours { my ($data, $type, $prime) = @_; my @result; my @hier = $prime eq 'R' ? (0,1,2) : $prime eq 'G' ? (1,2,0) : (2,0,1); push @result, sort { $data->{$b}[$hier[0]] <=> $data->{$a}[$hier[0]] || $data->{$b}[$hier[1]] <=> $data->{$a}[$hier[1]] || $data->{$b}[$hier[2]] <=> $data->{$a}[$hier[2]] } grep { if ($type eq 'rgb') { $data->{$_}[$hier[1]] < $data->{$_}[$hier[0]] && $data->{$_}[$hier[0]] > $data->{$_}[$hier[2]] } elsif ($type eq 'ycm') { $data->{$_}[$hier[0]] == $data->{$_}[$hier[1]] && $data->{$_}[$hier[0]] > $data->{$_}[$hier[2]] } else { $data->{$_}[$hier[0]] == $data->{$_}[$hier[1]] && $data->{$_}[$hier[0]] == $data->{$_}[$hier[2]] } } keys %$data; return @result; } sub print_table { my ($colours) = @_; print qq{<table border="1">\n}; for (@$colours) { print qq{ <tr><th><tt>$_</tt></th><td bgcolor="$_" width="100 +">&nbsp;</td></tr>\n}; } print "</table>\n"; return; }

    As you can see, I added a separate array of evenly-spaced colours (mainly for my own testing purposes). The output, from print_table(), is PM-style HTML which I pasted directly into my post.

    With my test colours, I got the result I was looking for:

    #ff0000 
    #7f0000 
    #ffff00 
    #7f7f00 
    #00ff00 
    #007f00 
    #00ffff 
    #007f7f 
    #0000ff 
    #00007f 
    #ff00ff 
    #7f007f 
    #ffffff 
    #7f7f7f 
    #000000 

    Using the colours from your OP, the result is possibly not what you're after:

    #FFDE72 
    #FF0000 
    #F55B73 
    #E6212E 
    #B24551 
    #AF7E45 
    #AA2261 
    #963049 
    #704A2B 
    #001200 
    #716373 
    #000000 

    Some observations:

    • #FFDE72 has more red than green or blue; however, there's so much green that it appears yellowish.
    • #001200 is pure green; however, there's so little green that I can't distinguish it from black.
    • #716373 has almost identical red, green and blue: it looks more like a grey to me.
    "how to order these so that they are in the same order as the colours found on a normal colour wheel"

    If you told us what you believe the "normal colour wheel" order is, we would then at least know the expected results, and could potentially provide better answers.

    This general problem-space is interesting. I've front-paged this question to perhaps gain a wider coverage. It would be particularly useful if you would provide feedback to the responses you've received.

    — Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11129152]
Approved by Corion
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2024-03-29 02:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found