#
# Create BAD_demo.pm
# - needed since we allow bad pixel handling to be switched off
#

use strict;

use Config;
use File::Basename qw(&basename &dirname);
use blib;

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
my $file;
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file\n";
chmod 0644, $file;

print OUT <<'!NO!SUBS!';
#
# Created by BAD_demo.pm.PL
#  ** DO NOT EDIT THIS FILE **
#
package PDL::Demos::BAD_demo;
use PDL;

PDL::Demos::Routines->import();
sub comment($);
sub act($);
sub output;

sub run {

comment q|
    Welcome to this tour of the bad value support in PDL

    Each ndarray contains a flag - accessible via the badflag() method -
    which indicates whether:

       the ndarray contains no bad values (flag equals 0)
       the ndarray *MAY* contain bad values (flag equals 1)

    If the flag is set, then the routines (well, those that have been
    converted) will process these bad values correctly, otherwise they
    are ignored.

    The code has been written so as to provide as little overhead as
    possible; therefore there should be almost no difference in the
    time it takes to process ndarrays which do not have their bad flag
    set.

|;

act q|

    # There are 2 ways to see whether bad-value support has been
    # compiled into your perldl or pdl2 shell:
    print("You can use bad values.\n");

    # note that PDL::Bad is included by default when you use
    # 'use PDL', 'use PDL::Lite', or 'use PDL::LiteF'

|;

act q|

    # create an ndarray
    $x = byte(1,2,3);
    print( "Bad flag (x) == ", $x->badflag(), "\n" );

    # set bad flag, even though all the data is good
    $x->badflag(1);
    print( "Bad flag (x) == ", $x->badflag(), "\n" );

    # note the bad flag is infectious
    $y = 2 * $x;
    print( "Bad flag (y) == ", $y->badflag(), "\n\n" );

|;

act q|

    # the badflag is also included in the state info of
    # ndarray
    #
    $c = pdl(2,3); # just an ndarray without the badflag set

    print "   Type   Dimension        State          Mem\n";
    print "-------------------------------------------------\n";
    print "x ", $x->info("%-6T %-15D   %-5S  %12M"), "\n";
    print "y ", $y->info("%-6T %-15D   %-5S  %12M"), "\n";
    print "c ", $c->info("%-6T %-15D   %-5S  %12M"), "\n\n";
|;

act q|

    print "No bad values:   $x\n";
    # set the middle value bad
    $x->setbadat(1);

    # now print out
    print "Some bad values: $x\n";
    print "b contains:      $y\n";
    $c = $x + $y;
    print "so x + y =       $c\n\n";

|;

act q|

    # The module PDL::Bad contains a number of routines designed
    # to make using bad values easy.
    print "x contains ", $x->nbad, " bad elements.\n";
    print "The bad value for type #",$x->get_datatype," is ",$x->badvalue,"\n";
    print "It is easy to find whether a value is good: ", isgood($x), "\n\n";

    print "or to remove the bad values\n";
    $x->inplace->setbadtoval(23);
    print "x = $x and \$x->badflag == ", $x->badflag, "\n\n";

|;

act q|

    print "We can even label certain values as bad!\n";
    $x = sequence(3,3);
    $x = $x->setbadif( $x % 2 ); # unfortunately can not be done inplace
    print $x;

|;

act q|

    # the issue of how to cope with dataflow is not fully resolved. At
    # present, if you change the badflag of an ndarray, all its children
    # are also changed:
    $x = sequence( byte, 2, 3 );
    $x = $x->setbadif( $x == 3 );
    $y = $x->slice("(1),:");
    print "y = $y\tbadflag = ", $y->badflag, "\n";

    $x->inplace->setbadtoval(3);
    print "y = $y\tbadflag = ", $y->badflag, "\n\n";

|;

act q|

    # Note that "boolean" operators return a bad value if either of the
    # operands are bad: one way around this is to replace all bad values
    # by 0 or 1.

    $x = sequence(3,3); $x = $x->setbadif( $x % 2 );
    print $x > 5;
    print setbadtoval($x > 5,0);  # set all bad values to false

|;

act q|
    # One area that is likely to cause confusion is the return value from
    # comparison operators (e.g. all and any) when ALL elements are bad.

    # Currently, the bad value is returned; however most code will not
    # be aware of this and just see it as a true or false value (depending
    # on the numerical value used to store bad values).

    # There is also the fact that the bad value need not relate to the
    # type of the input ndarray (due to internal conversion to an 'int +').

    $x = ones(3); $x = $x->setbadif( $x == 1 );
    print "Any returns: ", any( $x > 2 ), "\n";
    print "which is the bad value of 'long' (", long->badvalue, ").\n";

    print "Whereas the bad value for \$x is: ", $x->badvalue, "\n";

|;

comment q|
    Many of the 'core' routines have been converted to handle bad values.
    However, some (including most of the additional modules) have not,
    either because it does not make sense or its too much work to do!

    To find out the status of a particular routine, use the 'badinfo'
    command in perldl or pdl2 shell (this information is also included
    when you do 'help'), or the '-b' switch of pdldoc.

|;

}

1;

!NO!SUBS!

# end
