Skip to content

Commit

Permalink
no use NiceSlice
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Jan 23, 2022
1 parent 1f0eb21 commit a2526fe
Show file tree
Hide file tree
Showing 2 changed files with 79 additions and 82 deletions.
139 changes: 69 additions & 70 deletions lib/PDL/Transform/Color.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -353,7 +353,6 @@ use PDL;
use PDL::Transform;
use PDL::MatrixOps;
use PDL::Options;
use PDL::NiceSlice;

use Carp;

Expand Down Expand Up @@ -1200,9 +1199,9 @@ sub t_pc {

## These are the actual transforms. They're figured by the constructor,
## which does any combinatorics in setting up the subs.
$out->((0)) .= &{$opt->{subs}->[0]}($in2)->clip(0,1);
$out->((1)) .= &{$opt->{subs}->[1]}($in2)->clip(0,1);
$out->((2)) .= &{$opt->{subs}->[2]}($in2)->clip(0,1);
$out->slice('(0)') .= $opt->{subs}->[0]->($in2)->clip(0,1);
$out->slice('(1)') .= $opt->{subs}->[1]->($in2)->clip(0,1);
$out->slice('(2)') .= $opt->{subs}->[2]->($in2)->clip(0,1);

if(defined($opt->{lut}->{ogamma})) {
$out *= ($out->abs) ** ($opt->{lut}->{ogamma}-1);
Expand Down Expand Up @@ -1297,9 +1296,9 @@ sub t_xyz {
} else {
my $rgb = get_rgb($me->{params}->{rgb_system});

my ($xr,$yr) = ($rgb->{r}->((0)),$rgb->{r}->((1)));
my ($xg,$yg) = ($rgb->{g}->((0)),$rgb->{g}->((1)));
my ($xb,$yb) = ($rgb->{b}->((0)),$rgb->{b}->((1)));
my ($xr,$yr) = ($rgb->{r}->slice('(0)'),$rgb->{r}->slice('(1)'));
my ($xg,$yg) = ($rgb->{g}->slice('(0)'),$rgb->{g}->slice('(1)'));
my ($xb,$yb) = ($rgb->{b}->slice('(0)'),$rgb->{b}->slice('(1)'));

my $Xr = $xr / ($yr + ($yr==0));
my $Yr = 1;
Expand All @@ -1314,12 +1313,12 @@ sub t_xyz {
my $M = pdl( [ $Xr, $Xg, $Xb ], [$Yr, $Yg, $Yb], [$Zr, $Zg, $Zb] );
my $Minv = $M->inv;

my ($xw, $yw, $Yw) = ($rgb->{w}->((0)),$rgb->{w}->((1)),$rgb->{w}->((2)));
my ($xw, $yw, $Yw) = ($rgb->{w}->slice('(0)'),$rgb->{w}->slice('(1)'),$rgb->{w}->slice('(2)'));
my $Xw = $xw * $Yw / ($yw + ($yw==0));
my $Zw = (1 - $xw - $yw)*$Yw / ($yw+($yw==0));
my $XYZw = pdl($Xw,$Yw,$Zw);

my $Srgb = ($Minv x $XYZw->(*1))->((0)); # row vector
my $Srgb = ($Minv x $XYZw->slice('*1'))->slice('(0)'); # row vector
$M *= $Srgb;
$me->{params}->{mat} = $M;
$me->{params}->{inv} = $M->inv;
Expand All @@ -1333,7 +1332,7 @@ sub t_xyz {
$me->{func} = sub {
my($in, $opt) = @_;

my $out = ( $opt->{mat} x $in->(*1) )->((0))->sever;
my $out = ( $opt->{mat} x $in->slice('*1') )->slice('(0)')->sever;

if($in->is_inplace) {
$in .= $out;
Expand All @@ -1344,7 +1343,7 @@ sub t_xyz {

$me->{inv} = sub {
my($in, $opt) = @_;
my $out = ( $opt->{inv} x $in->(*1) )->((0))->sever;
my $out = ( $opt->{inv} x $in->slice('*1') )->slice('(0)')->sever;

if($in->is_inplace) {
$in .= $out;
Expand Down Expand Up @@ -1377,10 +1376,10 @@ sub t_rgi {

$me->{func} = sub {
my($in,$opt) = @_;
my $i = $in->sumover->(*1);
my $i = $in->sumover->slice('*1');
my $out = zeroes($in);
$out->(0:1) .= $in(0:1) / ($i+($i==0));
$out->(2) .= $i/3;
$out->slice('0:1') .= $in->slice('0:1') / ($i+($i==0));
$out->slice('2') .= $i/3;
if($in->is_inplace) {
$in .= $out;
return $in;
Expand All @@ -1390,9 +1389,9 @@ sub t_rgi {
$me->{inv} = sub {
my($in,$opt) = @_;
my $out = zeroes($in);
$out->(0:1) .= $in(0:1);
$out->((2)) .= 1 - $in(0:1)->sumover;
$out *= $in->(2) * 3;
$out->slice('0:1') .= $in->slice('0:1');
$out->slice('(2)') .= 1 - $in->slice('0:1')->sumover;
$out *= $in->slice('2') * 3;
if($in->is_inplace) {
$in .= $out;
return $in;
Expand Down Expand Up @@ -1435,8 +1434,8 @@ sub t_xyy {

$me->{func} = sub {
my($XYZ, $opt) = @_;
my $out = $XYZ/$XYZ->sumover->(*1);
$out->((2)) .= $XYZ->((1));
my $out = $XYZ/$XYZ->sumover->slice('*1');
$out->slice('(2)') .= $XYZ->slice('(1)');
if($XYZ->is_inplace) {
$XYZ .= $out;
$out = $XYZ;
Expand All @@ -1450,10 +1449,10 @@ sub t_xyy {
my $XYZ = zeroes($in);

# stuff X and Z in there.
my $in1 = $in->((1))+($in->((1))==0);
$XYZ->((0)) .= $in->((0)) * $in->((2)) / $in1;
$XYZ->((1)) .= $in->((2));
$XYZ->((2)) .= $in->((2)) * (1 - $in->((0)) - $in->((1))) / $in1;
my $in1 = $in->slice('(1)')+($in->slice('(1)')==0);
$XYZ->slice('(0)') .= $in->slice('(0)') * $in->slice('(2)') / $in1;
$XYZ->slice('(1)') .= $in->slice('(2)');
$XYZ->slice('(2)') .= $in->slice('(2)') * (1 - $in->slice('(0)') - $in->slice('(1)')) / $in1;

if($in->is_inplace) {
$in .= $XYZ;
Expand Down Expand Up @@ -1539,8 +1538,8 @@ sub t_xyz2lab {
# get and store illuminant XYZ
my $wp_xyy = xyy_from_illuminant($me->{params}->{white});
$me->{params}->{wp_xyz} = $wp_xyy->copy;
$me->{params}->{wp_xyz}->(2) .= 1 - $wp_xyy->(0) - $wp_xyy->(1);
$me->{params}->{wp_xyz} *= $wp_xyy->(2);
$me->{params}->{wp_xyz}->slice('2') .= 1 - $wp_xyy->slice('0') - $wp_xyy->slice('1');
$me->{params}->{wp_xyz} *= $wp_xyy->slice('2');


# input is XYZ by the time it gets here
Expand All @@ -1550,11 +1549,11 @@ sub t_xyz2lab {

my $wp = $opt->{wp_xyz} + ($opt->{wp_xyz}==0);

my $FYp = f_lab( $in->((1)) / $wp->((1)) );
my $FYp = f_lab( $in->slice('(1)') / $wp->slice('(1)') );

$out->((0)) .= 116 * $FYp - 16;
$out->((1)) .= 500 * ( f_lab( $in->((0)) / $wp->((0)) ) - $FYp );
$out->((2)) .= 200 * ( $FYp - f_lab( $in->((2)) / $wp->((2)) ) );
$out->slice('(0)') .= 116 * $FYp - 16;
$out->slice('(1)') .= 500 * ( f_lab( $in->slice('(0)') / $wp->slice('(0)') ) - $FYp );
$out->slice('(2)') .= 200 * ( $FYp - f_lab( $in->slice('(2)') / $wp->slice('(2)') ) );

if($in->is_inplace) {
$in .= $out;
Expand All @@ -1567,11 +1566,11 @@ sub t_xyz2lab {
my($in,$opt) = @_;
my($out) = zeroes($in);

my $Lterm = ($in->((0))+16)/116;
my $Lterm = ($in->slice('(0)')+16)/116;

$out->((0)) .= $opt->{wp_xyz}->((0)) * f_lab_inv( $Lterm + $in->((1))/500 );
$out->((1)) .= $opt->{wp_xyz}->((1)) * f_lab_inv( $Lterm );
$out->((2)) .= $opt->{wp_xyz}->((2)) * f_lab_inv( $Lterm - $in->((2))/200 );
$out->slice('(0)') .= $opt->{wp_xyz}->slice('(0)') * f_lab_inv( $Lterm + $in->slice('(1)')/500 );
$out->slice('(1)') .= $opt->{wp_xyz}->slice('(1)') * f_lab_inv( $Lterm );
$out->slice('(2)') .= $opt->{wp_xyz}->slice('(2)') * f_lab_inv( $Lterm - $in->slice('(2)')/200 );

if($in->is_inplace) {
$in .= $out;
Expand Down Expand Up @@ -1648,13 +1647,13 @@ sub t_cmyk {

$me->{func} = sub {
my($in,$opt) = @_;
my $out = zeroes( 4, $in->((0))->dims );
my $out = zeroes( 4, $in->slice('(0)')->dims );

my $Kp = $in->maximum->(*1);
(my $K = $out->(3)) .= 1 - $Kp;
$out->(0:2) .= ($Kp - $in->(0:2)) / $Kp;
$out->((3))->where($Kp==0) .= 1;
$out->(0:2)->mv(0,-1)->where($Kp==0) .= 0;
my $Kp = $in->maximum->slice('*1');
(my $K = $out->slice('3')) .= 1 - $Kp;
$out->slice('0:2') .= ($Kp - $in->slice('0:2')) / $Kp;
$out->slice('(3)')->where($Kp==0) .= 1;
$out->slice('0:2')->mv(0,-1)->where($Kp==0) .= 0;

if(defined($opt->{htgamma}) && $opt->{htgamma} != 1) {
$out *= ($out->abs) ** ($opt->{htgamma} - 1);
Expand All @@ -1672,7 +1671,7 @@ sub t_cmyk {

$me->{inv} = sub {
my($in,$opt) = @_;
my $out = zeroes( 3, $in->((0))->dims );
my $out = zeroes( 3, $in->slice('(0)')->dims );

$in = $in->new_or_inplace;

Expand All @@ -1683,8 +1682,8 @@ sub t_cmyk {
if(defined($opt->{htgamma}) && $opt->{htgamma} != 1) {
$in *= ($in->abs) ** (1.0/$opt->{htgamma} - 1);
}
my $Kp = 1.0 - $in->(3);
$out .= $Kp * ( 1 - $in->(0:2) );
my $Kp = 1.0 - $in->slice('3');
$out .= $Kp * ( 1 - $in->slice('0:2') );
return $out;
};

Expand Down Expand Up @@ -1781,25 +1780,25 @@ sub t_hsl {

my $Cmax = $in->maximum;
my $Cmin = $in->minimum;
my $maxdex = $in->qsorti->((2))->sever;
my $maxdex = $in->qsorti->slice('(2)')->sever;
my $Delta = ( $Cmax - $Cmin );

my $dexes = ($maxdex->(*1) + pdl(0,1,2)) % 3;
my $dexes = ($maxdex->slice('*1') + pdl(0,1,2)) % 3;

my $H = $out->((0));
my $H = $out->slice('(0)');

if($opt->{hue_linear}) {
## Old linear method
$H .= (
(($in->index1d($dexes->(1)) - $in->index1d($dexes->(2)))->((0))/($Delta+($Delta==0)))
+ 2 * $dexes->((0)) ) ;
(($in->index1d($dexes->slice('1')) - $in->index1d($dexes->slice('2')))->slice('(0)')/($Delta+($Delta==0)))
+ 2 * $dexes->slice('(0)') ) ;

$H += 6*($H<0);
$H /= 6;
} else {
## New hotness: smooth transitions at corners
my $Hint = 2*$dexes->((0));
my $Hfrac = (($in->index1d($dexes->(1)) - $in->index1d($dexes->(2)))->((0))/($Delta+($Delta==0)));
my $Hint = 2*$dexes->slice('(0)');
my $Hfrac = (($in->index1d($dexes->slice('1')) - $in->index1d($dexes->slice('2')))->slice('(0)')/($Delta+($Delta==0)));
my $Hfs = -1*($Hfrac<0) + ($Hfrac >= 0);
$Hfrac .= $Hfs * ( asin( ($Hfrac->abs) ** 0.25 ) * 2/$PI );
$H .= $Hint + $Hfrac;
Expand All @@ -1809,13 +1808,13 @@ sub t_hsl {
$H += ($H<0);

# Lightness and Saturation
my $L = $out->((2));
my $L = $out->slice('(2)');
if($opt->{hsv}) {
$L .= $Cmax;
$out->((1)) .= $Delta / ($L + ($L==0));
$out->slice('(1)') .= $Delta / ($L + ($L==0));
} else {
$L .= ($Cmax + $Cmin)/2;
$out->((1)) .= $Delta / (1 - (2*$L-1)->abs + ($L==0 | $L==1));
$out->slice('(1)') .= $Delta / (1 - (2*$L-1)->abs + ($L==0 | $L==1));
}


Expand All @@ -1833,16 +1832,16 @@ sub t_hsl {
$me->{inv} = sub {
my($in,$opt) = @_;

my $H = $in->((0))*6;
my $S = $in->((1));
my $L = $in->((2));
my $H = $in->slice('(0)')*6;
my $S = $in->slice('(1)');
my $L = $in->slice('(2)');

if($opt->{lgamma} != 1) {
$L = $L * (($L->abs + ($L==0)) ** ($opt->{lgamma}-1));
}

my $ZCX = zeroes($in);
my $C = $ZCX->((1));
my $C = $ZCX->slice('(1)');
my $m;
if($opt->{hsv}) {
$C .= $L * $S;
Expand All @@ -1854,15 +1853,15 @@ sub t_hsl {

if($opt->{hue_linear}){
## Old linear method
$ZCX->((2)) .= $C * (1 - ($H % 2 - 1)->abs);
$ZCX->slice('(2)') .= $C * (1 - ($H % 2 - 1)->abs);
} else {
## New hotness: smooth transitions at corners.
$ZCX->((2)) .= $C * sin($PI/2 * (1 - ($H % 2 - 1)->abs))**4;
$ZCX->slice('(2)') .= $C * sin($PI/2 * (1 - ($H % 2 - 1)->abs))**4;
}

my $dexes = pdl( [1,2,0], [2,1,0], [0,1,2], [0,2,1], [2,0,1], [1,0,2] )->mv(1,0)->sever;
my $dex = $dexes->index1d($H->floor->(*1,*1) % 6)->((0))->sever; # 3x(threads)
my $out = $ZCX->index1d($dex)->sever + $m->(*1);
my $dex = $dexes->index1d($H->floor->slice('*1,*1') % 6)->slice('(0)')->sever; # 3x(threads)
my $out = $ZCX->index1d($dex)->sever + $m->slice('*1');

if($in->is_inplace) {
$in .= $out;
Expand Down Expand Up @@ -1980,28 +1979,28 @@ sub t_shift_illuminant {

$me->{func} = sub {
my($in, $opt) = @_;
my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->(*1) )->((0))->sever;
my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->(*1) )->((0))->sever;
my $M = $opt->{Ma_inv} x ( ( $rhgabe_to / $rhgabe_fr )->(*1) * $opt->{Ma} );
my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->slice('*1') )->slice('(0)')->sever;
my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->slice('*1') )->slice('(0)')->sever;
my $M = $opt->{Ma_inv} x ( ( $rhgabe_to / $rhgabe_fr )->slice('*1') * $opt->{Ma} );

if($opt->{basis} =~ m/^X/i) {
return (( $M x $in->(*1) )->((0))->sever);
return (( $M x $in->slice('*1') )->slice('(0)')->sever);
} else {
return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->(*1) )->((0))->sever);
return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->slice('*1') )->slice('(0)')->sever);
}

};

$me->{inv} = sub {
my($in, $opt) = @_;
my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->(*1) )->((0))->sever;
my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->(*1) )->((0))->sever;
my $M = $opt->{Ma_inv} x ( ( $rhgabe_fr / $rhgabe_to )->(*1) * $opt->{Ma} );
my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->slice('*1') )->slice('(0)')->sever;
my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->slice('*1') )->slice('(0)')->sever;
my $M = $opt->{Ma_inv} x ( ( $rhgabe_fr / $rhgabe_to )->slice('*1') * $opt->{Ma} );

if($opt->{basis} =~ m/^X/i) {
return (( $M x $in->(*1) )->((0))->sever);
return (( $M x $in->slice('*1') )->slice('(0)')->sever);
} else {
return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->(*1) )->((0))->sever);
return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->slice('*1') )->slice('(0)')->sever);
}
};

Expand Down
22 changes: 10 additions & 12 deletions t/color.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ eval "use PDL::Transform::Color;";
ok( $PDL::Transform::Color::VERSION, "looks like there's a version in the module" );
use PDL;
use PDL::Transform;
use PDL::NiceSlice;

##########
## test t_gamma
Expand All @@ -34,11 +33,11 @@ $itriplet *= pdl(-1,1,1);
eval {$otriplet = $itriplet->apply($t);};
is $@, '', "t_gamma transform with negative values works OK";
ok(all(($otriplet * 10000)->abs->rint == (($itriplet->abs)**2 * 10000)->rint), "gamma=2 gives correct magnitude with negative input values");
ok($otriplet->((0))<0, "gamma=2 preserves sign");
ok($otriplet->slice('(0)')<0, "gamma=2 preserves sign");
eval {$otriplet = $itriplet->invert($t);};
is $@, '', "t_gamma transformm inverts OK on negative values";
ok(all(($otriplet * 10000)->abs->rint == (($itriplet->abs)**0.5 * 10000)->rint), "gamma=2 inverse gives correct magnitude with negative input values");
ok($otriplet->((0))<0, "gamma=2 inverse preserves sign");
ok($otriplet->slice('(0)')<0, "gamma=2 inverse preserves sign");


##########
Expand Down Expand Up @@ -83,8 +82,8 @@ $itriplet = pdl(0.341,0.341,0.341);
eval { $otriplet = $itriplet->apply($t); };
is $@, '', "t_cmyk forward runs OK" ;
ok( $otriplet->nelem==4, "t_cmyk makes a 4-vector");
ok( all($otriplet->(0:2)==0), "t_cmyk finds an all-k solution");
ok( $otriplet->((3))==1.0 - 0.341, "t_cmyk gets corrrect k value");
ok( all($otriplet->slice('0:2')==0), "t_cmyk finds an all-k solution");
ok( $otriplet->slice('(3)')==1.0 - 0.341, "t_cmyk gets corrrect k value");
eval { $i2triplet = $otriplet->invert($t);};
is $@, '', "t_cmyk reverse runs OK";
ok( $i2triplet->nelem==3, "t_cmyk inverse makes a 3-vector" );
Expand All @@ -102,8 +101,8 @@ $itriplet = pdl([1,0,0],[0,1,0],[0,0,1]);
eval { $otriplet = $itriplet->apply(t_xyz()); };
is $@, '', "t_xyz runs OK ($@)";
# Check against chromaticities of the sRGB primaries
my $xpypzptriplet = $otriplet / $otriplet->sumover->(*1);
ok( all( ($xpypzptriplet->(0:1)*1000)->rint ==
my $xpypzptriplet = $otriplet / $otriplet->sumover->slice('*1');
ok( all( ($xpypzptriplet->slice('0:1')*1000)->rint ==
( pdl( [ 0.640, 0.330 ],
[ 0.300, 0.600 ],
[ 0.150, 0.060 ]
Expand All @@ -122,7 +121,6 @@ my $brgbcmyw = pdl([0,0,0],
[0,1,1],[1,0,1],[1,1,0],
[1,1,1]);
my $ocolors;
my $t;
eval { $t = t_rgi(); };
is $@, '', "t_rgi runs OK ($@)";
eval { $ocolors = $brgbcmyw->apply($t) };
Expand Down Expand Up @@ -164,10 +162,10 @@ $a = xvals(256)/255;
eval { $b = PDL::Transform::Color::_srgb_encode($a); };
is $@, '', "_srgb_encode ran ok";
ok(all($b+1e-10 > $a), "_srgb_encode output is always larger than input on [0,1]");
ok(all($b->(1:-1)>$b->(0:-2)),"_srgb_encode output is monotonically increasing");
$slope = $b->(1:-1) - $b->(0:-2);
ok(all($slope->(1:-1) < $slope->(0:-2)),"slope is monotonically decreasing");
eval { $aa = PDL::Transform::Color::_srgb_decode($b); };
ok(all($b->slice('1:-1')>$b->slice('0:-2')),"_srgb_encode output is monotonically increasing");
my $slope = $b->slice('1:-1') - $b->slice('0:-2');
ok(all($slope->slice('1:-1') < $slope->slice('0:-2')),"slope is monotonically decreasing");
my $aa = eval { PDL::Transform::Color::_srgb_decode($b) };
is $@, '', "_srgb_decode ran ok";
ok(all( ($aa > $a -1e-10) & ($aa < $a + 1e-10) ),"decoding undoes coding");

Expand Down

0 comments on commit a2526fe

Please sign in to comment.