/*
* From Knuth, The Art of Computer Programming:
*
* To compute GCD(u,v)
*
* A1:
* if (v == 0) return (u)
* A2:
* t = u mod v
* u = v
* v = t
* goto A1
*/
void m_apm_gcd_traditional(M_APM r, M_APM u, M_APM v)
{
M_APM tmpD, tmpN, tmpU, tmpV;
tmpD = M_get_stack_var();
tmpN = M_get_stack_var();
tmpU = M_get_stack_var();
tmpV = M_get_stack_var();
m_apm_absolute_value(tmpU, u);
m_apm_absolute_value(tmpV, v);
while (TRUE)
{
if (tmpV->m_apm_sign == 0)
break;
m_apm_integer_div_rem(tmpD, tmpN, tmpU, tmpV);
m_apm_copy(tmpU, tmpV);
m_apm_copy(tmpV, tmpN);
}
m_apm_copy(r, tmpU);
M_restore_stack(4);
}
/*
* arcsinh(x) == log [ x + sqrt(x^2 + 1) ]
*
* also, use arcsinh(-x) == -arcsinh(x)
*/
void m_apm_arcsinh(M_APM rr, int places, M_APM aa)
{
M_APM tmp0, tmp1, tmp2;
/* result is 0 if input is 0 */
if (aa->m_apm_sign == 0)
{
M_set_to_zero(rr);
return;
}
tmp0 = M_get_stack_var();
tmp1 = M_get_stack_var();
tmp2 = M_get_stack_var();
m_apm_absolute_value(tmp0, aa);
m_apm_multiply(tmp1, tmp0, tmp0);
m_apm_add(tmp2, tmp1, MM_One);
m_apm_sqrt(tmp1, (places + 6), tmp2);
m_apm_add(tmp2, tmp0, tmp1);
m_apm_log(rr, places, tmp2);
rr->m_apm_sign = aa->m_apm_sign; /* fix final sign */
M_restore_stack(3);
}
/*
* arctanh(x) == 0.5 * log [ (1 + x) / (1 - x) ]
*
* |x| < 1.0
*/
void m_apm_arctanh(M_APM rr, int places, M_APM aa)
{
M_APM tmp1, tmp2, tmp3;
int ii, local_precision;
tmp1 = M_get_stack_var();
m_apm_absolute_value(tmp1, aa);
ii = m_apm_compare(tmp1, MM_One);
if (ii >= 0) /* |x| >= 1.0 */
{
M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arctanh\', |Argument| >= 1");
M_set_to_zero(rr);
M_restore_stack(1);
return;
}
tmp2 = M_get_stack_var();
tmp3 = M_get_stack_var();
local_precision = places + 8;
m_apm_add(tmp1, MM_One, aa);
m_apm_subtract(tmp2, MM_One, aa);
m_apm_divide(tmp3, local_precision, tmp1, tmp2);
m_apm_log(tmp2, local_precision, tmp3);
m_apm_multiply(tmp1, tmp2, MM_0_5);
m_apm_round(rr, places, tmp1);
M_restore_stack(3);
}
void m_apm_arccos(M_APM r, int places, M_APM x)
{
M_APM tmp0, tmp1, tmp2, tmp3, current_x;
int ii, maxiter, maxp, tolerance, local_precision;
current_x = M_get_stack_var();
tmp0 = M_get_stack_var();
tmp1 = M_get_stack_var();
tmp2 = M_get_stack_var();
tmp3 = M_get_stack_var();
m_apm_absolute_value(tmp0, x);
ii = m_apm_compare(tmp0, MM_One);
if (ii == 1) /* |x| > 1 */
{
M_apm_log_error_msg(M_APM_RETURN, "\'m_apm_arccos\', |Argument| > 1");
M_set_to_zero(r);
M_restore_stack(5);
return;
}
if (ii == 0) /* |x| == 1, arccos = 0, PI */
{
if (x->m_apm_sign == 1)
{
M_set_to_zero(r);
}
else
{
M_check_PI_places(places);
m_apm_round(r, places, MM_lc_PI);
}
M_restore_stack(5);
return;
}
if (m_apm_compare(tmp0, MM_0_85) == 1) /* check if > 0.85 */
{
M_cos_to_sin(tmp2, (places + 4), x);
if (x->m_apm_sign == 1)
{
m_apm_arcsin(r, places, tmp2);
}
else
{
M_check_PI_places(places);
m_apm_arcsin(tmp3, (places + 4), tmp2);
m_apm_subtract(tmp1, MM_lc_PI, tmp3);
m_apm_round(r, places, tmp1);
}
M_restore_stack(5);
return;
}
if (x->m_apm_sign == 0) /* input == 0 ?? */
{
M_check_PI_places(places);
m_apm_round(r, places, MM_lc_HALF_PI);
M_restore_stack(5);
return;
}
if (x->m_apm_exponent <= -4) /* input close to 0 ?? */
{
M_arccos_near_0(r, places, x);
M_restore_stack(5);
return;
}
tolerance = -(places + 4);
maxp = places + 8;
local_precision = 18;
/*
* compute the maximum number of iterations
* that should be needed to calculate to
* the desired accuracy. [ constant below ~= 1 / log(2) ]
*/
maxiter = (int)(log((double)(places + 2)) * 1.442695) + 3;
if (maxiter < 5)
maxiter = 5;
M_get_acos_guess(current_x, x);
/* Use the following iteration to solve for arc-cos :
cos(X) - N
X = X + ------------
n+1 sin(X)
*/
ii = 0;
while (TRUE)
{
M_4x_cos(tmp1, local_precision, current_x);
M_cos_to_sin(tmp2, local_precision, tmp1);
if (tmp2->m_apm_sign != 0)
tmp2->m_apm_sign = current_x->m_apm_sign;
m_apm_subtract(tmp3, tmp1, x);
m_apm_divide(tmp0, local_precision, tmp3, tmp2);
m_apm_add(tmp2, current_x, tmp0);
m_apm_copy(current_x, tmp2);
if (ii != 0)
{
if (((2 * tmp0->m_apm_exponent) < tolerance) || (tmp0->m_apm_sign == 0))
break;
}
if (++ii == maxiter)
{
M_apm_log_error_msg(M_APM_RETURN,
"\'m_apm_arccos\', max iteration count reached");
break;
}
local_precision *= 2;
if (local_precision > maxp)
local_precision = maxp;
}
m_apm_round(r, places, current_x);
M_restore_stack(5);
}
void m_apm_reciprocal(M_APM rr, int places, M_APM aa)
{
M_APM last_x, guess, tmpN, tmp1, tmp2;
int ii, bflag, dplaces, nexp, tolerance;
if (aa->m_apm_sign == 0)
{
M_apm_log_error_msg(M_APM_RETURN,
"Warning! ... \'m_apm_reciprocal\', Input = 0");
M_set_to_zero(rr);
return;
}
last_x = M_get_stack_var();
guess = M_get_stack_var();
tmpN = M_get_stack_var();
tmp1 = M_get_stack_var();
tmp2 = M_get_stack_var();
m_apm_absolute_value(tmpN, aa);
/*
normalize the input number (make the exponent 0) so
the 'guess' below will not over/under flow on large
magnitude exponents.
*/
nexp = aa->m_apm_exponent;
tmpN->m_apm_exponent -= nexp;
m_apm_set_double(guess, (1.0 / m_apm_get_double(tmpN)));
tolerance = places + 4;
dplaces = places + 16;
bflag = FALSE;
m_apm_negate(last_x, MM_Ten);
/* Use the following iteration to calculate the reciprocal :
X = X * [ 2 - N * X ]
n+1
*/
ii = 0;
while (TRUE)
{
m_apm_multiply(tmp1, tmpN, guess);
m_apm_subtract(tmp2, MM_Two, tmp1);
m_apm_multiply(tmp1, tmp2, guess);
if (bflag)
break;
m_apm_round(guess, dplaces, tmp1);
/* force at least 2 iterations so 'last_x' has valid data */
if (ii != 0)
{
m_apm_subtract(tmp2, guess, last_x);
if (tmp2->m_apm_sign == 0)
break;
/*
* if we are within a factor of 4 on the error term,
* we will be accurate enough after the *next* iteration
* is complete.
*/
if ((-4 * tmp2->m_apm_exponent) > tolerance)
bflag = TRUE;
}
m_apm_copy(last_x, guess);
ii++;
}
m_apm_round(rr, places, tmp1);
rr->m_apm_exponent -= nexp;
rr->m_apm_sign = aa->m_apm_sign;
M_restore_stack(5);
}
void m_apm_absolute_value_mt(M_APM d, M_APM s)
{
m_apm_enter();
m_apm_absolute_value(d,s);
m_apm_leave();
}
MAPM MAPM::abs(void) const
{
MAPM ret;
m_apm_absolute_value(ret.val(),cval());
return ret;
}
void m_apm_to_fixpt_stringex(char *s, int dplaces, M_APM atmp,
char ch_radix, char ch_sep, int count_sep)
{
M_APM btmp;
char ch, *cpd, *cps;
int ii, jj, kk, ct, dl, xp, no_sep_flg, places;
btmp = M_get_stack_var();
places = dplaces;
cpd = s;
no_sep_flg = FALSE;
m_apm_absolute_value(btmp, atmp); /* do conversion of positive number */
if (ch_sep == 0 || count_sep == 0) /* no separator char OR count */
no_sep_flg = TRUE;
/* determine how much memory to get for the temp string */
dl = btmp->m_apm_datalength;
xp = btmp->m_apm_exponent;
if (places < 0) /* show ALL digits */
{
if (xp < 0)
ii = dl - xp;
else
{
if (dl > xp)
ii = dl;
else
ii = xp;
}
}
else
{
ii = places;
if (xp > 0)
ii += xp;
}
if ((cps = (char *)MAPM_MALLOC((ii + 32) * sizeof(char))) == NULL)
{
/* fatal, this does not return */
M_apm_log_error_msg(M_APM_FATAL,
"\'m_apm_to_fixpt_stringex\', Out of memory");
}
m_apm_to_fixpt_string(cps, places, btmp);
/*
* the converted string may be all 'zero', 0.0000...
* if so and the original number is negative,
* do NOT set the '-' sign of our output string.
*/
if (atmp->m_apm_sign == -1) /* if input number negative */
{
kk = 0;
jj = 0;
while (TRUE)
{
ch = cps[kk++];
if ((ch == '\0') || (jj != 0))
break;
if (isdigit((int)ch))
{
if (ch != '0')
jj = 1;
}
}
if (jj)
*cpd++ = '-';
}
ct = M_strposition(cps, "."); /* find the default (.) radix char */
if (ct == -1) /* if not found .. */
{
strcat(cps, "."); /* add one */
ct = M_strposition(cps, "."); /* and then find it */
}
if (places == 0) /* int format, terminate at radix char */
cps[ct] = '\0';
else
cps[ct] = ch_radix; /* assign the radix char */
/*
* if the number is small enough to not have any separator char's ...
*/
if (ct <= count_sep)
no_sep_flg = TRUE;
if (no_sep_flg)
{
strcpy(cpd, cps);
}
else
{
jj = 0;
kk = count_sep;
ii = ct / count_sep;
if ((ii = ct - ii * count_sep) == 0)
ii = count_sep;
while (TRUE) /* write out the first 1,2 */
{ /* (up to count_sep) digits */
*cpd++ = cps[jj++];
if (--ii == 0)
break;
}
while (TRUE) /* write rest of the string */
{
if (kk == count_sep) /* write a new separator char */
{
if (jj != ct) /* unless we're at the radix */
{
*cpd++ = ch_sep; /* note that this also disables */
kk = 0; /* the separator char AFTER */
} /* the radix char */
}
if ((*cpd++ = cps[jj++]) == '\0')
break;
kk++;
}
}
MAPM_FREE(cps);
M_restore_stack(1);
}
/*
* From Knuth, The Art of Computer Programming:
*
* This is the binary GCD algorithm as described
* in the book (Algorithm B)
*/
void m_apm_gcd(M_APM r, M_APM u, M_APM v)
{
M_APM tmpM, tmpN, tmpT, tmpU, tmpV;
int kk, kr, mm;
long pow_2;
/* 'is_integer' will return 0 || 1 */
if ((m_apm_is_integer(u) + m_apm_is_integer(v)) != 2)
{
M_apm_log_error_msg(M_APM_RETURN,
"Warning! \'m_apm_gcd\', Non-integer input");
M_set_to_zero(r);
return;
}
if (u->m_apm_sign == 0)
{
m_apm_absolute_value(r, v);
return;
}
if (v->m_apm_sign == 0)
{
m_apm_absolute_value(r, u);
return;
}
tmpM = M_get_stack_var();
tmpN = M_get_stack_var();
tmpT = M_get_stack_var();
tmpU = M_get_stack_var();
tmpV = M_get_stack_var();
m_apm_absolute_value(tmpU, u);
m_apm_absolute_value(tmpV, v);
/* Step B1 */
kk = 0;
while (TRUE)
{
mm = 1;
if (m_apm_is_odd(tmpU))
break;
mm = 0;
if (m_apm_is_odd(tmpV))
break;
m_apm_multiply(tmpN, MM_0_5, tmpU);
m_apm_copy(tmpU, tmpN);
m_apm_multiply(tmpN, MM_0_5, tmpV);
m_apm_copy(tmpV, tmpN);
kk++;
}
/* Step B2 */
if (mm)
{
m_apm_negate(tmpT, tmpV);
goto B4;
}
m_apm_copy(tmpT, tmpU);
/* Step: */
B3:
m_apm_multiply(tmpN, MM_0_5, tmpT);
m_apm_copy(tmpT, tmpN);
/* Step: */
B4:
if (m_apm_is_even(tmpT))
goto B3;
/* Step B5 */
if (tmpT->m_apm_sign == 1)
m_apm_copy(tmpU, tmpT);
else
m_apm_negate(tmpV, tmpT);
/* Step B6 */
m_apm_subtract(tmpT, tmpU, tmpV);
if (tmpT->m_apm_sign != 0)
goto B3;
/*
* result = U * 2 ^ kk
*/
if (kk == 0)
m_apm_copy(r, tmpU);
else
{
if (kk == 1)
m_apm_multiply(r, tmpU, MM_Two);
if (kk == 2)
m_apm_multiply(r, tmpU, MM_Four);
if (kk >= 3)
{
mm = kk / 28;
kr = kk % 28;
pow_2 = 1L << kr;
if (mm == 0)
{
m_apm_set_long(tmpN, pow_2);
m_apm_multiply(r, tmpU, tmpN);
}
else
{
m_apm_copy(tmpN, MM_One);
m_apm_set_long(tmpM, 0x10000000L); /* 2 ^ 28 */
while (TRUE)
{
m_apm_multiply(tmpT, tmpN, tmpM);
m_apm_copy(tmpN, tmpT);
if (--mm == 0)
break;
}
if (kr == 0)
{
m_apm_multiply(r, tmpU, tmpN);
}
else
{
m_apm_set_long(tmpM, pow_2);
m_apm_multiply(tmpT, tmpN, tmpM);
m_apm_multiply(r, tmpU, tmpT);
}
}
}
}
M_restore_stack(5);
}
void M_apm_sdivide(M_APM r, int places, M_APM a, M_APM b)
{
int j, k, m, b0, sign, nexp, indexr, icompare, iterations;
long trial_numer;
void *vp;
if (M_div_firsttime)
{
M_div_firsttime = FALSE;
M_div_worka = m_apm_init();
M_div_workb = m_apm_init();
M_div_tmp7 = m_apm_init();
M_div_tmp8 = m_apm_init();
M_div_tmp9 = m_apm_init();
}
sign = a->m_apm_sign * b->m_apm_sign;
if (sign == 0) /* one number is zero, result is zero */
{
if (b->m_apm_sign == 0)
{
M_apm_log_error_msg(M_APM_RETURN, "\'M_apm_sdivide\', Divide by 0");
}
M_set_to_zero(r);
return;
}
/*
* Knuth step D1. Since base = 100, base / 2 = 50.
* (also make the working copies positive)
*/
if (b->m_apm_data[0] >= 50)
{
m_apm_absolute_value(M_div_worka, a);
m_apm_absolute_value(M_div_workb, b);
}
else /* 'normal' step D1 */
{
k = 100 / (b->m_apm_data[0] + 1);
m_apm_set_long(M_div_tmp9, (long)k);
m_apm_multiply(M_div_worka, M_div_tmp9, a);
m_apm_multiply(M_div_workb, M_div_tmp9, b);
M_div_worka->m_apm_sign = 1;
M_div_workb->m_apm_sign = 1;
}
/* setup trial denominator for step D3 */
b0 = 100 * (int)M_div_workb->m_apm_data[0];
if (M_div_workb->m_apm_datalength >= 3)
b0 += M_div_workb->m_apm_data[1];
nexp = M_div_worka->m_apm_exponent - M_div_workb->m_apm_exponent;
if (nexp > 0)
iterations = nexp + places + 1;
else
iterations = places + 1;
k = (iterations + 1) >> 1; /* required size of result, in bytes */
if (k > r->m_apm_malloclength)
{
if ((vp = MAPM_REALLOC(r->m_apm_data, (k + 32))) == NULL)
{
/* fatal, this does not return */
M_apm_log_error_msg(M_APM_FATAL, "\'M_apm_sdivide\', Out of memory");
}
r->m_apm_malloclength = k + 28;
r->m_apm_data = (UCHAR *)vp;
}
/* clear the exponent in the working copies */
M_div_worka->m_apm_exponent = 0;
M_div_workb->m_apm_exponent = 0;
/* if numbers are equal, ratio == 1.00000... */
if ((icompare = m_apm_compare(M_div_worka, M_div_workb)) == 0)
{
iterations = 1;
r->m_apm_data[0] = 10;
nexp++;
}
else /* ratio not 1, do the real division */
{
if (icompare == 1) /* numerator > denominator */
{
nexp++; /* to adjust the final exponent */
M_div_worka->m_apm_exponent += 1; /* multiply numerator by 10 */
}
else /* numerator < denominator */
{
M_div_worka->m_apm_exponent += 2; /* multiply numerator by 100 */
}
indexr = 0;
m = 0;
while (TRUE)
{
/*
* Knuth step D3. Only use the 3rd -> 6th digits if the number
* actually has that many digits.
*/
trial_numer = 10000L * (long)M_div_worka->m_apm_data[0];
if (M_div_worka->m_apm_datalength >= 5)
{
trial_numer += 100 * M_div_worka->m_apm_data[1]
+ M_div_worka->m_apm_data[2];
}
else
{
if (M_div_worka->m_apm_datalength >= 3)
trial_numer += 100 * M_div_worka->m_apm_data[1];
}
j = (int)(trial_numer / b0);
/*
* Since the library 'normalizes' all the results, we need
* to look at the exponent of the number to decide if we
* have a lead in 0n or 00.
*/
if ((k = 2 - M_div_worka->m_apm_exponent) > 0)
{
while (TRUE)
{
j /= 10;
if (--k == 0)
break;
}
}
if (j == 100) /* qhat == base ?? */
j = 99; /* if so, decrease by 1 */
m_apm_set_long(M_div_tmp8, (long)j);
m_apm_multiply(M_div_tmp7, M_div_tmp8, M_div_workb);
/*
* Compare our q-hat (j) against the desired number.
* j is either correct, 1 too large, or 2 too large
* per Theorem B on pg 272 of Art of Compter Programming,
* Volume 2, 3rd Edition.
*
* The above statement is only true if using the 2 leading
* digits of the numerator and the leading digit of the
* denominator. Since we are using the (3) leading digits
* of the numerator and the (2) leading digits of the
* denominator, we eliminate the case where our q-hat is
* 2 too large, (and q-hat being 1 too large is quite remote).
*/
if (m_apm_compare(M_div_tmp7, M_div_worka) == 1)
{
j--;
m_apm_subtract(M_div_tmp8, M_div_tmp7, M_div_workb);
m_apm_copy(M_div_tmp7, M_div_tmp8);
}
/*
* Since we know q-hat is correct, step D6 is unnecessary.
*
* Store q-hat, step D5. Since D6 is unnecessary, we can
* do D5 before D4 and decide if we are done.
*/
r->m_apm_data[indexr++] = (UCHAR)j; /* j == 'qhat' */
m += 2;
if (m >= iterations)
break;
/* step D4 */
m_apm_subtract(M_div_tmp9, M_div_worka, M_div_tmp7);
/*
* if the subtraction yields zero, the division is exact
* and we are done early.
*/
if (M_div_tmp9->m_apm_sign == 0)
{
iterations = m;
break;
}
/* multiply by 100 and re-save */
M_div_tmp9->m_apm_exponent += 2;
m_apm_copy(M_div_worka, M_div_tmp9);
}
}
r->m_apm_sign = sign;
r->m_apm_exponent = nexp;
r->m_apm_datalength = iterations;
M_apm_normalize(r);
}