File Coverage

blib/lib/PDLA/Bad.pm
Criterion Covered Total %
statement 54 70 77.1
branch 9 20 45.0
condition 8 9 88.8
subroutine 13 14 92.8
pod 0 6 0.0
total 84 119 70.5


line stmt bran cond sub pod time code
1              
2             #
3             # GENERATED WITH PDLA::PP! Don't modify!
4             #
5             package PDLA::Bad;
6              
7             @EXPORT_OK = qw( badflag check_badflag badvalue orig_badvalue nbad nbadover ngood ngoodover setbadat PDLA::PP isbad PDLA::PP isgood PDLA::PP nbadover PDLA::PP ngoodover PDLA::PP setbadif PDLA::PP setvaltobad PDLA::PP setnantobad PDLA::PP setbadtonan PDLA::PP setbadtoval PDLA::PP copybad );
8             %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
9              
10 77     77   912 use PDLA::Core;
  77         181  
  77         486  
11 77     77   606 use PDLA::Exporter;
  77         181  
  77         527  
12 77     77   426 use DynaLoader;
  77         246  
  77         6069  
13              
14              
15              
16            
17             @ISA = ( 'PDLA::Exporter','DynaLoader' );
18             push @PDLA::Core::PP, __PACKAGE__;
19             bootstrap PDLA::Bad ;
20              
21              
22              
23              
24              
25             =head1 NAME
26              
27             PDLA::Bad - PDLA does process bad values
28              
29             =head1 DESCRIPTION
30              
31             PDLA has been compiled with WITH_BADVAL set to 1. Therefore,
32             you can enter the wonderful world of bad value support in
33             PDLA.
34              
35             This module is loaded when you do C,
36             C or C.
37              
38             Implementation details are given in
39             L.
40              
41             =head1 SYNOPSIS
42              
43             use PDLA::Bad;
44             print "\nBad value support in PDLA is turned " .
45             $PDLA::Bad::Status ? "on" : "off" . ".\n";
46              
47             Bad value support in PDLA is turned on.
48              
49             and some other things
50              
51             =head1 VARIABLES
52              
53             There are currently three variables that this module defines
54             which may be of use.
55              
56             =over 4
57              
58             =item $PDLA::Bad::Status
59              
60             Set to 1
61              
62             =item $PDLA::Bad::UseNaN
63              
64             Set to 1 if PDLA was compiled with C set,
65             0 otherwise.
66              
67             =item $PDLA::Bad::PerPdl
68              
69             Set to 1 if PDLA was compiled with the I
70             C option set, 0 otherwise.
71              
72             =back
73              
74             =cut
75              
76              
77              
78              
79              
80              
81              
82             =head1 FUNCTIONS
83              
84              
85              
86             =cut
87              
88              
89              
90              
91              
92             # really should be constants
93             $PDLA::Bad::Status = 1;
94             $PDLA::Bad::UseNaN = 0;
95             $PDLA::Bad::PerPdl = 0;
96              
97 77     77   518 use strict;
  77         180  
  77         2101  
98              
99 77     77   410 use PDLA::Types;
  77         168  
  77         9453  
100 77     77   627 use PDLA::Primitive;
  77         223  
  77         617  
101              
102             ############################################################
103             ############################################################
104              
105              
106              
107             ############################################################
108             ############################################################
109              
110             *badflag = \&PDLA::badflag;
111             *badvalue = \&PDLA::badvalue;
112             *orig_badvalue = \&PDLA::orig_badvalue;
113              
114             ############################################################
115             ############################################################
116              
117             =head2 badflag
118              
119             =for ref
120              
121             getter/setter for the bad data flag
122              
123             =for example
124              
125             if ( $x->badflag() ) {
126             print "Data may contain bad values.\n";
127             }
128             $x->badflag(1); # set bad data flag
129             $x->badflag(0); # unset bad data flag
130              
131             When called as a setter, this modifies the piddle on which
132             it is called. This always returns a Perl scalar with the
133             final value of the bad flag.
134              
135             A return value of 1 does not guarantee the presence of
136             bad data in a piddle; all it does is say that we need to
137             I for the presence of such beasties. To actually
138             find out if there are any bad values present in a piddle,
139             use the L method.
140              
141             =for bad
142              
143             This function works with piddles that have bad values. It
144             always returns a Perl scalar, so it never returns bad values.
145              
146             =head2 badvalue
147              
148             =for ref
149              
150             returns the value used to indicate a missing (or bad) element
151             for the given piddle type. You can give it a piddle,
152             a PDLA::Type object, or one of C<$PDLA_B>, C<$PDLA_S>, etc.
153              
154             =for example
155              
156             $badval = badvalue( float );
157             $x = ones(ushort,10);
158             print "The bad data value for ushort is: ",
159             $x->badvalue(), "\n";
160              
161             This can act as a setter (e.g. C<< $x->badvalue(23) >>)
162             if the data type is an integer or C<$PDLA::Bad::UseNaN == 0>.
163             Note that this B.
164             That is, if C<$x> already has bad values, they will not
165             be changed to use the given number and if any elements of
166             C<$x> have that value, they will unceremoniously be marked
167             as bad data. See L, L, and
168             L for ways to actually modify the data in piddles
169              
170             If the C<$PDLA::Bad::PerPdl> flag is set then it is possible to
171             change the bad value on a per-piddle basis, so
172              
173             $x = sequence (10);
174             $x->badvalue (3); $x->badflag (1);
175             $y = sequence (10);
176             $y->badvalue (4); $y->badflag (1);
177              
178             will set $x to be C<[0 1 2 BAD 4 5 6 7 8 9]> and $y to be
179             C<[0 1 2 3 BAD 5 6 7 8 9]>. If the flag is not set then both
180             $x and $y will be set to C<[0 1 2 3 BAD 5 6 7 8 9]>. Please
181             note that the code to support per-piddle bad values is
182             I in the current release, and it requires that
183             you modify the settings under which PDLA is compiled.
184              
185             =for bad
186              
187             This method does not care if you call it on an input piddle
188             that has bad values. It always returns a Perl scalar
189             with the current or new bad value.
190              
191             =head2 orig_badvalue
192              
193             =for ref
194              
195             returns the original value used to represent bad values for
196             a given type.
197              
198             This routine operates the same as L,
199             except you can not change the values.
200              
201             It also has an I name.
202              
203             =for example
204              
205             $orig_badval = orig_badvalue( float );
206             $x = ones(ushort,10);
207             print "The original bad data value for ushort is: ",
208             $x->orig_badvalue(), "\n";
209              
210             =for bad
211              
212             This method does not care if you call it on an input piddle
213             that has bad values. It always returns a Perl scalar
214             with the original bad value for the associated type.
215              
216             =head2 check_badflag
217              
218             =for ref
219              
220             Clear the bad-value flag of a piddle if it does not
221             contain any bad values
222              
223             Given a piddle whose bad flag is set, check whether it
224             actually contains any bad values and, if not, clear the flag.
225             It returns the final state of the bad-value flag.
226              
227             =for example
228              
229             print "State of bad flag == ", $pdl->check_badflag;
230              
231             =for bad
232              
233             This method accepts piddles with or without bad values. It
234             returns a Perl scalar with the final bad-value flag, so it
235             never returns bad values itself.
236              
237             =cut
238              
239             *check_badflag = \&PDLA::check_badflag;
240              
241             sub PDLA::check_badflag {
242 3     3 0 41 my $pdl = shift;
243 3 100 66     28 $pdl->badflag(0) if $pdl->badflag and $pdl->nbad == 0;
244 3         21 return $pdl->badflag;
245             } # sub: check_badflag()
246              
247              
248              
249              
250             # note:
251             # if sent a piddle, we have to change it's bad values
252             # (but only if it contains bad values)
253             # - there's a slight overhead in that the badflag is
254             # cleared and then set (hence propagating to all
255             # children) but we'll ignore that)
256             # - we can ignore this for float/double types
257             # since we can't change the bad value
258             #
259             sub PDLA::badvalue {
260 77     77   677 no strict 'refs';
  77         174  
  77         20695  
261              
262 32     32 0 20638 my ( $self, $val ) = @_;
263 32         52 my $num;
264 32 50       113 if ( UNIVERSAL::isa($self,"PDLA") ) {
    0          
265 32         100 $num = $self->get_datatype;
266 32 100 100     127 if ( $num < $PDLA_F && defined($val) && $self->badflag ) {
      100        
267 1         5 $self->inplace->setbadtoval( $val );
268 1         9 $self->badflag(1);
269             }
270              
271 32 50       113 if ($PDLA::Config{BADVAL_PER_PDLA}) {
272 0         0 my $name = "PDLA::_badvalue_per_pdl_int$num";
273 0 0       0 if ( defined $val ) {
274 0         0 return &{$name}($self, $val )->sclr;
  0         0  
275             } else {
276 0         0 return &{$name}($self, undef)->sclr;
  0         0  
277             }
278             }
279              
280             } elsif ( UNIVERSAL::isa($self,"PDLA::Type") ) {
281 0         0 $num = $self->enum;
282             } else {
283             # assume it's a number
284 0         0 $num = $self;
285             }
286              
287 32         87 my $name = "PDLA::_badvalue_int$num";
288 32 100       76 if ( defined $val ) {
289 14         21 return &{$name}( $val )->sclr;
  14         158  
290             } else {
291 18         33 return &{$name}( undef )->sclr;
  18         207  
292             }
293              
294             } # sub: badvalue()
295              
296             sub PDLA::orig_badvalue {
297 77     77   586 no strict 'refs';
  77         223  
  77         42641  
298              
299 0     0 0 0 my $self = shift;
300 0         0 my $num;
301 0 0       0 if ( UNIVERSAL::isa($self,"PDLA") ) {
    0          
302 0         0 $num = $self->get_datatype;
303             } elsif ( UNIVERSAL::isa($self,"PDLA::Type") ) {
304 0         0 $num = $self->enum;
305             } else {
306             # assume it's a number
307 0         0 $num = $self;
308             }
309              
310 0         0 my $name = "PDLA::_default_badvalue_int$num";
311 0         0 return &${name}();
312              
313             } # sub: orig_badvalue()
314              
315             ############################################################
316             ############################################################
317              
318              
319              
320              
321              
322             =head2 isbad
323              
324             =for sig
325              
326             Signature: (a(); int [o]b())
327              
328             =for ref
329              
330             Returns a binary mask indicating which values of
331             the input are bad values
332              
333             Returns a 1 if the value is bad, 0 otherwise.
334             Similar to L.
335              
336             =for example
337              
338             $x = pdl(1,2,3);
339             $x->badflag(1);
340             set($x,1,$x->badvalue);
341             $y = isbad($x);
342             print $y, "\n";
343             [0 1 0]
344              
345             =for bad
346              
347             This method works with input piddles that are bad. The output piddle
348             will never contain bad values, but its bad value flag will be the
349             same as the input piddle's flag.
350              
351              
352              
353             =cut
354              
355              
356              
357              
358              
359             *isbad = \&PDLA::isbad;
360              
361              
362              
363              
364              
365             =head2 isgood
366              
367             =for sig
368              
369             Signature: (a(); int [o]b())
370              
371             =for ref
372              
373             Is a value good?
374              
375             Returns a 1 if the value is good, 0 otherwise.
376             Also see L.
377              
378             =for example
379              
380             $x = pdl(1,2,3);
381             $x->badflag(1);
382             set($x,1,$x->badvalue);
383             $y = isgood($x);
384             print $y, "\n";
385             [1 0 1]
386              
387             =for bad
388              
389             This method works with input piddles that are bad. The output piddle
390             will never contain bad values, but its bad value flag will be the
391             same as the input piddle's flag.
392              
393              
394              
395             =cut
396              
397              
398              
399              
400              
401             *isgood = \&PDLA::isgood;
402              
403              
404              
405              
406              
407             =head2 nbadover
408              
409             =for sig
410              
411             Signature: (a(n); indx [o] b())
412              
413             =for ref
414              
415             Find the number of bad elements along the 1st dimension.
416              
417             This function reduces the dimensionality of a piddle by one by finding the
418             number of bad elements along the 1st dimension. In this sense it shares
419             much in common with the functions defined in L. In particular,
420             by using L and similar dimension rearranging methods,
421             it is possible to perform this calculation over I dimension.
422              
423             =for usage
424              
425             $x = nbadover($y);
426              
427             =for example
428              
429             $spectrum = nbadover $image->xchg(0,1)
430              
431             =for bad
432              
433             nbadover processes input values that are bad. The output piddle will not have
434             any bad values, but the bad flag will be set if the input piddle had its bad
435             flag set.
436              
437              
438              
439             =cut
440              
441              
442              
443              
444              
445             *nbadover = \&PDLA::nbadover;
446              
447              
448              
449              
450              
451             =head2 ngoodover
452              
453             =for sig
454              
455             Signature: (a(n); indx [o] b())
456              
457             =for ref
458              
459             Find the number of good elements along the 1st dimension.
460              
461             This function reduces the dimensionality of a piddle
462             by one by finding the number of good elements
463             along the 1st dimension.
464              
465             By using L etc. it is possible to use
466             I dimension.
467              
468             =for usage
469              
470             $x = ngoodover($y);
471              
472             =for example
473              
474             $spectrum = ngoodover $image->xchg(0,1)
475              
476             =for bad
477              
478             ngoodover processes input values that are bad. The output piddle will not have
479             any bad values, but the bad flag will be set if the input piddle had its bad
480             flag set.
481              
482              
483              
484             =cut
485              
486              
487              
488              
489              
490             *ngoodover = \&PDLA::ngoodover;
491              
492              
493              
494              
495             *nbad = \&PDLA::nbad;
496             sub PDLA::nbad {
497 6     6 0 24 my($x) = @_; my $tmp;
  6         11  
498 6         21 $x->clump(-1)->nbadover($tmp=PDLA->nullcreate($x) );
499 6         53 return $tmp->at();
500             }
501              
502              
503              
504             *ngood = \&PDLA::ngood;
505             sub PDLA::ngood {
506 5     5 0 14 my($x) = @_; my $tmp;
  5         8  
507 5         18 $x->clump(-1)->ngoodover($tmp=PDLA->nullcreate($x) );
508 5         52 return $tmp->at();
509             }
510              
511              
512              
513             =head2 nbad
514              
515             =for ref
516              
517             Returns the number of bad values in a piddle
518              
519             =for usage
520              
521             $x = nbad($data);
522              
523             =for bad
524              
525             Accepts good and bad input piddles; output is a Perl scalar
526             and therefore is always good.
527              
528             =head2 ngood
529              
530             =for ref
531              
532             Returns the number of good values in a piddle
533              
534             =for usage
535              
536             $x = ngood($data);
537              
538             =for bad
539              
540             Accepts good and bad input piddles; output is a Perl scalar
541             and therefore is always good.
542              
543             =head2 setbadat
544              
545             =for ref
546              
547             Set the value to bad at a given position.
548              
549             =for usage
550              
551             setbadat $piddle, @position
552              
553             C<@position> is a coordinate list, of size equal to the
554             number of dimensions in the piddle.
555             This is a wrapper around L and is
556             probably mainly useful in test scripts!
557              
558             =for example
559              
560             pdla> $x = sequence 3,4
561             pdla> $x->setbadat 2,1
562             pdla> p $x
563             [
564             [ 0 1 2]
565             [ 3 4 BAD]
566             [ 6 7 8]
567             [ 9 10 11]
568             ]
569              
570             =for bad
571              
572             This method can be called on piddles that have bad values.
573             The remainder of the arguments should be Perl scalars indicating
574             the position to set as bad. The output piddle will have bad values
575             and will have its badflag turned on.
576              
577             =cut
578              
579             *setbadat = \&PDLA::setbadat;
580             sub PDLA::setbadat {
581 12 50   12 0 748 barf 'Usage: setbadat($pdl, $x, $y, ...)' if $#_<1;
582 12         25 my $self = shift;
583 12         41 PDLA::Core::set_c ($self, [@_], $self->badvalue);
584 12         67 $self->badflag(1);
585 12         29 return $self;
586             }
587              
588              
589              
590              
591              
592             =head2 setbadif
593              
594             =for sig
595              
596             Signature: (a(); int mask(); [o]b())
597              
598             =for ref
599              
600             Set elements bad based on the supplied mask, otherwise
601             copy across the data.
602              
603             =for example
604              
605             pdla> $x = sequence(5,5)
606             pdla> $x = $x->setbadif( $x % 2 )
607             pdla> p "a badflag: ", $x->badflag, "\n"
608             a badflag: 1
609             pdla> p "a is\n$x"
610             [
611             [ 0 BAD 2 BAD 4]
612             [BAD 6 BAD 8 BAD]
613             [ 10 BAD 12 BAD 14]
614             [BAD 16 BAD 18 BAD]
615             [ 20 BAD 22 BAD 24]
616             ]
617              
618             Unfortunately, this routine can I be run inplace, since the
619             current implementation can not handle the same piddle used as
620             C and C (eg C<< $x->inplace->setbadif($x%2) >> fails).
621             Even more unfortunate: we can't catch this error and tell you.
622              
623             =for bad
624              
625             The output always has its bad flag set, even if it does not contain
626             any bad values (use L to check
627             whether there are any bad values in the output).
628             The input piddle can have bad values: any bad values in the input piddles
629             are copied across to the output piddle.
630              
631             Also see L and L.
632              
633              
634              
635             =cut
636              
637              
638              
639              
640              
641             *setbadif = \&PDLA::setbadif;
642              
643              
644              
645              
646              
647             =head2 setvaltobad
648              
649             =for sig
650              
651             Signature: (a(); [o]b(); double value)
652              
653             =for ref
654              
655             Set bad all those elements which equal the supplied value.
656              
657             =for example
658              
659             $x = sequence(10) % 3;
660             $x->inplace->setvaltobad( 0 );
661             print "$x\n";
662             [BAD 1 2 BAD 1 2 BAD 1 2 BAD]
663              
664             This is a simpler version of L, but this
665             function can be done inplace. See L
666             if you want to convert NaN/Inf to the bad value.
667              
668             =for bad
669              
670             The output always has its bad flag set, even if it does not contain
671             any bad values (use L to check
672             whether there are any bad values in the output).
673             Any bad values in the input piddles are copied across to the output piddle.
674              
675              
676              
677             =cut
678              
679              
680              
681              
682              
683             *setvaltobad = \&PDLA::setvaltobad;
684              
685              
686              
687              
688              
689             =head2 setnantobad
690              
691             =for sig
692              
693             Signature: (a(); [o]b())
694              
695             =for ref
696              
697             Sets NaN/Inf values in the input piddle bad
698             (only relevant for floating-point piddles).
699             Can be done inplace.
700              
701             =for usage
702              
703             $y = $x->setnantobad;
704             $x->inplace->setnantobad;
705              
706             =for bad
707              
708             This method can process piddles with bad values: those bad values
709             are propagated into the output piddle. Any value that is not finite
710             is also set to bad in the output piddle. If all values from the input
711             piddle are good and finite, the output piddle will B have its
712             bad flag set. One more caveat: if done inplace, and if the input piddle's
713             bad flag is set, it will no
714              
715              
716              
717             =cut
718              
719              
720              
721              
722              
723             *setnantobad = \&PDLA::setnantobad;
724              
725              
726              
727              
728              
729             =head2 setbadtonan
730              
731             =for sig
732              
733             Signature: (a(); [o] b();)
734              
735             =for ref
736              
737             Sets Bad values to NaN
738              
739             This is only relevant for floating-point piddles. The input piddle can be
740             of any type, but if done inplace, the input must be floating point.
741              
742             =for usage
743              
744             $y = $x->setbadtonan;
745             $x->inplace->setbadtonan;
746              
747             =for bad
748              
749             This method processes input piddles with bad values. The output piddles will
750             not contain bad values (insofar as NaN is not Bad as far as PDLA is concerned)
751             and the output piddle does not have its bad flag set. As an inplace
752             operation, it clears the bad flag.
753              
754              
755              
756             =cut
757              
758              
759              
760              
761              
762             *setbadtonan = \&PDLA::setbadtonan;
763              
764              
765              
766              
767              
768             =head2 setbadtoval
769              
770             =for sig
771              
772             Signature: (a(); [o]b(); double newval)
773              
774             =for ref
775              
776             Replace any bad values by a (non-bad) value.
777              
778             Can be done inplace. Also see
779             L.
780              
781             =for example
782              
783             $x->inplace->setbadtoval(23);
784             print "a badflag: ", $x->badflag, "\n";
785             a badflag: 0
786              
787             =for bad
788              
789             The output always has its bad flag cleared.
790             If the input piddle does not have its bad flag set, then
791             values are copied with no replacement.
792              
793              
794              
795             =cut
796              
797              
798              
799              
800              
801             *setbadtoval = \&PDLA::setbadtoval;
802              
803              
804              
805              
806              
807             =head2 copybad
808              
809             =for sig
810              
811             Signature: (a(); mask(); [o]b())
812              
813             =for ref
814              
815             Copies values from one piddle to another, setting them
816             bad if they are bad in the supplied mask.
817              
818             Can be done inplace.
819              
820             =for example
821              
822             $x = byte( [0,1,3] );
823             $mask = byte( [0,0,0] );
824             $mask->badflag(1);
825             set($mask,1,$mask->badvalue);
826             $x->inplace->copybad( $mask );
827             p $x;
828             [0 BAD 3]
829              
830             It is equivalent to:
831              
832             $c = $x + $mask * 0
833              
834             =for bad
835              
836             This handles input piddles that are bad. If either C<$x>
837             or C<$mask> have bad values, those values will be marked
838             as bad in the output piddle and the output piddle will have
839             its bad value flag set to true.
840              
841              
842              
843             =cut
844              
845              
846              
847              
848              
849             *copybad = \&PDLA::copybad;
850              
851              
852              
853             ;
854              
855              
856             =head1 CHANGES
857              
858             The I C configuration option,
859             which - when set - allows per-piddle bad values, was added
860             after the 2.4.2 release of PDLA.
861             The C<$PDLA::Bad::PerPdl> variable can be
862             inspected to see if this feature is available.
863              
864              
865             =head1 CONFIGURATION
866              
867             The way the PDLA handles the various bad value settings depends on your
868             compile-time configuration settings, as held in C.
869              
870             =over
871              
872             =item C<$PDLA::Config{WITH_BADVAL}>
873              
874             Set this configuration option to a true value if you want bad value
875             support. The default setting is for this to be true.
876              
877             =item C<$PDLA::Config{BADVAL_USENAN}>
878              
879             Set this configuration option to a true value if you want floating-pont
880             numbers to use NaN to represent the bad value. If set to false, you can
881             use any number to represent a bad value, which is generally more
882             flexible. In the default configuration, this is set to a false value.
883              
884             =item C<$PDLA::Config{BADVAL_PER_PDLA}>
885              
886             Set this configuration option to a true value if you want each of your
887             piddles to keep track of their own bad values. This means that for one
888             piddle you can set the bad value to zero, while in another piddle you
889             can set the bad value to NaN (or any other useful number). This is
890             usually set to false.
891              
892             =back
893              
894             =head1 AUTHOR
895              
896             Doug Burke (djburke@cpan.org), 2000, 2001, 2003, 2006.
897              
898             The per-piddle bad value support is by Heiko Klein (2006).
899              
900             CPAN documentation fixes by David Mertens (2010, 2013).
901              
902             All rights reserved. There is no warranty. You are allowed to
903             redistribute this software / documentation under certain conditions. For
904             details, see the file COPYING in the PDLA distribution. If this file is
905             separated from the PDLA distribution, the copyright notice should be
906             included in the file.
907              
908             =cut
909              
910              
911              
912              
913              
914             # Exit with OK status
915              
916             1;
917              
918