view release on metacpan or  search on metacpan

lib/Math/Business/BlackScholes/Binaries/Greeks/Delta.pm  view on Meta::CPAN

    my ($S, $U, $t, $r_q, $mu, $vol, $w) = @_;

    # No touch bet always pay out at end
    $w = 1;

    return -1 * onetouch($S, $U, $t, $r_q, $mu, $vol, $w);
}

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

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

    return ot_up_ko_down_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w) + ot_down_ko_up_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w);
}

sub x_common_function_pelsser_1997 {
    my ($S, $U, $D, $t, $r_q, $mu, $vol, $w, $eta) = @_;

    my $pi = Math::Trig::pi;

    my $h = log($U / $D);
    my $x = log($S / $D);

    # $eta = 1, onetouch up knockout down
    # $eta = 0, onetouch down knockout up
    # This variable used to check stability
    if (not defined $eta) {
        die
            "$0: (x_common_function_pelsser_1997) Wrong usage of this function for S=$S, U=$U, D=$D, t=$t, r_q=$r_q, mu=$mu, vol=$vol, w=$w. eta not defined.";
    }
    if ($eta == 0) { $x = $h - $x; }

    my $mu_new = $mu - (0.5 * $vol * $vol);
    my $mu_dash =
        sqrt(max($Math::Business::BlackScholesMerton::Binaries::SMALL_VALUE_MU, ($mu_new * $mu_new) + (2 * $vol * $vol * $r_q * (1 - $w))));

    my $series_part = 0;
    my $hyp_part    = 0;

    my $stability_constant =
        Math::Business::BlackScholesMerton::Binaries::get_stability_constant_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w, $eta, 2);

    my $iterations_required = Math::Business::BlackScholesMerton::Binaries::get_min_iterations_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w);

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

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

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

        #
        # For delta, the stability function is $phi/$S, for gamma it is different,
        # but we shall ignore for now.
        #
        if ($k == 1 and (not(abs($phi / $S) < $stability_constant))) {
            die
                "$0: PELSSER DELTA formula for S=$S, U=$U, D=$D, t=$t, r_q=$r_q, mu=$mu, vol=$vol, w=$w, eta=$eta cannot be evaluated because PELSSER DELTA stability conditions ($phi / $S less than $stability_constant) not met. This could be due to b...
        }
    }

    # Need to take care when $mu goes to zero
    if (abs($mu_new) < $Math::Business::BlackScholesMerton::Binaries::SMALL_VALUE_MU) {
        my $sign = ($mu_new >= 0) ? 1 : -1;
        $mu_new = $sign * $Math::Business::BlackScholesMerton::Binaries::SMALL_VALUE_MU;
        $mu_dash = sqrt(($mu_new * $mu_new) + (2 * $vol * $vol * $r_q * (1 - $w)));
    }

    $hyp_part = ($mu_dash / ($vol * $vol)) * (Math::Trig::cosh($mu_dash * $x / ($vol * $vol)) / Math::Trig::sinh($mu_dash * $h / ($vol * $vol)));

    my $dc_dx = ($hyp_part + $series_part) * exp(-$r_q * $t * $w);

    return $dc_dx;
}

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

    my $mu_new = $mu - (0.5 * $vol * $vol);
    my $h      = log($U / $D);
    my $x      = log($S / $D);

    my $dVu_dx =
        -(($mu_new / ($vol * $vol)) *
            Math::Business::BlackScholesMerton::Binaries::common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w, 1));

    $dVu_dx += x_common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w, 1);
    $dVu_dx *= exp($mu_new * ($h - $x) / ($vol * $vol));

    # dV/dS = dV/dx * dx/dS = dV/dx * 1/S
    return $dVu_dx / $S;
}

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

    my $mu_new = $mu - (0.5 * $vol * $vol);
    my $x = log($S / $D);

    my $dVl_dx =
        -(($mu_new / ($vol * $vol)) *
            Math::Business::BlackScholesMerton::Binaries::common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w, 0));

    $dVl_dx -= x_common_function_pelsser_1997($S, $U, $D, $t, $r_q, $mu, $vol, $w, 0);
    $dVl_dx *= exp(-$mu_new * $x / ($vol * $vol));

    # dV/dS = dV/dx * dx/dS = dV/dx * 1/S
    return $dVl_dx / $S;
}

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

    # Range always pay out at end
    $w = 1;

    return -1 * upordown($S, $U, $D, $t, $r_q, $mu, $vol, $w);
}