Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re: Ordering Colours Problem

by kcott (Archbishop)
on Mar 07, 2021 at 13:55 UTC ( [id://11129270]=note: print w/replies, xml ) Need Help??


in reply to Ordering Colours Problem

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: note [id://11129270]
help
Chatterbox?
and the web crawler heard nothing...

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

    No recent polls found