File Coverage

blib/lib/Math/Business/DMI.pm

Criterion	Covered	Total	%
statement	88	96	91.6
branch	21	26	80.7
condition	9	12	75.0
subroutine	9	12	75.0
pod	0	8	0.0
total	127	154	82.4

package Math::Business::DMI;

use strict;
use warnings;
use Carp;

use Math::Business::ATR;

1;

sub tag { (shift)->{tag} }

sub recommended {
    my $class = shift;

    $class->new(14);
}

sub new {
    my $class = shift;
    my $this  = bless {
        ATR => new Math::Business::ATR,
    }, $class;

    my $days = shift;
    if( defined $days ) {
        $this->set_days( $days );
    }

    return $this;
}

sub set_days {
    my $this = shift;
    my $arg  = int(shift);

    croak "days must be a positive non-zero integer" if $arg <= 0;

    $this->{ATR}->set_days($arg);
    $this->{days} = $arg;
    $this->{R}  = ($arg-1)/$arg;
    $this->{R1} = 1/$arg;

    $this->{tag} = "DMI($this->{days})";
}

sub insert {
    my $this = shift;

    my $y_point = $this->{y};
    while( defined( my $point = shift ) ) {
        croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3;
        my ($t_high, $t_low, $t_close) = @$point;

        if( defined $y_point ) {
            my $atr = $this->{ATR};
               $atr->insert($point);

            my ($y_high, $y_low, $y_close) = @$y_point;

            my ($PDM, $MDM) = (0,0);
            my $A = $t_high - $y_high;
            my $B = $y_low  - $t_low;

            if( $A > 0 and $A > $B ) {
                $PDM = $A;
                $MDM = 0;

            } elsif( $B > 0 and $B > $A ) {
                $PDM = 0;
                $MDM = $B;
            }

            if( defined(my $pdm = $this->{aPDM}) ) {
                my $mdm = $this->{aMDM};

                my $R  = $this->{R};
                my $R1 = $this->{R1};

                my $aPDM = $this->{aPDM} = $R * $pdm + $R1 * $PDM;
                my $aMDM = $this->{aMDM} = $R * $mdm + $R1 * $MDM;

                my $ATR = $atr->query;

                if( $ATR == 0 ) {
                    my $DX = $this->{PDI} = $this->{MDI} = 0;
                    $this->{ADX} = $R * $this->{ADX} + $R1 * $DX;

                } else {
                    my $PDI = $this->{PDI} = $aPDM / $ATR;
                    my $MDI = $this->{MDI} = $aMDM / $ATR;

                    my $DI = abs( $PDI - $MDI );
                    my $DX = $DI ? $DI / ($PDI + $MDI) : 0;
                    # 0/0 is indeterminent form, but I think 0 makes sense

                    $this->{ADX} = $R * $this->{ADX} + $R1 * $DX;
                }

            } else {
                my $p;
                my $N = $this->{days};
                if( ref($p = $this->{_p}) and (@$p >= $N-1) ) {
                    my $psum = 0;
                       $psum += $_ for @$p;
                       $psum += $PDM;

                    my $m = $this->{_m};
                    my $msum = 0;
                       $msum += $_ for @$m;
                       $msum += $MDM;

                    my $aPDM = $this->{aPDM} = $psum / $N;
                    my $aMDM = $this->{aMDM} = $msum / $N;

                    my $ATR = $atr->query;
                    if( $ATR == 0 ) {
                        $this->{PDI} = $this->{MDI} = $this->{ADX} = 0;

                    } else {
                        my $PDI = $this->{PDI} = $aPDM / $ATR;
                        my $MDI = $this->{MDI} = $aMDM / $ATR;

                        my $DI = abs( $PDI - $MDI );
                        my $DX = $DI ? $DI / ($PDI + $MDI) : 0;
                        # 0/0 is indeterminent form, but I think 0 makes sense

                        $this->{ADX} = $DX; # is this right?  No idea...  I assume this is well documented in his book
                    }

                    delete $this->{_p};
                    delete $this->{_m};

                } else {
                    push @{$this->{_p}}, $PDM;
                    push @{$this->{_m}}, $MDM;
                }
            }
        }

        $y_point = $point;
    }

    $this->{y} = $y_point;
}

sub query_pdi  { my $this = shift; return $this->{PDI}; }
sub query_mdi  { my $this = shift; return $this->{MDI}; }

sub query {
    my $this = shift;

    return ($this->{PDI}, $this->{MDI}, $this->{ADX}) if wantarray;
    return $this->{ADX};
}

__END__