Math-Business-BlackScholesMerton

 view release on metacpan or  search on metacpan

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

        1.35,       # stock price
        1.36,       # barrier
        (7/365),    # time
        0.002,      # payout currency interest rate (0.05 = 5%)
        0.001,      # quanto drift adjustment (0.05 = 5%)
        0.11,       # volatility (0.3 = 30%)
    );

=head1 DESCRIPTION

Prices options using the GBM model, all closed formulas.

Important(a): Basically, onetouch, upordown and doubletouch have two cases of
payoff either at end or at hit. We treat them differently. We use parameter
$w to differ them.

$w = 0: payoff at hit time.
$w = 1: payoff at end.

Our current contracts pay rebate at hit time, so we set $w = 0 by default.

Important(b) :Furthermore, for all contracts, we allow a different
payout currency (Quantos).

Paying domestic currency (JPY if for USDJPY) = correlation coefficient is ZERO.
Paying foreign currency (USD if for USDJPY) = correlation coefficient is ONE.
Paying another currency = correlation is between negative ONE and positive ONE.

See [3] for Quanto formulas and examples

=head1 SUBROUTINES

=head2 call

    USAGE
    my $price = call($S, $K, $t, $r_q, $mu, $sigma)

    PARAMS
    $S => stock price

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

    $t => time (1 = 1 year)
    $r_q => payout currency interest rate (0.05 = 5%)
    $mu => quanto drift adjustment (0.05 = 5%)
    $sigma => volatility (0.3 = 30%)

    DESCRIPTION
    Price a Call and remove the N(d2) part if the time is too small

    EXPLANATION
    The definition of the contract is that if S > K, it gives
    full payout (1).  However the formula DC(T,K) = e**(-rT) N(d2) will not be
    correct when T->0 and K=S.  The value of DC(T,K) for this case will be 0.5.

    The formula is actually "correct" because when T->0 and S=K, the probability
    should just be 0.5 that the contract wins, moving up or down is equally
    likely in that very small amount of time left. Thus the only problem is
    that the math cannot evaluate at T=0, where divide by 0 error occurs. Thus,
    we need this check that throws away the N(d2) part (N(d2) will evaluate
    "wrongly" to 0.5 if S=K).

    NOTE
    Note that we have call = - dCall/dStrike
    pair Foreign/Domestic

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

    if ($t < $SMALLTIME) {
        return ($S < $K) ? exp(-$r_q * $t) : 0;
    }

    return exp(-$r_q * $t) * pnorm(-1 * d2($S, $K, $t, $r_q, $mu, $sigma));
}

=head2 d2

returns the DS term common to many BlackScholesMerton formulae.

=cut

sub d2 {
    my ($S, $K, $t, undef, $mu, $sigma) = @_;

    return (log($S / $K) + ($mu - $sigma * $sigma / 2.0) * $t) / ($sigma * sqrt($t));
}

=head2 expirymiss

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

sub onetouch {
    my ($S, $U, $t, $r_q, $mu, $sigma, $w) = @_;

    # w = 0, rebate paid at hit (good way to remember is that waiting
    #   time to get paid = 0)
    # w = 1, rebate paid at end.

    # When the contract already reached it expiry and not yet reach it
    # settlement time, it is consider an unexpired contract but will come to
    # here with t=0 and it will caused the formula to die hence set it to the
    # SMALLTIME which is 1 second
    $t = max($SMALLTIME, $t);

    $w ||= 0;

    # eta = -1, one touch up
    # eta = 1, one touch down
    my $eta = ($S < $U) ? -1 : 1;

    my $sqrt_t = sqrt($t);

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

#
our $MIN_ACCURACY_UPORDOWN_PELSSER_1997 = 1.0 / 100000.0;
our $SMALL_VALUE_MU                     = 1e-10;

# The smallest (in magnitude) floating-point number which,
# when added to the floating-point number 1.0, produces a
# floating-point result different from 1.0 is termed the
# machine accuracy, e.
#
# This value is very important for knowing stability to
# certain formulas used. e.g. Pelsser formula for UPORDOWN
# and RANGE contracts.
#
my $MACHINE_EPSILON = machine_epsilon();

=head2 upordown

    USAGE
    my $price = upordown(($S, $U, $D, $t, $r_q, $mu, $sigma, $w))

    PARAMS

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

    DESCRIPTION
    Price an Up or Down contract

=cut

sub upordown {
    my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w) = @_;

    # When the contract already reached it's expiry and not yet reach it
    # settlement time, it is considered an unexpired contract but will come to
    # here with t=0 and it will caused the formula to die hence set it to the
    # SMALLTIME whiich is 1 second
    $t = max($t, $SMALLTIME);

    # $w = 0, paid at hit
    # $w = 1, paid at end
    if (not defined $w) { $w = 0; }

    # spot is outside [$D, $U] --> contract is expired with full payout,
    # one barrier is already hit (can happen due to shift markup):
    if ($S >= $U or $S <= $D) {

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

#   CONDITION 4:    ONETOUCH[U] + ONETOUCH[D] >= $MIN_ACCURACY_UPORDOWN_PELSSER_1997
#
    my $onetouch_up_prob   = onetouch($S, $U, $t, $r_q, $mu, $sigma, $w);
    my $onetouch_down_prob = onetouch($S, $D, $t, $r_q, $mu, $sigma, $w);

    my $upordown_prob;

    if ($onetouch_up_prob + $onetouch_down_prob < $MIN_ACCURACY_UPORDOWN_PELSSER_1997) {

        # CONDITION 4:
        #   The probability is too small for the Pelsser formula to be correct.
        #   Do this check first to avoid PELSSER stability condition to be
        #   triggered.
        #   Here we assume that the ONETOUCH formula is perfect and never give
        #   wrong values (e.g. negative).
        return 0;
    } elsif ($onetouch_up_prob xor $onetouch_down_prob) {

        # One of our ONETOUCH probabilities is 0.
        # That means our upordown prob is equivalent to the other one.
        # Pelsser recompute will either be the same or wrong.
        # Continuing to assume the ONETOUCH is perfect.
        $upordown_prob = max($onetouch_up_prob, $onetouch_down_prob);
    } else {

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

    }

    # CONDITION 4:
    #   Now check on the other end, when the contract is too close to payout.
    #   Not really needed to check for payout at hit, because RANGE is
    #   always at end, and thus the value (DISCOUNT - UPORDOWN) is not
    #   evaluated.
    if ($w == 1) {

        # Since the difference is already less than the min accuracy,
        # the value [payout - upordown], which is the RANGE formula
        # can become negative.
        if (abs(exp(-$r_q * $t) - $upordown_prob) < $MIN_ACCURACY_UPORDOWN_PELSSER_1997) {
            $upordown_prob = exp(-$r_q * $t);
        }
    }

# CONDITION 1-3
#   We use hardcoded small value of $SMALL_TOLERANCE, because if we were to increase
#   the minimum accuracy, and this small value uses that min accuracy, it is
#   very hard for the conditions to pass.

lib/Math/Business/BlackScholesMerton/Binaries.pm  view on Meta::CPAN

    # These constants will determine whether or not this contract can be
    # evaluated to a predefined accuracy. It is VERY IMPORTANT because
    # if these conditions are not met, the prices can be complete nonsense!!
    my $stability_constant = get_stability_constant_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta, 1);

    # The number of iterations is important when recommending the
    # range of the upper/lower barriers on our site. If we recommend
    # a range that is too big and our iteration is too small, the
    # price will be wrong! We must know the rate of convergence of
    # the formula used.
    my $iterations_required = get_min_iterations_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w);

    for (my $k = 1; $k < $iterations_required; $k++) {
        my $lambda_k_dash = (0.5 * (($mu_dash * $mu_dash) / ($sigma * $sigma) + ($k * $k * $pi * $pi * $sigma * $sigma) / ($h * $h)));

        my $phi = ($sigma * $sigma) / ($h * $h) * exp(-$lambda_k_dash * $t) * $k / $lambda_k_dash;

        $series_part += $phi * $pi * sin($k * $pi * ($h - $x) / $h);

        #
        # Note that greeks may also call this function, and their
        # stability constant will differ. However, for simplicity
        # we will not bother (else the code will get messy), and
        # just use the price stability constant.
        #
        if ($k == 1 and (not(abs($phi) < $stability_constant))) {
            die "PELSSER VALUATION formula for S=$S, U=$U, D=$D, t=$t, r_q=$r_q, "
                . "mu=$mu, vol=$sigma, w=$w, eta=$eta, cannot be evaluated because"
                . "PELSSER VALUATION stability conditions ($phi less than "
                . "$stability_constant) not met. This could be due to barriers "
                . "too big, volatilities too low, interest/dividend rates too high, "
                . "or machine accuracy too low. Machine accuracy is "
                . $MACHINE_EPSILON . ".";
        }
    }

    #

lib/Math/Business/BlackScholesMerton/NonBinaries.pm  view on Meta::CPAN

        1.35,       # stock price
        1.34,       # barrier
        (7/365),    # time
        0.002,      # payout currency interest rate (0.05 = 5%)
        0.001,      # quanto drift adjustment (0.05 = 5%)
        0.11,       # volatility (0.3 = 30%)
    );

=head1 DESCRIPTION

Contains non-binary option pricing formula.

=cut

=head2 vanilla_call

    USAGE
    my $price = vanilla_call($S, $K, $t, $r_q, $mu, $sigma);

    DESCRIPTION
    Price of a Vanilla Call

lib/Math/Business/BlackScholesMerton/NonBinaries.pm  view on Meta::CPAN

sub lbhighlow {
    my ($S, $K, $t, $r_q, $mu, $sigma, $S_max, $S_min) = @_;

    my $value = lbfloatcall($S, $S_min, $t, $r_q, $mu, $sigma, $S_max, $S_min) + lbfloatput($S, $S_max, $t, $r_q, $mu, $sigma, $S_max, $S_min);

    return $value;
}

=head2 _d1_function

returns the d1 term common to many BlackScholesMerton formulae.

=cut

sub _d1_function {
    my ($S, $K, $t, $r_q, $mu, $sigma) = @_;

    my $value = (log($S / $K) + ($mu + $sigma * $sigma * 0.5) * $t) / ($sigma * sqrt($t));

    return $value;
}

t/BlackScholes.t  view on Meta::CPAN

        foreign  => 1,
        domestic => 1,
    },

);

foreach
    my $test_group (['Math::Business::BlackScholesMerton::Binaries::', \@binaries], ['Math::Business::BlackScholesMerton::NonBinaries::', \@vanillas])
{
    foreach my $test_case (@{$test_group->[1]}) {
        my $formula_name = $test_group->[0] . $test_case->{type};
        my %probs        = (
            domestic => &$formula_name($S, @{$test_case->{barriers}}, $t, $r, $r - $q,             $sigma),
            foreign  => &$formula_name($S, @{$test_case->{barriers}}, $t, $q, $r - $q + $sigma**2, $sigma),
        );

        foreach my $curr (sort keys %probs) {
            my $length    = length($test_case->{$curr});
            my $precision = ($length < 2) ? 1 : 10**(-1 * ($length - 2));
            is(roundnear($precision, $probs{$curr}), $test_case->{$curr}, $test_case->{type} . ' ' . $curr);
        }
    }
}

t/benchmark.t  view on Meta::CPAN

    my $spot          = $args->{spot};
    my $discount_rate = $args->{discount_rate};
    my $t             = $args->{t};
    my $mu            = $args->{mu};
    my $sigma         = $args->{vol};
    my $s_max         = $args->{spot_max};
    my $s_min         = $args->{spot_min};

    my $price;

    my $formula = 'Math::Business::BlackScholesMerton::NonBinaries::' . $type;

    my $func = \&$formula;

    $price = $func->($spot, $strike, $t, $discount_rate, $mu, $sigma, $s_max, $s_min);

    my $diff = abs($price - $expected) / $expected;

    cmp_ok($diff, '<', 0.08, 'Diff is within permissible range');
}

sub test_greek {
    my $args     = shift;

t/benchmark.t  view on Meta::CPAN

    my $spot          = $args->{spot};
    my $discount_rate = $args->{discount_rate};
    my $t             = $args->{t};
    my $mu            = $args->{mu};
    my $sigma         = $args->{vol};
    my $s_max         = $args->{spot_max};
    my $s_min         = $args->{spot_min};

    my $price;

    my $formula = 'Math::Business::Lookback::Greeks::Delta::' . $type;

    my $func = \&$formula;

    $price = $func->($spot, $strike, $t, $discount_rate, $mu, $sigma, $s_max, $s_min);

    my $diff = abs($price - $expected) / $expected;
    cmp_ok($diff, '<', 0.12, 'Diff is within permissible range');
}

done_testing;

t/price_test.t  view on Meta::CPAN

    my $spot          = $args->{spot};
    my $discount_rate = $args->{discount_rate};
    my $t             = $args->{t};
    my $mu            = $args->{mu};
    my $sigma         = $args->{vol};
    my $s_max         = $args->{spot_max};
    my $s_min         = $args->{spot_min};

    my $price;

    my $formula = 'Math::Business::BlackScholesMerton::NonBinaries::' . $type;

    my $func = \&$formula;

    $price = $func->($spot, $strike, $t, $discount_rate, $mu, $sigma, $s_max, $s_min);

    is roundnear(0.00001, $price), roundnear(0.00001, $expected), "correct price for " . $type;
}

done_testing;