From 173e9d3a9005435b2570c25cf80e2d193589997b Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Sun, 8 Dec 2024 13:47:48 -0600 Subject: [PATCH] Fix approx for complex values. 2.095 fails --- Basic/lib/PDL/Primitive.pd | 24 ++++++++++++------------ Basic/t/primitive-misc.t | 2 ++ Changes | 1 + 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/Basic/lib/PDL/Primitive.pd b/Basic/lib/PDL/Primitive.pd index 5081dc932..5ebb4f646 100644 --- a/Basic/lib/PDL/Primitive.pd +++ b/Basic/lib/PDL/Primitive.pd @@ -2437,51 +2437,51 @@ The default value of C is C. =for example use PDL; - + my @modes = qw( sample insert_leftmost insert_rightmost match bin_inclusive bin_exclusive ); - + # Generate a sequence of 3 zeros, 3 ones, ..., 3 fours. my $x = zeroes(3,5)->yvals->flat; - + for my $mode ( @modes ) { # if the value is in $x my $contained = 2; my $idx_contained = vsearch( $contained, $x, { mode => $mode } ); my $x_contained = $x->copy; $x_contained->slice( $idx_contained ) .= 9; - + # if the value is not in $x my $not_contained = 1.5; my $idx_not_contained = vsearch( $not_contained, $x, { mode => $mode } ); my $x_not_contained = $x->copy; $x_not_contained->slice( $idx_not_contained ) .= 9; - + print sprintf("%-23s%30s\n", '$x', $x); print sprintf("%-23s%30s\n", "$mode ($contained)", $x_contained); print sprintf("%-23s%30s\n\n", "$mode ($not_contained)", $x_not_contained); } - + # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # sample (2) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4] # sample (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4] - # + # # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # insert_leftmost (2) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4] # insert_leftmost (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4] - # + # # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # insert_rightmost (2) [0 0 0 1 1 1 2 2 2 9 3 3 4 4 4] # insert_rightmost (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4] - # + # # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # match (2) [0 0 0 1 1 1 2 9 2 3 3 3 4 4 4] # match (1.5) [0 0 0 1 1 1 2 2 9 3 3 3 4 4 4] - # + # # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # bin_inclusive (2) [0 0 0 1 1 1 2 2 9 3 3 3 4 4 4] # bin_inclusive (1.5) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4] - # + # # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4] # bin_exclusive (2) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4] # bin_exclusive (1.5) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4] @@ -3600,7 +3600,7 @@ double abs_diff2 = PDL_IF_GENTYPE_REAL( if (abs_diff2 <= atol2) { $result() = 1; continue; } double rel_diff2 = rtol2 * PDL_IF_GENTYPE_REAL( expctd * expctd, - (creall(expctd) * creall(expctd)) + (cimagl(expctd) * cimagl(expctd)) + ((creall(expctd) * creall(expctd)) + (cimagl(expctd) * cimagl(expctd))) ); if (abs_diff2 <= rel_diff2) { $result() = 1; continue; } $result() = 0; diff --git a/Basic/t/primitive-misc.t b/Basic/t/primitive-misc.t index a746e79f8..a11727d64 100644 --- a/Basic/t/primitive-misc.t +++ b/Basic/t/primitive-misc.t @@ -82,6 +82,8 @@ subtest approx_artol => sub { $got_a = pdl('inf bad')->approx_artol(pdl('inf bad')); $exp_a_mask = pdl([1,1]); ok all($got_a == $exp_a_mask), 'inf,bad matches inf,bad' or diag "got=$got_a\nexp=$exp_a_mask"; + ok all(approx_artol i,i), 'i is approx i'; + ok !all(approx_artol i,5*i), 'i is not approx 5i'; }; done_testing; diff --git a/Changes b/Changes index f4a671f14..402a2e9c0 100644 --- a/Changes +++ b/Changes @@ -27,6 +27,7 @@ - split PDL::IO::Dicom out to separate distro - finish, then split PDL::IO::ENVI out to separate distro - split PDL::Graphics::TriD out to separate distro +- fix approx_artol for complex values (#507) - thanks @wlmb 2.095 2024-11-03 - add PDL_GENTYPE_IS_{REAL,FLOATREAL,COMPLEX,SIGNED,UNSIGNED}_##ppsym (#502)