/*
    Theseus - maximum likelihood superpositioning of macromolecular structures

    Copyright (C) 2004-2015 Douglas L. Theobald

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the:

    Free Software Foundation, Inc.,
    59 Temple Place, Suite 330,
    Boston, MA  02111-1307  USA

    -/_|:|_|_\-
*/

#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_psi.h>
//#include "DLTmath.h"
#include "statistics.h"
#include "gamma_dist.h" /* gamma_dev() */
#include "invchisqr_dist.h"

/* The inverse chi^2 distribution has the form

   p(x) dx = (1/(2^(n/2) * Gamma(nu/2))) * x^(-nu/2 - 1) * exp(-1/(2x)) dx

   0 <= x < +inf
   nu > 0
*/


double
invchisqr_dev(const double nu, const double nullval, const gsl_rng *r2)
{
    return(0.5 / gamma_dev(1.0, 0.5*nu, r2));
}


double
invchisqr_pdf(const double x, const double nu, const double nullval)
{
    double          p, nu2;

    if (x <= 0.0)
    {
        return(0.0);
    }
    else
    {
        nu2 = 0.5*nu;
      
        p = (-nu2-1.0)*log(x) - (0.5/x) - nu2*log(2.0) - lgamma(nu2);
        return(exp(p));
    }
}


double
invchisqr_lnpdf(const double x, const double nu, const double nullval)
{
    double          p, nu2;

    nu2 = 0.5*nu;
      
    p = (-nu2-1.0)*log(x) - (0.5/x) - nu2*log(2.0) - lgamma(nu2);
    return(p);
}


double
invchisqr_cdf(const double x, const double nu, const double nullval)
{
    return(-gsl_sf_gamma_inc_Q(0.5*nu, (0.5/x)));
}


double
invchisqr_sdf(const double x, const double nu, const double nullval)
{
    return(1.0 - invchisqr_cdf(x, nu, nullval));
}


double
invchisqr_int(const double x, const double y, const double nu, const double nullval)
{
    return(invchisqr_cdf(x, nu, nullval) - invchisqr_cdf(y, nu, nullval));
}


/* For the maximum likelihood fit we must find the root of:

       F1 = (1/N)\Sum{log(x)} + log(2) + digamma{nu/2} = 0

   where the first derivative with repect to nu (dF1/dnu) is:

       F1' = trigamma(nu/2)/2 = 0

   These were derived using the fact that the deriviative of the
   ln(Gamma()) function is the digamma() function. And the
   deriviative fo the digamma() is the trigamma().
*/
void
evalinvchisqrML(const double logterm, const double nu, double *fx, double *dfx)
{
    *fx  = logterm + gsl_sf_psi(0.5*nu);
    *dfx = 0.5*gsl_sf_psi_1(0.5*nu);
}


/* fit an inverse chi^2 distribution by maximum likelihood */
double
invchisqr_fit(const double *data, const int num, double *nu, double *nullp, double *prob)
{
    double          ave, logterm, fx, dfx, guess_nu;
    int             i;
    int             iter = 100;
    double          tol = 1e-8;

    ave = 0.0;
    for (i = 0; i < num; ++i)
    {
        if (data[i] < 0.0)
        {
            fprintf(stderr, "\n ERROR345: inverse chi^2 distributed data must be >= 0.0 ");
            return(-1.0);
        }
        else
        {
            ave += data[i];
        }
    }
    ave /= (double) num;

    guess_nu = *nu = (1.0 / ave) + 2.0;

/* SCREAMF(*nu); */

    logterm = 0.0;
    for (i = 0; i < num; ++i)
    {
        if(data[i] == 0.0)
            continue;

        logterm += log(data[i]);
    }
    logterm /= (double) num;
    logterm += log(2.0);

    for (i = 0; i < iter; ++i)
    {
        evalinvchisqrML(logterm, *nu, &fx, &dfx);
/*         SCREAME(fx); */
/*         SCREAME(dfx); */
/*         SCREAME(*nu); */

        if (fabs(fx) < tol)
            break;             /* success */

        *nu -= (fx / dfx);     /* Newton-Raphson is simple */

        if (*nu <= 0.0)
            *nu = tol;
    }

/* SCREAMD(i); */

    if (i == iter)
        *nu = guess_nu;

/* SCREAMF(*nu); */

    return(chi_sqr_adapt(data, num, 0, prob, *nu, 0, invchisqr_pdf, invchisqr_lnpdf, invchisqr_int));
}
