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) ; } ;
In reply to Re^4: Mapping function values to colors
by gone2015
in thread Mapping function values to colors
by spx2
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |