/ 
PDL-2.4.5_003
River stage three • 116 direct dependents • 124 total dependents
/ Basic/Ops/ops.pd

NAME

PDL::Ops - Fundamental mathematical operators

DESCRIPTION

This module provides the functions used by PDL to overload the basic mathematical operators (+ - / * etc.) and functions (sin sqrt etc.)

It also includes the function log10, which should be a perl function so that we can overload it!

Matrix multiplication (the operator x) is handled by the module PDL::Primitive.

SYNOPSIS

none

AUTHOR

Tuomas J. Lukka (lukka@fas.harvard.edu), Karl Glazebrook (kgb@aaoepp.aao.gov.au), Doug Hunt (dhunt@ucar.edu), Christian Soeller (c.soeller@auckland.ac.nz), Doug Burke (burke@ifa.hawaii.edu), and Craig DeForest (deforest@boulder.swri.edu).

$doc

\$c = $name \$a, \$b, 0;     # explicit call with trailing 0
\$c = \$a $op \$b;           # overloaded call
\$a->inplace->$name(\$b,0);  # modify \$a inplace

It can be made to work inplace with the \$a->inplace syntax. This function is used to overload the binary $optxt operator. Note that when calling this function explicitly you need to supply a third argument that should generally be zero (see first example). This restriction is expected to go away in future releases. EOD } # sub: biop()

#simple binary functions sub bifunc { my ($name,$func,$swap,$doc,%extra) = @_; my $funcov = ref $func eq 'ARRAY' ? $func->[1] : $func; my $isop=0; if ($funcov =~ s/^op//) { $isop = 1; } my $funcovp = protect_chars $funcov; $func = $func->[0] if ref $func eq 'ARRAY'; if ($swap) { $extra{HdrCode} .= << 'EOH'; pdl *tmp; if (swap) { tmp = a; a = b; b = tmp; } EOH } my $ovcall; # is this one to be used as a function or operator ? if ($isop) { $ovcall = "\$c = \$a $funcov \$b; # overloaded use"; } else { $ovcall = "\$c = $funcov \$a, \$b; # overloaded use"; }

#a little dance to avoid the MOD macro warnings for byte & ushort datatypes my $codestr; my $badcodestr; if ($extra{unsigned}){ $codestr = << "ENDCODE"; types(BU) %{ \$c() = BU_$func(\$a(),\$b()); %} types(SLFD) %{ \$c() = $func(\$a(),\$b()); %} ENDCODE } else { $codestr = "\$c() = $func(\$a(),\$b());"; } delete $extra{unsigned}; #remove the key so it doesn't get added in pp_def.

 $badcodestr = 'if ( $ISBAD(a()) || $ISBAD(b()) )
	       $SETBAD(c());
	       else {' . $codestr . " } \n";
#end dance

    pp_def($name,
	   HandleBad => 1,
	   NoBadifNaN => 1,
	   Pars => 'a(); b(); [o]c();',
	   OtherPars => 'int swap',
	   Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job
	   Code => $codestr,
	   BadCode => $badcodestr, 
	   CopyBadStatusCode =>
	   'if ( $BADFLAGCACHE() ) {
               if ( a == c && $ISPDLSTATEGOOD(a) ) {
                  PDL->propogate_badflag( c, 1 ); /* have inplace op AND badflag has changed */
               }
               $SETPDLSTATEBAD(c);
            }',
	   %extra,
	   Doc => << "EOD");
=for ref

$doc

\$c = \$a->$name(\$b,0); # explicit function call
$ovcall
\$a->inplace->$name(\$b,0);     # modify \$a inplace

It can be made to work inplace with the \$a->inplace syntax. This function is used to overload the binary $funcovp function. Note that when calling this function explicitly you need to supply a third argument that should generally be zero (see first example). This restriction is expected to go away in future releases. EOD } # sub: bifunc()

# simple unary functions and operators sub ufunc { my ($name,$func,$doc,%extra) = @_; my $funcov = ref $func eq 'ARRAY' ? $func->[1] : $func; my $funcovp = protect_chars $funcov; $func = $func->[0] if ref $func eq 'ARRAY';

    # handle exceptions
    my $badcode = '$ISBAD(a())';
    if ( exists $extra{Exception} ) {
#	$badcode .= " || $extra{Exception}";
#	print "Warning: ignored exception for $name\n";
	delete $exists{Exception};
    }

    # do not have to worry about propogation of the badflag when
    # inplace since only input piddle is a, hence its badflag
    # won't change
    # UNLESS an exception occurs...
    pp_def($name,
	   Pars => 'a(); [o]b()',
	   HandleBad => 1,
	   NoBadifNaN => 1,
	   Inplace => 1,
	   Code => 
	   "\$b() = $func(\$a());",
	   BadCode =>
	   'if ( ' . $badcode . ' )
	      $SETBAD(b());
	   else' . "\n  \$b() = $func(\$a());\n",
	   %extra,
	   Doc => << "EOD");
=for ref

$doc

\$b = $funcov \$a;
\$a->inplace->$name;  # modify \$a inplace

It can be made to work inplace with the \$a->inplace syntax. This function is used to overload the unary $funcovp operator/function. EOD } # sub: ufunc()

######################################################################

# we trap some illegal operations here -- see the Exception option # note, for the ufunc()'s, the checks do not work too well # for unsigned integer types (ie < 0) # # XXX needs thinking about # - have to integrate into Code section as well (so # 12/pdl(2,4,0,3) is trapped and flagged bad) # --> complicated # - perhaps could use type %{ %} ? # # ==> currently have commented out the exception code, since # want to see if can use NaN/Inf for bad values # (would solve many problems for F,D types) # # there is an issue over how we handle comparison operators # - see Primitive/primitive.pd/zcover() for more discussion #

## arithmetic ops # no swap biop('plus','+',0,'add two piddles'); biop('mult','*',0,'multiply two piddles');

# all those need swapping biop('minus','-',1,'subtract two piddles'); biop('divide','/',1,'divide two piddles', Exception => '$b() == 0' );

## note: divide should perhaps trap division by zero as well

## comparison ops # need swapping biop('gt','>',1,'the binary > (greater than) operation'); biop('lt','<',1,'the binary < (less than) operation'); biop('le','<=',1,'the binary <= (less equal) operation'); biop('ge','>=',1,'the binary >= (greater equal) operation'); # no swap required biop('eq','==',0,'binary equal to operation (==)'); biop('ne','!=',0,'binary not equal to operation (!=)');

## bit ops # those need to be limited to the right types my $T = [B,U,S,L]; # the sensible types here biop('shiftleft','<<',1,'leftshift a$ by $b',GenericTypes => $T); biop('shiftright','>>',1,'leftshift a$ by $b',GenericTypes => $T); biop('or2','|',0,'binary or of two piddles',GenericTypes => $T); biop('and2','&',0,'binary and of two piddles',GenericTypes => $T); biop('xor','^',0,'binary exclusive or of two piddles',GenericTypes => $T);

# really an ufunc ufunc('bitnot','~','unary bit negation',GenericTypes => $T);

# some standard binary functions bifunc('power',['pow','op**'],1,'raise piddle $a to the power b',GenericTypes => [D]); bifunc('atan2','atan2',1,'elementwise atan2 of two piddles',GenericTypes => [D]); bifunc('modulo',['MOD','op%'],1,'elementwise modulo operation',unsigned=>1); bifunc('spaceship',['SPACE','op<=>'],1,'elementwise "<=>" operation');

# some standard unary functions ufunc('sqrt','sqrt','elementwise square root', Exception => '$a() < 0' ); ufunc('abs',['ABS','abs'],'elementwise absolute value',GenericTypes => [D,F,S,L]); ufunc('sin','sin','the sin function'); ufunc('cos','cos','the cos function'); ufunc('not','!','the elementwise not operation'); ufunc('exp','exp','the exponential function',GenericTypes => [D]); ufunc('log','log','the natural logarithm',GenericTypes => [D], Exception => '$a() <= 0' );

pp_export_nothing();

# make log10() work on scalars (returning scalars) # as well as piddles ufunc('log10','log10','the base 10 logarithm', GenericTypes => [D], Exception => '$a() <= 0', PMCode => ' sub PDL::log10 { my $x = shift; if ( ! UNIVERSAL::isa($x,"PDL") ) { return log($x) / log(10); } my $y; if ( $x->is_inplace ) { $x->set_inplace(0); $y = $x; } elsif( ref($x) eq "PDL"){ #PDL Objects, use nullcreate: $y = PDL->nullcreate($x); }else{ #PDL-Derived Object, use copy: (Consistent with # Auto-creation docs in Objects.pod) $y = $x->copy; } &PDL::_log10_int( $x, $y ); return $y; }; ' );

# note: the extra code that adding 'HandleBad => 1' creates is # unneeded here. Things could be made clever enough to work this out, # but it's very low priority. # It does add doc information though, and lets people know it's been # looked at for bad value support # DJB adds: not completely sure about this now that I have added code # to avoid a valgrind-reported error (see the CacheBadFlagInit rule # in PP.pm) # # Can't this be handled in Core.pm when '.=' is overloaded ? # pp_def( 'assgn', # HandleBad => 1, Pars => 'a(); [o]b();', Code => '$b() = $a();', # BadCode => # 'if ( $ISBAD(a()) ) { $SETBAD(b()); } else { $b() = $a(); }', Doc => 'Plain numerical assignment. This is used to implement the ".=" operator', ); # pp_def assgn

#pp_export_nothing();

pp_done();