Math-Business-BlackscholesMerton
view release on metacpan or search on metacpan
# Math::Business::BlackScholesMerton
[](https://travis-ci.org/binary-com/perl-math-business-blackscholesmerton)
[](https://codecov.io/gh/binary-com/perl-math-business-blackscholesmerton)
Prices options using the GBM model, all closed formulas.
Important(a): Basically, one_touch, up_or_down and double_touch 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.
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;
( run in 0.272 second using v1.01-cache-2.11-cpan-26ccb49234f )