gnm_float
qcauchy (gnm_float p, gnm_float location, gnm_float scale,
gboolean lower_tail, gboolean log_p)
{
if (gnm_isnan(p) || gnm_isnan(location) || gnm_isnan(scale))
return p + location + scale;
R_Q_P01_check(p);
if (scale < 0 || !gnm_finite(scale)) ML_ERR_return_NAN;
if (log_p) {
if (p > -1)
/* The "0" here is important for the p=0 case: */
lower_tail = !lower_tail, p = 0 - gnm_expm1 (p);
else
p = gnm_exp (p);
}
if (lower_tail) scale = -scale;
return location + scale / gnm_tan(M_PIgnum * p);
}
gnm_float gnm_lbeta(gnm_float a, gnm_float b)
{
gnm_float corr, p, q;
p = q = a;
if(b < p) p = b;/* := min(a,b) */
if(b > q) q = b;/* := max(a,b) */
#ifdef IEEE_754
if(gnm_isnan(a) || gnm_isnan(b))
return a + b;
#endif
/* both arguments must be >= 0 */
if (p < 0)
ML_ERR_return_NAN
else if (p == 0) {
return gnm_pinf;
}
else if (!gnm_finite(q)) {
return gnm_ninf;
}
if (p >= 10) {
/* p and q are big. */
corr = lgammacor(p) + lgammacor(q) - lgammacor(p + q);
return gnm_log(q) * -0.5 + M_LN_SQRT_2PI + corr
+ (p - 0.5) * gnm_log(p / (p + q)) + q * gnm_log1p(-p / (p + q));
}
else if (q >= 10) {
/* p is small, but q is big. */
corr = lgammacor(q) - lgammacor(p + q);
return gnm_lgamma(p) + corr + p - p * gnm_log(p + q)
+ (q - 0.5) * gnm_log1p(-p / (p + q));
}
else
/* p and q are small: p <= q < 10. */
return gnm_lgamma (p) + gnm_lgamma (q) - gnm_lgamma (p + q);
}
static GoalSeekStatus
goal_seek_eval (gnm_float x, gnm_float *y, void *vevaldata)
{
GoalEvalData const *evaldata = vevaldata;
GnmValue *v = value_new_float (x);
if (evaldata->update_ui) {
sheet_cell_set_value (evaldata->xcell, v);
} else {
gnm_cell_set_value (evaldata->xcell, v);
cell_queue_recalc (evaldata->xcell);
}
workbook_recalc (evaldata->state->wb);
if (evaldata->ycell->value) {
*y = value_get_as_float (evaldata->ycell->value) - evaldata->ytarget;
if (gnm_finite (*y))
return GOAL_SEEK_OK;
}
return GOAL_SEEK_ERROR;
}
static gboolean
rosenbrock_iter (GnmNlsolve *nl)
{
GnmSolver *sol = nl->parent;
const int n = nl->vars->len;
int i, j;
const gnm_float alpha = 3;
const gnm_float beta = 0.5;
gboolean any_at_all = FALSE;
gnm_float *d, **A, *x, *dx, *t;
char *state;
int dones = 0;
gnm_float ykm1 = nl->yk, *xkm1;
gnm_float eps = gnm_pow2 (-16);
int safety = 0;
if (nl->tentative) {
nl->tentative--;
if (nl->tentative == 0) {
if (nl->debug)
g_printerr ("Tentative move rejected\n");
rosenbrock_tentative_end (nl, FALSE);
}
}
if (nl->k % 20 == 0) {
for (i = 0; i < n; i++)
for (j = 0; j < n; j++)
nl->xi[i][j] = (i == j);
}
A = g_new (gnm_float *, n);
for (i = 0; i < n; i++)
A[i] = g_new (gnm_float, n);
dx = g_new (gnm_float, n);
for (i = 0; i < n; i++)
dx[i] = 0;
x = g_new (gnm_float, n);
t = g_new (gnm_float, n);
d = g_new (gnm_float, n);
for (i = 0; i < n; i++) {
d[i] = (nl->xk[i] == 0)
? eps
: gnm_abs (nl->xk[i]) * eps;
}
xkm1 = g_memdup (nl->xk, n * sizeof (gnm_float));
state = g_new0 (char, n);
while (dones < n) {
/*
* A safety that shouldn't get hit, but might if the function
* being optimized is non-deterministic.
*/
if (safety++ > n * GNM_MANT_DIG)
break;
for (i = 0; i < n; i++) {
gnm_float y;
if (state[i] == 2)
continue;
/* x = xk + (d[i] * xi[i]) */
for (j = 0; j < n; j++)
x[j] = nl->xk[j] + d[i] * nl->xi[i][j];
set_vector (nl, x);
y = get_value (nl);
if (y <= nl->yk && gnm_solver_check_constraints (sol)) {
if (y < nl->yk) {
nl->yk = y;
memcpy (nl->xk, x, n * sizeof (gnm_float));
dx[i] += d[i];
any_at_all = TRUE;
}
switch (state[i]) {
case 0:
state[i] = 1;
/* Fall through */
case 1:
d[i] *= alpha;
break;
default:
case 2:
break;
}
} else {
switch (state[i]) {
case 1:
state[i] = 2;
dones++;
/* Fall through */
case 0:
d[i] *= -beta;
break;
default:
case 2:
/* No sign change. */
d[i] *= 0.5;
break;
}
}
}
}
if (any_at_all) {
gnm_float div, sum;
for (j = n - 1; j >= 0; j--)
for (i = 0; i < n; i++)
A[j][i] = (j == n - 1 ? 0 : A[j + 1][i]) + dx[j] * nl->xi[j][i];
sum = 0;
for (i = n - 1; i >= 0; i--) {
sum += dx[i] * dx[i];
t[i] = sum;
}
for (i = n - 1; i > 0; i--) {
div = gnm_sqrt (t[i - 1] * t[i]);
if (div != 0)
for (j = 0; j < n; j++) {
nl->xi[i][j] = (dx[i - 1] * A[i][j] -
nl->xi[i - 1][j] * t[i]) / div;
g_assert (gnm_finite (nl->xi[i][j]));
}
}
gnm_range_hypot (dx, n, &div);
if (div != 0) {
for (i = 0; i < n; i++) {
nl->xi[0][i] = A[0][i] / div;
if (!gnm_finite (nl->xi[0][i])) {
g_printerr ("%g %g %g\n",
div, A[0][i], nl->xi[0][i]);
g_assert (gnm_finite (nl->xi[0][i]));
}
}
}
/* ---------------------------------------- */
if (!nl->tentative) {
set_vector (nl, nl->xk);
gnm_nlsolve_set_solution (nl);
}
if (nl->tentative) {
if (nl->yk < nl->tentative_yk) {
if (nl->debug)
g_printerr ("Tentative move accepted!\n");
rosenbrock_tentative_end (nl, TRUE);
}
} else if (gnm_abs (nl->yk - ykm1) > gnm_abs (ykm1) * 0.01) {
/* A big step. */
nl->smallsteps = 0;
} else {
nl->smallsteps++;
}
if (!nl->tentative && nl->smallsteps > 50) {
gnm_float yk = nl->yk;
nl->tentative = 10;
nl->tentative_xk = g_memdup (nl->xk, n * sizeof (gnm_float));
nl->tentative_yk = yk;
for (i = 0; i < 4; i++) {
gnm_float ymax = yk +
gnm_abs (yk) * (0.10 / (i + 1));
if (i > 0)
ymax = MIN (ymax, nl->yk);
if (!newton_improve (nl, nl->xk, &nl->yk, ymax))
break;
}
if (nl->debug)
print_vector ("Tentative move to", nl->xk, n);
}
}
g_free (x);
g_free (xkm1);
g_free (dx);
g_free (t);
g_free (d);
free_matrix (A, n);
g_free (state);
return any_at_all;
}
int
gnm_complex_invalid_p (gnm_complex const *src)
{
return !(gnm_finite (src->re) && gnm_finite (src->im));
}
