// Copyright (c) Microsoft Corporation. All rights reserved.
// Licensed under the MIT License.

//-----------------------------------------------------------------------------
//  Package Title  ratpak
//  File           fact.c
//  Copyright      (C) 1995-96 Microsoft
//  Date           01-16-95
//
//
//  Description
//
//     Contains fact(orial) and supporting _gamma functions.
//
//-----------------------------------------------------------------------------
#include "ratpak.h"

#define NEGATE(x) ((x)->pp->sign *= -1)

//-----------------------------------------------------------------------------
//
//  FUNCTION: factrat, _gamma, gamma
//
//  ARGUMENTS:  x PRAT representation of number to take the sine of
//
//  RETURN: factorial of x in PRAT form.
//
//  EXPLANATION: This uses Taylor series
//
//      n
//     ___    2j
//   n \  ]  A       1          A
//  A   \   -----[ ---- - ---------------]
//      /   (2j)!  n+2j   (n+2j+1)(2j+1)
//     /__]
//     j=0
//
//                        / oo
//                        |    n-1 -x     __
//  This was derived from |   x   e  dx = |
//                        |               | (n) { = (n-1)! for +integers}
//                        / 0
//
//  It can be shown that the above series is within precision if A is chosen
//  big enough.
//                          A    n  precision
//  Based on the relation ne  = A 10            A was chosen as
//
//             precision
//  A = ln(Base         /n)+1
//  A += n*ln(A)  This is close enough for precision > base and n < 1.5
//
//
//-----------------------------------------------------------------------------

void _gamma(PRAT* pn, uint32_t radix, int32_t precision)

{
    PRAT factorial = nullptr;
    PNUMBER count = nullptr;
    PRAT tmp = nullptr;
    PRAT one_pt_five = nullptr;
    PRAT a = nullptr;
    PRAT a2 = nullptr;
    PRAT term = nullptr;
    PRAT sum = nullptr;
    PRAT err = nullptr;
    PRAT mpy = nullptr;

    // Set up constants and initial conditions
    PRAT ratprec = i32torat(precision);

    // Find the best 'A' for convergence to the required precision.
    a = i32torat(radix);
    _lograt(&a, precision);
    mulrat(&a, ratprec, precision);

    // Really is -ln(n)+1, but -ln(n) will be < 1
    // if we scale n between 0.5 and 1.5
    _addrat(&a, rat_two, precision);
    DUPRAT(tmp, a);
    _lograt(&tmp, precision);
    mulrat(&tmp, *pn, precision);
    _addrat(&a, tmp, precision);
    _addrat(&a, rat_one, precision);

    // Calculate the necessary bump in precision and up the precision.
    // The following code is equivalent to
    // precision += ln(exp(a)*pow(a,n+1.5))-ln(radix));
    DUPRAT(tmp, *pn);
    one_pt_five = i32torat(3L);
    divrat(&one_pt_five, rat_two, precision);
    _addrat(&tmp, one_pt_five, precision);
    DUPRAT(term, a);
    powratcomp(&term, tmp, radix, precision);
    DUPRAT(tmp, a);
    exprat(&tmp, radix, precision);
    mulrat(&term, tmp, precision);
    _lograt(&term, precision);
    const auto ratRadix = i32torat(radix);
    DUPRAT(tmp, ratRadix);
    _lograt(&tmp, precision);
    _subrat(&term, tmp, precision);
    precision += rattoi32(term, radix, precision);

    // Set up initial terms for series, refer to series in above comment block.
    DUPRAT(factorial, rat_one); // Start factorial out with one
    count = i32tonum(0L, BASEX);

    DUPRAT(mpy, a);
    powratcomp(&mpy, *pn, radix, precision);
    // a2=a^2
    DUPRAT(a2, a);
    mulrat(&a2, a, precision);

    // sum=(1/n)-(a/(n+1))
    DUPRAT(sum, rat_one);
    divrat(&sum, *pn, precision);
    DUPRAT(tmp, *pn);
    _addrat(&tmp, rat_one, precision);
    DUPRAT(term, a);
    divrat(&term, tmp, precision);
    _subrat(&sum, term, precision);

    DUPRAT(err, ratRadix);
    NEGATE(ratprec);
    powratcomp(&err, ratprec, radix, precision);
    divrat(&err, ratRadix, precision);

    // Just get something not tiny in term
    DUPRAT(term, rat_two);

    // Loop until precision is reached, or asked to halt.
    while (!zerrat(term) && rat_gt(term, err, precision))
    {
        _addrat(pn, rat_two, precision);

        // WARNING: mixing numbers and  rationals here.
        // for speed and efficiency.
        INC(count);
        mulnumx(&(factorial->pp), count);
        INC(count)
        mulnumx(&(factorial->pp), count);

        divrat(&factorial, a2, precision);

        DUPRAT(tmp, *pn);
        _addrat(&tmp, rat_one, precision);
        destroyrat(term);
        createrat(term);
        DUPNUM(term->pp, count);
        DUPNUM(term->pq, num_one);
        _addrat(&term, rat_one, precision);
        mulrat(&term, tmp, precision);
        DUPRAT(tmp, a);
        divrat(&tmp, term, precision);

        DUPRAT(term, rat_one);
        divrat(&term, *pn, precision);
        _subrat(&term, tmp, precision);

        divrat(&term, factorial, precision);
        _addrat(&sum, term, precision);
        ABSRAT(term);
    }

    // Multiply by factor.
    mulrat(&sum, mpy, precision);

    // And cleanup
    destroyrat(ratprec);
    destroyrat(err);
    destroyrat(term);
    destroyrat(a);
    destroyrat(a2);
    destroyrat(tmp);
    destroyrat(one_pt_five);

    destroynum(count);

    destroyrat(factorial);
    destroyrat(*pn);
    DUPRAT(*pn, sum);
    destroyrat(sum);
}

void factrat(_Inout_ PRAT* px, uint32_t radix, int32_t precision)

{
    PRAT fact = nullptr;
    PRAT frac = nullptr;
    PRAT neg_rat_one = nullptr;

    if (rat_gt(*px, rat_max_fact, precision) || rat_lt(*px, rat_min_fact, precision))
    {
        // Don't attempt factorial of anything too large or small.
        throw CALC_E_OVERFLOW;
    }

    DUPRAT(fact, rat_one);

    DUPRAT(neg_rat_one, rat_one);
    neg_rat_one->pp->sign *= -1;

    DUPRAT(frac, *px);
    fracrat(&frac, radix, precision);

    // Check for negative integers and throw an error.
    if ((zerrat(frac) || (LOGRATRADIX(frac) <= -precision)) && (SIGN(*px) == -1))
    {
        throw CALC_E_DOMAIN;
    }
    while (rat_gt(*px, rat_zero, precision) && (LOGRATRADIX(*px) > -precision))
    {
        mulrat(&fact, *px, precision);
        _subrat(px, rat_one, precision);
    }

    // Added to make numbers 'close enough' to integers use integer factorial.
    if (LOGRATRADIX(*px) <= -precision)
    {
        DUPRAT((*px), rat_zero);
        intrat(&fact, radix, precision);
    }

    while (rat_lt(*px, neg_rat_one, precision))
    {
        _addrat(px, rat_one, precision);
        divrat(&fact, *px, precision);
    }

    if (rat_neq(*px, rat_zero, precision))
    {
        _addrat(px, rat_one, precision);
        _gamma(px, radix, precision);
        mulrat(px, fact, precision);
    }
    else
    {
        DUPRAT(*px, fact);
    }

    destroyrat(fact);
    destroyrat(frac);
    destroyrat(neg_rat_one);
}
