in reply to Re^2: Mapping function values to colors
in thread Mapping function values to colors

However,I will be concerned about the granularity of this,and also,because my values have a peak of 485 now, it's all shown in a blue nuances.

Seems I did a piss poor job of extracting and generalising the routine from where I was using it. I've updated ColorRamp1785 with the improved version used below.

But soon I will probably have higher values , maybe 1000,maybe 100000 ... it's not as easy as I thought(looking on your code) to deal with those high numbers as well.

The following shows a few different possibilities. Try running it with a few of the following command lines to see the effects: 

>euclid -MAPPING=C                ## the original 1021 color ramp
>euclid -MAPPING=C -CENTER        ## Same centered
>euclid -MAPPING=CE               ## The enhanced 1785 color ramp
>euclid -MAPPING=CE -CENTER
>euclid -MAPPING=BW               ## A grey scale
>euclid -MAPPING=BW -CENTER

[download]

You can also increase the size -SIZE=nnnn, but it just takes longer :) 

#! perl -slw
use strict;
use GD;

our $MAPPING ||= 'CE';
our $SIZE ||= 500;
our $CENTER ||= 0;

sub euclid {
    my( $x, $y ) = @_;
    return sqrt( $x**2 + $y**2 );
}

my $img = GD::Image->new( $SIZE, $SIZE, 1 );
my $max = $CENTER ? euclid( $SIZE/2, $SIZE/2 ) : euclid( $SIZE, $SIZE 
+);


for my $y ( 0 .. $SIZE-1 ) {
    for my $x ( 0 .. $SIZE-1 ) {
        my $euclid = $CENTER ? euclid( $x - ( $SIZE/2 ), $y - ( $SIZE/
+2 ) )
                             : euclid( $x, $y );
        my $color =
              $MAPPING eq 'BW' ? colorRampGrey( $euclid, 0, $max )
            : $MAPPING eq 'C'  ? colorRamp1021( $euclid, 0, $max )
            :                    colorRamp1785( $euclid, 0, $max );;
        $img->setPixel( $x, $y, $color );
    }
}

open PNG, '>:raw', "euclid.png" or die $!;
print PNG $img->png;
close PNG;

system 'euclid.png';

exit;

sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }

BEGIN {
    my %map = (
         255 => sub{         0,             0,   $_[0] * 255 },
         510 => sub{         0,     $_[0]*255,           255 },
         765 => sub{         0,           255, (1-$_[0])*255 },
        1020 => sub{ $_[0]*255,           255,             0 },
        1275 => sub{       255, (1-$_[0])*255,             0 },
        1530 => sub{       255,             0,     $_[0]*255 },
        1785 => sub{       255,     $_[0]*255,           255 },
    );
    my @map = sort{ $::a <=> $::b } keys %map;
    sub colorRamp1785 {
        my( $v, $vmin, $vmax ) = @_;
        $v = $vmax if $v > $vmax;
        $v = $vmin if $v < $vmin;
        $v = ( $v - $vmin ) / ( $vmax - $vmin );
        $v *= 1785;
        $v < $_ and return rgb2n( $map{ $_ }->( $v % 255 / 256 ) ) for
+ @map;
    }
}

sub colorRamp1021 {
    my( $v, $vmin, $vmax ) = @_;
    my( $r, $g, $b ) = (1) x 3;
    $v = $vmax if $v > $vmax;
    $v = $vmin if $v < $vmin;

    my $dv = $vmax - $vmin;
    if( $v < ( $vmin + 0.25*$dv ) ) {
        $r = 0;
        $g = 4 * ($v - $vmin) / $dv;
    }
    elsif( $v < ( $vmin + 0.5 * $dv ) ) {
        $r = 0;
        $b = 1 + 4 * ($vmin + 0.25 * $dv - $v) / $dv;
    }
    elsif( $v < ( $vmin + 0.75 * $dv ) ) {
        $r = 4 * ($v - $vmin - 0.5 * $dv) / $dv;
        $b = 0;
    }
    else {
        $g = 1 + 4 * ($vmin + 0.75 * $dv - $v) / $dv;
        $b = 0;
    }
    return rgb2n( $r*255, $g*255, $b*255 );
}

sub colorRampGrey {
    my( $v, $vmin, $vmax ) = @_;
    $v = $vmax if $v > $vmax;
    $v = $vmin if $v < $vmin;
    $v = ( $v - $vmin ) / ( $vmax - $vmin );
    return rgb2n( ( $v * 255 ) x 3 );
}

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Replies are listed 'Best First'.
Re^4: Mapping function values to colors
by gone2015 (Deacon) on Dec 10, 2008 at 16:51 UTC

    Ah. I was about to offer the code below as an improvement... I've added the updated subroutine to my tests.

    The "corners" here are: (a) you can end up with  $v == 1786; and (b) the ranges contain 255 values, apart from the first range (up to 255) which contains 256.

    [Assuming I've understood the mapping correctly... the code below tests the various colorRamp1785() routines for 0..1785 (with $vmin == 0 and $vmax == 1785) against the expected values.]

    use strict ; use warnings ;

sub rgb2n { unpack 'N', pack 'CCCC', 0, @_ } ;

# As per original.... ________________________________________________
+____________________

my %map = (
     255 => sub{         0,             0,   $_[0] * 255 },
     510 => sub{         0,     $_[0]*255,           255 },
     765 => sub{         0,           255, (1-$_[0])*255 },
    1020 => sub{ $_[0]*255,           255,             0 },
    1275 => sub{       255, (1-$_[0])*255,             0 },
    1530 => sub{       255,             0,     $_[0]*255 },
    1785 => sub{       255,     $_[0]*255,           255 },
);
my @map = sort{ $::a <=> $::b } keys %map;

sub colorRamp1785 {
    my( $v, $vmin, $vmax ) = @_;
    $v = $vmax if $v > $vmax;
    $v = $vmin if $v < $vmin;
    $v = ( $v - $vmin ) / ( $vmax - $vmin );
    $v *= 1785;

    $v < $_ and return rgb2n( $map{ $_ }->( $v ) ) for @map;
}

# As updated.... _____________________________________________________
+____________________

BEGIN {
    my %map = (
         255 => sub{         0,             0,   $_[0] * 255 },
         510 => sub{         0,     $_[0]*255,           255 },
         765 => sub{         0,           255, (1-$_[0])*255 },
        1020 => sub{ $_[0]*255,           255,             0 },
        1275 => sub{       255, (1-$_[0])*255,             0 },
        1530 => sub{       255,             0,     $_[0]*255 },
        1785 => sub{       255,     $_[0]*255,           255 },
    );
    my @map = sort{ $::a <=> $::b } keys %map;
    sub colorRamp1785_u {
        my( $v, $vmin, $vmax ) = @_;
        $v = $vmax if $v > $vmax;
        $v = $vmin if $v < $vmin;
        $v = ( $v - $vmin ) / ( $vmax - $vmin );
        $v *= 1785;
        $v < $_ and return rgb2n( $map{ $_ }->( $v % 255 / 256 ) ) for
+ @map;
    }
}

# Alternative 1.... __________________________________________________
+____________________

my %map_1 = (
   255 => sub {         0,         0, 255+$_[0] },
   510 => sub {         0, 255+$_[0],       255 },
   765 => sub {         0,       255,    -$_[0] },
  1020 => sub { 255+$_[0],       255,         0 },
  1275 => sub {       255,    -$_[0],         0 },
  1530 => sub {       255,         0, 255+$_[0] },
  1785 => sub {       255, 255+$_[0],       255 },
  1786 => sub {       255,       255,       255 },  # Trap edge case
);

sub numeric ($$) { $_[0] <=> $_[1] } ;

my @map_1 = sort numeric keys %map_1 ;

sub colorRamp1785_1 {
  my( $v, $vmin, $vmax ) = @_;
  $v = $vmax if $v > $vmax;
  $v = $vmin if $v < $vmin;
  $v = int(1786 * ($v - $vmin) / ($vmax - $vmin)) ;  # NB: if $v == $v
+max: $v => 1786

  $v <= $_ and return rgb2n( $map_1{ $_ }->($v - $_) ) for @map_1 ;
}

# Alternative 2.... __________________________________________________
+____________________

my @map_2 = (
  sub {(          0,          0,      $_[0] )}, #    0.. 255 => (     
+0,      0, 0..255)
  sub {(          0, $_[0]- 255,        255 )}, #  256.. 510 => (     
+0, 1..255,    255)
  sub {(          0,        255,  765-$_[0] )}, #  511.. 765 => (     
+0,    255, 254..0)
  sub {( $_[0]- 765,        255,          0 )}, #  766..1020 => (1..25
+5,    255,      0)
  sub {(        255, 1275-$_[0],          0 )}, # 1021..1275 => (   25
+5, 254..0,      0)
  sub {(        255,          0, $_[0]-1275 )}, # 1276..1530 => (   25
+5,      0, 1..255)
  sub {(        255, $_[0]-1530,        255 )}, # 1531..1785 => (   25
+5, 1..255,    255)
) ;

sub colorRamp1785_2 {
  my( $v, $vmin, $vmax ) = @_;

  $v = int((1785 + 1) * ($v - $vmin) / ($vmax - $vmin)) ;

  my $i ;
  if   ($v <=   0)  {
    $v = 0 ;                           # Clamp $v < $vmin
    $i = 0 ;                           # Special case of $v = 0
  }
  else {
    if ($v >= 1786) { $v = 1785 ; } ;  # Clamp $v >= $vmin
    $i = int(($v - 1) / 255) ;         # Select conversion band. 1..25
+5 => 0
                                       #                       256..51
+0 => 1  etc.
  } ;

  return rgb2n( $map_2[$i]->($v) ) ;
}

# Testing ____________________________________________________________
+____________________

test_ramp(-50, +50) ;

test_expected("colorRamp1785",   \&colorRamp1785) ;
test_expected("colorRamp1785_u", \&colorRamp1785_u) ;
test_expected("colorRamp1785_1", \&colorRamp1785_1) ;
test_expected("colorRamp1785_2", \&colorRamp1785_2) ;

sub test_ramp {
  my ($vmin, $vmax) = @_ ;
  my $diff = 0 ;

  print "\n" ;
  print "Ramps for $vmin-1..$vmax+1:\n" ;

  for my $v ($vmin-1..$vmax+1) {
    my $rgb   = colorRamp1785  ($v, $vmin, $vmax) ;
    my $rgb_u = colorRamp1785_u($v, $vmin, $vmax) ;
    my $rgb_1 = colorRamp1785_1($v, $vmin, $vmax) ;
    my $rgb_2 = colorRamp1785_2($v, $vmin, $vmax) ;

    print show($v, $vmin, $vmax), " ", show_rgb($rgb),
                             " & ",  show_rgb($rgb_u),
                             " cf ", show_rgb($rgb_1) ;
    if ($rgb_1 != $rgb_2) {
      print " *** but rgb_2 = ", show_rgb($rgb_2) ;
      $diff++ ;
    } ;

    print "\n" ;
  } ;

  print $diff ? "*** $diff differences" : "No difference",
                                      " between colorRamp1785_1 & colo
+rRamp1785_2\n" ;
} ;

sub test_expected {
  my ($name, $ramp) = @_ ;

  my $vmin   = 0 ;
  my $vmax   = 1785 ;
  my $vcount = $vmax - $vmin + 1 ;

  print "\n" ;
  print "Testing $name\($vmin..$vmax) against expected values.\n" ;

  my $ok = 0 ;

  for my $v ($vmin..$vmax) {
    my $rmp = $ramp->($v, $vmin, $vmax) ;
    my $exp = expectRamp($v) ;
    if ($rmp == $exp) {
      $ok++ ;
    }
    else {
      print show($v, $vmin, $vmax), " ", show_rgb($rmp),
                                 " cf ", show_rgb($exp), "\n" ;
    } ;
  } ;

  print "$name: $ok/$vcount OK" ;
  if ($ok != $vcount) { print " -- so ", $vcount - $ok, "/$vcount wron
+g" ; } ; 
  print "\n" ;
} ;

sub show {
  my ($v, $vmin, $vmax) = @_ ;
  
  sprintf "%+6d (%5.1f%%):", $v, 100 * ($v - $vmin) / ($vmax - $vmin) 
+;
} ;

sub show_rgb {
  my ($rgb) = @_ ;

  my (undef, $r, $g, $b) = unpack('C*', pack('N', $rgb)) ;
  sprintf "(r=%3d g=%3d b=%3d)", $r, $g, $b ;
} ;

sub expectRamp {
  my ($v) = @_ ;

  my ($r, $g, $b) = (0) x 3;

  for my $step (0 .. $v - 1) {
    if(    $step <  255 ) { ++$b; }
    elsif( $step <  510 ) { ++$g; }
    elsif( $step <  765 ) { --$b; }
    elsif( $step < 1020 ) { ++$r; }
    elsif( $step < 1275 ) { --$g; }
    elsif( $step < 1530 ) { ++$b; }
    else                  { ++$g; }
  } ;

  return rgb2n($r, $g, $b) ;
} ;

    [download]
[reply]
[d/l]
[select]
[reply]

        Indeed.

        You may, nevertheless, wish to fix the fact that when $v >= $vmax both the original and the updated code give (r=  0 g=  0 b=  0) cf the expected (r=255 g=255 b=255).

        As to performance, I ran a little benchmark over 1,000,000 random values -200..+200:

                          s/iter colorRamp1785_u colorRamp1785_2 colorRamp1785_3
  colorRamp1785_u   7.26              --            -19%            -65%
  colorRamp1785_2   5.85             24%              --            -57%
  colorRamp1785_3   2.54            186%            130%              --
        YMMV, of course. (colorRamp1785_3 is, of course, a direct look-up, after normalising $vmin..$vmax to 0..1785.)

        [Colour reproduction and colour perception being what they are, I imagine there's a cunning way of mapping a linear scale to something which appears linear. I just wish I knew what that was :-(]

        Update: FWIW the fastest I can make a direct look-up is the code below, which benchmarks:

                        s/iter colorRamp1785_u colorRamp1785_1 colorRamp1785_2 colorRamp1785_d
colorRamp1785_u   7.23              --             -8%            -20%            -67%
colorRamp1785_1   6.62              9%              --            -13%            -64%
colorRamp1785_2   5.79             25%             14%              --            -59%
colorRamp1785_d   2.37            205%            179%            144%              --

        Read more... colorRamp_d (2 kB)
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom