File Coverage

lib/Math/Business/BlackScholesMerton/Binaries.pm
Criterion Covered Total %
statement 150 153 98.0
branch 48 52 92.3
condition 16 24 66.6
subroutine 22 22 100.0
pod 14 14 100.0
total 250 265 94.3


line stmt bran cond sub pod time code
1             package Math::Business::BlackScholesMerton::Binaries;
2 10     10   848108 use strict;
  10         89  
  10         204  
3 10     10   33 use warnings;
  10         13  
  10         436  
4              
5             our $VERSION = '1.24'; ## VERSION
6             #
7             my $SMALLTIME = 1 / (60 * 60 * 24 * 365); # 1 second in years;
8              
9 10     10   42 use List::Util qw(max);
  10         12  
  10         793  
10 10     10   3485 use Math::CDF qw(pnorm);
  10         21270  
  10         417  
11 10     10   3830 use Math::Trig;
  10         97940  
  10         1050  
12 10     10   3895 use Machine::Epsilon;
  10         2831  
  10         18292  
13              
14             # ABSTRACT: Algorithm of Math::Business::BlackScholesMerton::Binaries
15              
16             =head1 NAME
17              
18             Math::Business::BlackScholesMerton::Binaries
19              
20             =head1 SYNOPSIS
21              
22             use Math::Business::BlackScholesMerton::Binaries;
23              
24             # price of a Call option
25             my $price_call_option = Math::Business::BlackScholesMerton::Binaries::call(
26             1.35, # stock price
27             1.36, # barrier
28             (7/365), # time
29             0.002, # payout currency interest rate (0.05 = 5%)
30             0.001, # quanto drift adjustment (0.05 = 5%)
31             0.11, # volatility (0.3 = 30%)
32             );
33              
34             =head1 DESCRIPTION
35              
36             Prices options using the GBM model, all closed formulas.
37              
38             Important(a): Basically, onetouch, upordown and doubletouch have two cases of
39             payoff either at end or at hit. We treat them differently. We use parameter
40             $w to differ them.
41              
42             $w = 0: payoff at hit time.
43             $w = 1: payoff at end.
44              
45             Our current contracts pay rebate at hit time, so we set $w = 0 by default.
46              
47             Important(b) :Furthermore, for all contracts, we allow a different
48             payout currency (Quantos).
49              
50             Paying domestic currency (JPY if for USDJPY) = correlation coefficient is ZERO.
51             Paying foreign currency (USD if for USDJPY) = correlation coefficient is ONE.
52             Paying another currency = correlation is between negative ONE and positive ONE.
53              
54             See [3] for Quanto formulas and examples
55              
56             =head1 SUBROUTINES
57              
58             =head2 call
59              
60             USAGE
61             my $price = call($S, $K, $t, $r_q, $mu, $sigma)
62              
63             PARAMS
64             $S => stock price
65             $K => barrier
66             $t => time (1 = 1 year)
67             $r_q => payout currency interest rate (0.05 = 5%)
68             $mu => quanto drift adjustment (0.05 = 5%)
69             $sigma => volatility (0.3 = 30%)
70              
71             DESCRIPTION
72             Price a Call and remove the N(d2) part if the time is too small
73              
74             EXPLANATION
75             The definition of the contract is that if S > K, it gives
76             full payout (1). However the formula DC(T,K) = e^(-rT) N(d2) will not be
77             correct when T->0 and K=S. The value of DC(T,K) for this case will be 0.5.
78              
79             The formula is actually "correct" because when T->0 and S=K, the probability
80             should just be 0.5 that the contract wins, moving up or down is equally
81             likely in that very small amount of time left. Thus the only problem is
82             that the math cannot evaluate at T=0, where divide by 0 error occurs. Thus,
83             we need this check that throws away the N(d2) part (N(d2) will evaluate
84             "wrongly" to 0.5 if S=K).
85              
86             NOTE
87             Note that we have call = - dCall/dStrike
88             pair Foreign/Domestic
89              
90             see [3] for $r_q and $mu for quantos
91              
92             =cut
93              
94             sub call {
95 13     13 1 7971 my ($S, $K, $t, $r_q, $mu, $sigma) = @_;
96              
97 13 100       34 if ($t < $SMALLTIME) {
98 2 100       10 return ($S > $K) ? exp(-$r_q * $t) : 0;
99             }
100              
101 11         75 return exp(-$r_q * $t) * pnorm(d2($S, $K, $t, $r_q, $mu, $sigma));
102             }
103              
104             =head2 put
105              
106             USAGE
107             my $price = put($S, $K, $t, $r_q, $mu, $sigma)
108              
109             PARAMS
110             $S => stock price
111             $K => barrier
112             $t => time (1 = 1 year)
113             $r_q => payout currency interest rate (0.05 = 5%)
114             $mu => quanto drift adjustment (0.05 = 5%)
115             $sigma => volatility (0.3 = 30%)
116              
117             DESCRIPTION
118             Price a standard Digital Put
119              
120             =cut
121              
122             sub put {
123 13     13 1 2316 my ($S, $K, $t, $r_q, $mu, $sigma) = @_;
124              
125 13 100       70 if ($t < $SMALLTIME) {
126 2 100       15 return ($S < $K) ? exp(-$r_q * $t) : 0;
127             }
128              
129 11         27 return exp(-$r_q * $t) * pnorm(-1 * d2($S, $K, $t, $r_q, $mu, $sigma));
130             }
131              
132             =head2 d2
133              
134             returns the DS term common to many BlackScholesMerton formulae.
135              
136             =cut
137              
138             sub d2 {
139 22     22 1 34 my ($S, $K, $t, undef, $mu, $sigma) = @_;
140              
141 22         183 return (log($S / $K) + ($mu - $sigma * $sigma / 2.0) * $t) / ($sigma * sqrt($t));
142             }
143              
144             =head2 expirymiss
145              
146             USAGE
147             my $price = expirymiss($S, $U, $D, $t, $r_q, $mu, $sigma)
148              
149             PARAMS
150             $S => stock price
151             $t => time (1 = 1 year)
152             $U => barrier
153             $D => barrier
154             $r_q => payout currency interest rate (0.05 = 5%)
155             $mu => quanto drift adjustment (0.05 = 5%)
156             $sigma => volatility (0.3 = 30%)
157              
158             DESCRIPTION
159             Price an expiry miss contract (1 Call + 1 Put)
160              
161             [3] for $r_q and $mu for quantos
162              
163             =cut
164              
165             sub expirymiss {
166 6     6 1 745 my ($S, $U, $D, $t, $r_q, $mu, $sigma) = @_;
167              
168 6         12 my ($call_price) = call($S, $U, $t, $r_q, $mu, $sigma);
169 6         11 my ($put_price) = put($S, $D, $t, $r_q, $mu, $sigma);
170              
171 6         12 return $call_price + $put_price;
172             }
173              
174             =head2 expiryrange
175              
176             USAGE
177             my $price = expiryrange($S, $U, $D, $t, $r_q, $mu, $sigma)
178              
179             PARAMS
180             $S => stock price
181             $U => barrier
182             $D => barrier
183             $t => time (1 = 1 year)
184             $r_q => payout currency interest rate (0.05 = 5%)
185             $mu => quanto drift adjustment (0.05 = 5%)
186             $sigma => volatility (0.3 = 30%)
187              
188             DESCRIPTION
189             Price an Expiry Range contract as Foreign/Domestic.
190              
191             [3] for $r_q and $mu for quantos
192              
193             =cut
194              
195             sub expiryrange {
196 3     3 1 1024 my ($S, $U, $D, $t, $r_q, $mu, $sigma) = @_;
197              
198 3         10 return exp(-$r_q * $t) - expirymiss($S, $U, $D, $t, $r_q, $mu, $sigma);
199             }
200              
201             =head2 onetouch
202              
203             PARAMS
204             $S => stock price
205             $U => barrier
206             $t => time (1 = 1 year)
207             $r_q => payout currency interest rate (0.05 = 5%)
208             $mu => quanto drift adjustment (0.05 = 5%)
209             $sigma => volatility (0.3 = 30%)
210              
211             [3] for $r_q and $mu for quantos
212              
213             =cut
214              
215             sub onetouch {
216 39     39 1 3697 my ($S, $U, $t, $r_q, $mu, $sigma, $w) = @_;
217              
218             # w = 0, rebate paid at hit (good way to remember is that waiting
219             # time to get paid = 0)
220             # w = 1, rebate paid at end.
221              
222             # When the contract already reached it expiry and not yet reach it
223             # settlement time, it is consider an unexpired contract but will come to
224             # here with t=0 and it will caused the formula to die hence set it to the
225             # SMALLTIME which is 1 second
226 39         92 $t = max($SMALLTIME, $t);
227              
228 39   100     110 $w ||= 0;
229              
230             # eta = -1, one touch up
231             # eta = 1, one touch down
232 39 100       82 my $eta = ($S < $U) ? -1 : 1;
233              
234 39         42 my $sqrt_t = sqrt($t);
235              
236 39         55 my $theta_ = (($mu) / $sigma) - (0.5 * $sigma);
237              
238             # Floor v_ squared at zero in case negative interest rates push it negative.
239             # See: Barrier Options under Negative Rates in Black-Scholes (Le Floc’h and Pruell, 2014)
240 39         90 my $v_ = sqrt(max(0, ($theta_ * $theta_) + (2 * (1 - $w) * $r_q)));
241              
242 39         82 my $e = (log($S / $U) - ($sigma * $v_ * $t)) / ($sigma * $sqrt_t);
243 39         52 my $e_ = (-log($S / $U) - ($sigma * $v_ * $t)) / ($sigma * $sqrt_t);
244              
245 39         227 my $price = (($U / $S)**(($theta_ + $v_) / $sigma)) * pnorm(-$eta * $e) + (($U / $S)**(($theta_ - $v_) / $sigma)) * pnorm($eta * $e_);
246              
247 39         91 return exp(-$w * $r_q * $t) * $price;
248             }
249              
250             =head2 notouch
251              
252             USAGE
253             my $price = notouch($S, $U, $t, $r_q, $mu, $sigma, $w)
254              
255             PARAMS
256             $S => stock price
257             $U => barrier
258             $t => time (1 = 1 year)
259             $r_q => payout currency interest rate (0.05 = 5%)
260             $mu => quanto drift adjustment (0.05 = 5%)
261             $sigma => volatility (0.3 = 30%)
262              
263             DESCRIPTION
264             Price a No touch contract.
265              
266             Payoff with domestic currency
267             Identity:
268             price of notouch = exp(- r t) - price of onetouch(rebate paid at end)
269              
270             [3] for $r_q and $mu for quantos
271              
272             =cut
273              
274             sub notouch {
275 7     7 1 1165 my ($S, $U, $t, $r_q, $mu, $sigma) = @_;
276              
277             # No touch contract always pay out at end
278 7         10 my $w = 1;
279              
280 7         21 return exp(-$r_q * $t) - onetouch($S, $U, $t, $r_q, $mu, $sigma, $w);
281             }
282              
283             # These variables require 'our' only because they need to be
284             # accessed by a test script.
285             our $MAX_ITERATIONS_UPORDOWN_PELSSER_1997 = 1000;
286             our $MIN_ITERATIONS_UPORDOWN_PELSSER_1997 = 16;
287              
288             #
289             # This variable requires 'our' only because it needs to be
290             # accessed via test script.
291             # Min accuracy. Accurate to 1 dollar for 100,000 notional
292             #
293             our $MIN_ACCURACY_UPORDOWN_PELSSER_1997 = 1.0 / 100000.0;
294             our $SMALL_VALUE_MU = 1e-10;
295              
296             # The smallest (in magnitude) floating-point number which,
297             # when added to the floating-point number 1.0, produces a
298             # floating-point result different from 1.0 is termed the
299             # machine accuracy, e.
300             #
301             # This value is very important for knowing stability to
302             # certain formulas used. e.g. Pelsser formula for UPORDOWN
303             # and RANGE contracts.
304             #
305             my $MACHINE_EPSILON = machine_epsilon();
306              
307             =head2 upordown
308              
309             USAGE
310             my $price = upordown(($S, $U, $D, $t, $r_q, $mu, $sigma, $w))
311              
312             PARAMS
313             $S stock price
314             $U barrier
315             $D barrier
316             $t time (1 = 1 year)
317             $r_q payout currency interest rate (0.05 = 5%)
318             $mu quanto drift adjustment (0.05 = 5%)
319             $sigma volatility (0.3 = 30%)
320              
321             see [3] for $r_q and $mu for quantos
322              
323             DESCRIPTION
324             Price an Up or Down contract
325              
326             =cut
327              
328             sub upordown {
329 16     16 1 4839 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w) = @_;
330              
331             # When the contract already reached it's expiry and not yet reach it
332             # settlement time, it is considered an unexpired contract but will come to
333             # here with t=0 and it will caused the formula to die hence set it to the
334             # SMALLTIME whiich is 1 second
335 16         35 $t = max($t, $SMALLTIME);
336              
337             # $w = 0, paid at hit
338             # $w = 1, paid at end
339 16 100       37 if (not defined $w) { $w = 0; }
  8         12  
340              
341             # spot is outside [$D, $U] --> contract is expired with full payout,
342             # one barrier is already hit (can happen due to shift markup):
343 16 100 100     62 if ($S >= $U or $S <= $D) {
344 4 100       11 return $w ? exp(-$t * $r_q) : 1;
345             }
346              
347             #
348             # SANITY CHECKS
349             #
350             # For extreme cases, the price will be wrong due the values in the
351             # infinite series getting too large or too small, which causes
352             # roundoff errors in the computer. Thus no matter how many iterations
353             # you make, the errors will never go away.
354             #
355             # For example try this:
356             #
357             # my ($S, $U, $D, $t, $r, $q, $vol, $w)
358             # = (100.00, 118.97, 99.00, 30/365, 0.1, 0.02, 0.01, 1);
359             # $up_price = Math::Business::BlackScholesMerton::Binaries::ot_up_ko_down_pelsser_1997(
360             # $S,$U,$D,$t,$r,$q,$vol,$w);
361             # $down_price= Math::Business::BlackScholesMerton::Binaries::ot_down_ko_up_pelsser_1997(
362             # $S,$U,$D,$t,$r,$q,$vol,$w);
363             #
364             # Thus we put a sanity checks here such that
365             #
366             # CONDITION 1: UPORDOWN[U,D] < ONETOUCH[U] + ONETOUCH[D]
367             # CONDITION 2: UPORDOWN[U,D] > ONETOUCH[U]
368             # CONDITION 3: UPORDOWN[U,D] > ONETOUCH[D]
369             # CONDITION 4: ONETOUCH[U] + ONETOUCH[D] >= $MIN_ACCURACY_UPORDOWN_PELSSER_1997
370             #
371 12         29 my $onetouch_up_prob = onetouch($S, $U, $t, $r_q, $mu, $sigma, $w);
372 12         26 my $onetouch_down_prob = onetouch($S, $D, $t, $r_q, $mu, $sigma, $w);
373              
374 12         13 my $upordown_prob;
375              
376 12 100 75     85 if ($onetouch_up_prob + $onetouch_down_prob < $MIN_ACCURACY_UPORDOWN_PELSSER_1997) {
    100          
377              
378             # CONDITION 4:
379             # The probability is too small for the Pelsser formula to be correct.
380             # Do this check first to avoid PELSSER stability condition to be
381             # triggered.
382             # Here we assume that the ONETOUCH formula is perfect and never give
383             # wrong values (e.g. negative).
384 1         3 return 0;
385             } elsif ($onetouch_up_prob xor $onetouch_down_prob) {
386              
387             # One of our ONETOUCH probabilities is 0.
388             # That means our upordown prob is equivalent to the other one.
389             # Pelsser recompute will either be the same or wrong.
390             # Continuing to assume the ONETOUCH is perfect.
391 4         9 $upordown_prob = max($onetouch_up_prob, $onetouch_down_prob);
392             } else {
393              
394             # THIS IS THE ONLY PLACE IT SHOULD BE!
395 7         18 $upordown_prob =
396             ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w) + ot_down_ko_up_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w);
397             }
398              
399             # CONDITION 4:
400             # Now check on the other end, when the contract is too close to payout.
401             # Not really needed to check for payout at hit, because RANGE is
402             # always at end, and thus the value (DISCOUNT - UPORDOWN) is not
403             # evaluated.
404 11 100       31 if ($w == 1) {
405              
406             # Since the difference is already less than the min accuracy,
407             # the value [payout - upordown], which is the RANGE formula
408             # can become negative.
409 5 50       26 if (abs(exp(-$r_q * $t) - $upordown_prob) < $MIN_ACCURACY_UPORDOWN_PELSSER_1997) {
410 0         0 $upordown_prob = exp(-$r_q * $t);
411             }
412             }
413              
414             # CONDITION 1-3
415             # We use hardcoded small value of $SMALL_TOLERANCE, because if we were to increase
416             # the minimum accuracy, and this small value uses that min accuracy, it is
417             # very hard for the conditions to pass.
418 11         14 my $SMALL_TOLERANCE = 0.00001;
419 11 50 33     59 if ( not($upordown_prob < $onetouch_up_prob + $onetouch_down_prob + $SMALL_TOLERANCE)
      33        
420             or not($upordown_prob + $SMALL_TOLERANCE > $onetouch_up_prob)
421             or not($upordown_prob + $SMALL_TOLERANCE > $onetouch_down_prob))
422             {
423 0         0 die "UPORDOWN price sanity checks failed for S=$S, U=$U, "
424             . "D=$D, t=$t, r_q=$r_q, mu=$mu, sigma=$sigma, w=$w. "
425             . "UPORDOWN PROB=$upordown_prob , "
426             . "ONETOUCH_UP PROB=$onetouch_up_prob , "
427             . "ONETOUCH_DOWN PROB=$onetouch_down_prob";
428             }
429              
430 11         28 return $upordown_prob;
431             }
432              
433             =head2 common_function_pelsser_1997
434              
435             USAGE
436             my $c = common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta)
437              
438             DESCRIPTION
439             Return the common function from Pelsser's Paper (1997)
440              
441             =cut
442              
443             sub common_function_pelsser_1997 {
444              
445             # h: normalized high barrier, log(U/L)
446             # x: normalized spot, log(S/L)
447 16     16 1 2205 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta) = @_;
448              
449 16         18 my $pi = Math::Trig::pi;
450              
451 16         27 my $h = log($U / $D);
452 16         20 my $x = log($S / $D);
453              
454             # $eta = 1, onetouch up knockout down
455             # $eta = 0, onetouch down knockout up
456             # This variable used to check stability
457 16 100       42 if (not defined $eta) {
458 1         19 die "Wrong usage of this function for S=$S, U=$U, D=$D, " . "t=$t, r_q=$r_q, mu=$mu, sigma=$sigma, w=$w, eta not defined.";
459             }
460 15 100       25 if ($eta == 0) { $x = $h - $x; }
  8         10  
461              
462             # $w = 0, paid at hit
463             # $w = 1, paid at end
464              
465 15         20 my $mu_new = $mu - (0.5 * $sigma * $sigma);
466 15         56 my $mu_dash = sqrt(max(0, ($mu_new * $mu_new) + (2 * $sigma * $sigma * $r_q * (1 - $w))));
467              
468 15         31 my $series_part = 0;
469 15         18 my $hyp_part = 0;
470              
471             # These constants will determine whether or not this contract can be
472             # evaluated to a predefined accuracy. It is VERY IMPORTANT because
473             # if these conditions are not met, the prices can be complete nonsense!!
474 15         30 my $stability_constant = get_stability_constant_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta, 1);
475              
476             # The number of iterations is important when recommending the
477             # range of the upper/lower barriers on our site. If we recommend
478             # a range that is too big and our iteration is too small, the
479             # price will be wrong! We must know the rate of convergence of
480             # the formula used.
481 15         31 my $iterations_required = get_min_iterations_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w);
482              
483 15         39 for (my $k = 1; $k < $iterations_required; $k++) {
484 253         320 my $lambda_k_dash = (0.5 * (($mu_dash * $mu_dash) / ($sigma * $sigma) + ($k * $k * $pi * $pi * $sigma * $sigma) / ($h * $h)));
485              
486 253         357 my $phi = ($sigma * $sigma) / ($h * $h) * exp(-$lambda_k_dash * $t) * $k / $lambda_k_dash;
487              
488 253         355 $series_part += $phi * $pi * sin($k * $pi * ($h - $x) / $h);
489              
490             #
491             # Note that greeks may also call this function, and their
492             # stability constant will differ. However, for simplicity
493             # we will not bother (else the code will get messy), and
494             # just use the price stability constant.
495             #
496 253 50 66     475 if ($k == 1 and (not(abs($phi) < $stability_constant))) {
497 0         0 die "PELSSER VALUATION formula for S=$S, U=$U, D=$D, t=$t, r_q=$r_q, "
498             . "mu=$mu, vol=$sigma, w=$w, eta=$eta, cannot be evaluated because"
499             . "PELSSER VALUATION stability conditions ($phi less than "
500             . "$stability_constant) not met. This could be due to barriers "
501             . "too big, volatilities too low, interest/dividend rates too high, "
502             . "or machine accuracy too low. Machine accuracy is "
503             . $MACHINE_EPSILON . ".";
504             }
505             }
506              
507             #
508             # Some math basics: When A -> 0,
509             #
510             # sinh(A) -> 0.5 * [ (1 + A) - (1 - A) ] = 0.5 * 2A = A
511             # cosh(A) -> 0.5 * [ (1 + A) + (1 - A) ] = 0.5 * 2 = 1
512             #
513             # Thus for sinh(A)/sinh(B) when A & B -> 0, we have
514             #
515             # sinh(A) / sinh(B) -> A / B
516             #
517             # Since the check of the spot == lower/upper barrier has been done in the
518             # _upordown subroutine, we can assume that $x and $h will never be 0.
519             # So we only need to check that $mu_dash is too small. Also note that
520             # $mu_dash is always positive.
521             #
522             # For example, even at 0.0001 the error becomes small enough
523             #
524             # 0.0001 - Math::Trig::sinh(0.0001) = -1.66688941837835e-13
525             #
526             # Since h > x, we only check for (mu_dash * h) / (vol * vol)
527             #
528 15 100       29 if (abs($mu_dash * $h / ($sigma * $sigma)) < $SMALL_VALUE_MU) {
529 3         5 $hyp_part = $x / $h;
530             } else {
531 12         36 $hyp_part = Math::Trig::sinh($mu_dash * $x / ($sigma * $sigma)) / Math::Trig::sinh($mu_dash * $h / ($sigma * $sigma));
532             }
533              
534 15         533 return ($hyp_part - $series_part) * exp(-$r_q * $t * $w);
535             }
536              
537             =head2 get_stability_constant_pelsser_1997
538              
539             USAGE
540             my $constant = get_stability_constant_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta, $p)
541              
542             DESCRIPTION
543             Get the stability constant (Pelsser 1997)
544              
545             =cut
546              
547             sub get_stability_constant_pelsser_1997 {
548 17     17 1 2434 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $eta, $p) = @_;
549              
550             # $eta = 1, onetouch up knockout down
551             # $eta = 0, onetouch down knockout up
552              
553 17 100       38 if (not defined $eta) {
554 1         23 die "Wrong usage of this function for S=$S, U=$U, D=$D, t=$t, " . "r_q=$r_q, mu=$mu, sigma=$sigma, w=$w, Eta not defined.";
555             }
556              
557             # p is the power of pi
558             # p=1 for price/theta/vega/vanna/volga
559             # p=2 for delta
560             # p=3 for gamma
561 16 50 66     38 if ($p != 1 and $p != 2 and $p != 3) {
      66        
562 1         18 die "Wrong usage of this function for S=$S, U=$U, D=$D, t=$t, "
563             . "r_q=$r_q, mu=$mu, sigma=$sigma, w=$w, Power of PI must "
564             . "be 1, 2 or 3. Given $p.";
565             }
566              
567 15         20 my $h = log($U / $D);
568 15         15 my $x = log($S / $D);
569 15         20 my $mu_new = $mu - (0.5 * $sigma * $sigma);
570              
571 15         29 my $numerator = $MIN_ACCURACY_UPORDOWN_PELSSER_1997 * exp(1.0 - $mu_new * (($eta * $h) - $x) / ($sigma * $sigma));
572 15         46 my $denominator = (exp(1) * (Math::Trig::pi + $p)) + (max($mu_new * (($eta * $h) - $x), 0.0) * Math::Trig::pi / ($sigma**2));
573 15         23 $denominator *= (Math::Trig::pi**($p - 1)) * $MACHINE_EPSILON;
574              
575 15         18 my $stability_condition = $numerator / $denominator;
576              
577 15         19 return $stability_condition;
578             }
579              
580             =head2 ot_up_ko_down_pelsser_1997
581              
582             USAGE
583             my $price = ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w)
584              
585             DESCRIPTION
586             This is V_{RAHU} in paper [5], or ONETOUCH-UP-KNOCKOUT-DOWN,
587             a contract that wins if it touches upper barrier, but expires
588             worthless if it touches the lower barrier first.
589              
590             =cut
591              
592             sub ot_up_ko_down_pelsser_1997 {
593 7     7 1 12 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w) = @_;
594              
595 7         11 my $mu_new = $mu - (0.5 * $sigma * $sigma);
596 7         11 my $h = log($U / $D);
597 7         9 my $x = log($S / $D);
598              
599 7         21 return exp($mu_new * ($h - $x) / ($sigma * $sigma)) * common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, 1);
600             }
601              
602             =head2 ot_down_ko_up_pelsser_1997
603              
604             USAGE
605             my $price = ot_down_ko_up_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w)
606              
607             DESCRIPTION
608             This is V_{RAHL} in paper [5], or ONETOUCH-DOWN-KNOCKOUT-UP,
609             a contract that wins if it touches lower barrier, but expires
610             worthless if it touches the upper barrier first.
611              
612             =cut
613              
614             sub ot_down_ko_up_pelsser_1997 {
615 7     7 1 21 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w) = @_;
616              
617 7         12 my $mu_new = $mu - (0.5 * $sigma * $sigma);
618 7         12 my $x = log($S / $D);
619              
620 7         16 return exp(-$mu_new * $x / ($sigma * $sigma)) * common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, 0);
621             }
622              
623             =head2 get_min_iterations_pelsser_1997
624              
625             USAGE
626             my $min = get_min_iterations_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy)
627              
628             DESCRIPTION
629             An estimate of the number of iterations required to achieve a certain
630             level of accuracy in the price.
631              
632             =cut
633              
634             sub get_min_iterations_pelsser_1997 {
635 18     18 1 2440 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy) = @_;
636              
637 18 100       32 if (not defined $accuracy) {
638 16         17 $accuracy = $MIN_ACCURACY_UPORDOWN_PELSSER_1997;
639             }
640              
641 18 100       81 if ($accuracy > $MIN_ACCURACY_UPORDOWN_PELSSER_1997) {
    100          
642 1         2 $accuracy = $MIN_ACCURACY_UPORDOWN_PELSSER_1997;
643             } elsif ($accuracy <= 0) {
644 1         2 $accuracy = $MIN_ACCURACY_UPORDOWN_PELSSER_1997;
645             }
646              
647 18         35 my $it_up = _get_min_iterations_ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy);
648 18         56 my $it_down = _get_min_iterations_ot_down_ko_up_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy);
649              
650 18         30 my $min = max($it_up, $it_down);
651              
652 18         23 return $min;
653             }
654              
655             =head2 _get_min_iterations_ot_up_ko_down_pelsser_1997
656              
657             USAGE
658             my $k_min = _get_min_iterations_ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy)
659              
660             DESCRIPTION
661             An estimate of the number of iterations required to achieve a certain
662             level of accuracy in the price for ONETOUCH-UP-KNOCKOUT-DOWN.
663              
664             =cut
665              
666             sub _get_min_iterations_ot_up_ko_down_pelsser_1997 {
667 39     39   773 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy) = @_;
668              
669 39 100       68 if (!defined $accuracy) {
670 1         9 die "accuracy required";
671             }
672              
673 38         40 my $pi = Math::Trig::pi;
674              
675 38         45 my $h = log($U / $D);
676 38         47 my $x = log($S / $D);
677 38         47 my $mu_new = $mu - (0.5 * $sigma * $sigma);
678 38         93 my $mu_dash = sqrt(max(0, ($mu_new * $mu_new) + (2 * $sigma * $sigma * $r_q * (1 - $w))));
679              
680 38         50 my $A = ($mu_dash * $mu_dash) / (2 * $sigma * $sigma);
681 38         50 my $B = ($pi * $pi * $sigma * $sigma) / (2 * $h * $h);
682              
683 38         41 my $delta_dash = $accuracy;
684 38         69 my $delta = $delta_dash * exp(-$mu_new * ($h - $x) / ($sigma * $sigma)) * (($h * $h) / ($pi * $sigma * $sigma));
685              
686             # This can happen when stability condition fails
687 38 100       64 if ($delta * $B <= 0) {
688 1         24 die "(_get_min_iterations_ot_up_ko_down_pelsser_1997) Cannot "
689             . "evaluate minimum iterations because too many iterations "
690             . "required!! delta=$delta, B=$B for input parameters S=$S, "
691             . "U=$U, D=$D, t=$t, r_q=$r_q, mu=$mu, sigma=$sigma, w=$w, "
692             . "accuracy=$accuracy";
693             }
694              
695             # Check that condition is satisfied
696 37         62 my $condition = max(exp(-$A * $t) / ($B * $delta), 1);
697              
698 37         53 my $k_min = log($condition) / ($B * $t);
699 37         33 $k_min = sqrt($k_min);
700              
701 37 100       58 if ($k_min < $MIN_ITERATIONS_UPORDOWN_PELSSER_1997) {
    100          
702              
703 32         55 return $MIN_ITERATIONS_UPORDOWN_PELSSER_1997;
704             } elsif ($k_min > $MAX_ITERATIONS_UPORDOWN_PELSSER_1997) {
705              
706 1         3 return $MAX_ITERATIONS_UPORDOWN_PELSSER_1997;
707             }
708              
709 4         6 return int($k_min);
710             }
711              
712             =head2 _get_min_iterations_ot_down_ko_up_pelsser_1997
713              
714             USAGE
715              
716             DESCRIPTION
717             An estimate of the number of iterations required to achieve a certain
718             level of accuracy in the price for ONETOUCH-UP-KNOCKOUT-UP.
719              
720             =cut
721              
722             sub _get_min_iterations_ot_down_ko_up_pelsser_1997 {
723 18     18   32 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy) = @_;
724              
725 18         25 my $h = log($U / $D);
726 18         24 my $mu_new = $mu - (0.5 * $sigma * $sigma);
727              
728 18         27 $accuracy = $accuracy * exp($mu_new * $h / ($sigma * $sigma));
729              
730 18         26 return _get_min_iterations_ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $sigma, $w, $accuracy);
731             }
732              
733             =head2 range
734              
735             USAGE
736             my $price = range($S, $U, $D, $t, $r_q, $mu, $sigma, $w)
737              
738             PARAMS
739             $S stock price
740             $t time (1 = 1 year)
741             $U barrier
742             $D barrier
743             $r_q payout currency interest rate (0.05 = 5%)
744             $mu quanto drift adjustment (0.05 = 5%)
745             $sigma volatility (0.3 = 30%)
746              
747             see [3] for $r_q and $mu for quantos
748              
749             DESCRIPTION
750             Price a range contract.
751              
752             =cut
753              
754             sub range {
755              
756             # payout time $w is only a dummy. range contracts always payout at end.
757 7     7 1 2170 my ($S, $U, $D, $t, $r_q, $mu, $sigma, $w) = @_;
758              
759             # range always pay out at end
760 7         11 $w = 1;
761              
762 7         27 return exp(-$r_q * $t) - upordown($S, $U, $D, $t, $r_q, $mu, $sigma, $w);
763             }
764              
765             1;
766