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

Hi BrowserUK,thanks allot,that really helped,I was able to get some quick results.
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.
But soon I will probably have higher values , maybe 1000,maybe 10000 ...
it's not as easy as I thought(looking on your code) to deal with those high numbers as well.
I will look more into your code and the color ramping link http://local.wasp.uwa.edu.au/~pbourke/texture_colour/colourramp/
was excellent, thank you :)

P.S. : perlmonks seems to always be full of knowledgeble people , of all the places I'd ask,I didn't expect
the answer would come from here
  • Comment on Re^2: Mapping function values to colors

Replies are listed 'Best First'.
Re^3: Mapping function values to colors
by BrowserUk (Patriarch) on Dec 10, 2008 at 15:16 UTC
    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

    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 ); }

    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.

      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) ; } ;