static int cash_function (Isis_Fit_Statistic_Type *st, /*{{{*/
double *y, double *fx, double *w, unsigned int npts,
double *vec, double *stat)
{
double sum, s, *val;
unsigned int i;
(void) w;
(void) st;
sum = 0.0;
if (NULL == (val = (double *) ISIS_MALLOC (npts * sizeof(double))))
return -1;
/* The form of the statistic is modified according to the
* suggestion of Castor described in the XSPEC manual.
*/
for (i = 0; i < npts; i++)
{
double fxi = fx[i];
double yi = y[i];
double log_fxi;
/* Want sum += (yi - fxi) + yi * log (fxi/yi);
* but must avoid log(0) and f/0
*/
if (yi <= 0) yi = 1.e-5;
log_fxi = (fxi > 0) ? log(fxi) : (double) DBL_MIN_10_EXP;
s = (yi - fxi);
s += yi * (log_fxi - log (yi));
s *= -2;
/* sum += s; */
val[i] = s;
vec[i] = isfinite(s) ? (s * SIGN(yi-fxi)) : DBL_MAX;
}
sum = isis_kahan_sum (val, npts);
ISIS_FREE(val);
if (0 == isfinite (sum))
sum = DBL_MAX;
*stat = sum;
return 0;
}
static int penalty_statistic (Isis_Fit_Statistic_Type *st, /*{{{*/
double *y, double *fx, double *w,
unsigned int npts, double *vec, double *stat)
{
SLang_Array_Type *sl_pars = NULL;
double *pars = NULL;
double old_stat, new_stat, penalty, b, vec_penalty;
SLindex_Type num;
unsigned int i, n;
if (-1 == (*st->assigned_fun)(st, y, fx, w, npts, vec, stat))
return -1;
if (st->constraint_fun == NULL)
return 0;
if (-1 == Fit_copy_fun_params ("constraint", 1, &pars, &n))
return -1;
num = n;
if (num > 0)
{
sl_pars = SLang_create_array (SLANG_DOUBLE_TYPE, 0, pars, &num, 1);
if (NULL == sl_pars)
return -1;
}
old_stat = *stat;
SLang_start_arg_list ();
/* NULL sl_pars is ok */
if ((-1 == SLang_push_double (*stat))
|| (-1 == SLang_push_array (sl_pars, 0)))
{
SLang_end_arg_list ();
SLang_free_array (sl_pars);
return -1;
}
SLang_end_arg_list ();
if ((-1 == SLexecute_function ((SLang_Name_Type *)st->constraint_fun))
|| -1 == SLang_pop_double (&new_stat))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "evaluating fit-constraint function");
SLang_free_array (sl_pars);
return -1;
}
SLang_free_array (sl_pars);
*stat = new_stat;
/* The penalty must also affect the vector statistic somehow.
* Try spreading it uniformly over all bins, assuming that
* the base statistic is the Euclidean norm = sum (vec^2);
* We want to define:
* new_vec = old_vec + vec_penalty
* so that
* new_stat = sum(new_vec^2) = old_stat + penalty.
*
* FIXME? This seems ok for chi-square, but perhaps something
* different would be better for max. likelihood or cash statistic?
* Maybe the statistic object should have a vec_penalty() method?
*/
b = 2 * isis_kahan_sum (vec, npts) / npts;
penalty = new_stat - old_stat;
vec_penalty = -0.5*b + sqrt (0.25*b*b + penalty / npts);
for (i = 0; i < npts; i++)
{
vec[i] += vec_penalty;
}
return 0;
}
