double MotifSearch::matrix_score() {
double ms = 0.0;
float* freq_matrix = new float[4 * motif.ncols()];
motif.calc_freq_matrix(freq_matrix);
int nc = motif.ncols();
int w = motif.get_width();
double sc[] = {0.0,0.0,0.0,0.0};
for(int i = 0; i < 4 * nc; i += 4) {
for(int j = 0; j < 4; j++) {
ms += gammaln((double) freq_matrix[i + j] + params.pseudo[j]);
sc[j] += freq_matrix[i + j];
}
}
delete [] freq_matrix;
ms -= nc * gammaln((double) motif.number() + params.npseudo);
for (int j = 0; j < 4; j++)
ms -= sc[j] * log(params.backfreq[j]);
/*
This factor arises from a modification of the model of Liu, et al
in which the background frequencies of DNA bases are taken to be
constant for the organism under consideration
*/
double vg = 0.0;
ms -= lnbico(w - 2, nc - 2);
for(int j = 0; j < 4; j++)
vg += gammaln(params.pseudo[j]);
vg -= gammaln((double) (params.npseudo));
ms -= ((double) nc * vg);
return ms;
}
double gamln(int pre,double x,int type) {
if(pre<=10000) {
if(pre<0) {
printf("DAMN...................... %d\n",pre);
}
else {
/*read from global variables*/
switch(type) {
case 1:
return gamln_0[pre];
case 2:
return gamln_a[pre];
case 3:
return gamln_g[pre];
case 4:
return gammaln(x);
/*return gamln_l[pre];*/
case 5:
return gamln_wl[pre];
}
}
}
else {
/*4th order approximation
return( M_lnSqrt2PI + (x-0.5)*log(x)-x);*/
return gammaln(x);
}
}
double MotifSearch::over_score() {
double os = 0.0;
double map_N = motif.positions_in_search_space();
double w = params.weight/(1.0-params.weight);
double map_alpha = (double) params.expect * w;
double map_beta = map_N * w - map_alpha;
double map_success = (double)motif.number();
os += ( gammaln(map_success+map_alpha)+gammaln(map_N-map_success+map_beta) );
os -= ( gammaln(map_alpha)+gammaln(map_N + map_beta) );
return os;
}
void npem_em_e(double *y, int *n_plates, double *c, int *n_groups,
int *n, int *ns, double *ests, double *k, double *ksq,
int *maxk)
{
int i, j, p, r;
double f, g, h, du;
int *ns_cur;
int absig_loc;
/* calculate E(k_ij|y_ij) and E[(k_ij)^2|y_ij] */
ns_cur = ns;
absig_loc = *n_groups;
/* p goes over the plates */
for(p=0; p < *n_plates; p++, absig_loc += 3) {
/* i goes over lambda groups within a plate */
for(i=0; i< *n_groups; i++, ns_cur++) {
/* j goes over the y within a lambda group */
for(j= *ns_cur; j< *(ns_cur + 1); j++) {
k[j] = 0.0;
ksq[j] = 0.0;
h = (y[j]- ests[absig_loc]) / ests[absig_loc+2];
g = exp( -0.5 * h * h );
for(f=0.0, r=1; r < (*maxk); r++) {
h = (y[j] - ests[absig_loc] - ests[absig_loc+1] *
((double)r)) / ests[absig_loc+2];
f = ( -0.5 * h * h + ((double)r) * log(ests[i]*c[j]) );
du = gammaln((double)r);
k[j] += exp(f - du);
ksq[j] += exp(f + log((double)r) - du);
du = gammaln((double)(r+1));
g += exp(f - du);
}
if(g < 1e-50) {
k[j]=1e-50; /* this hopefully fixes a problem */
ksq[j]=1e-50; /* which occurs when g=0 */
}
else {
k[j] /= g;
ksq[j] /= g;
}
}
}
}
}
double gcf(const double a, const double x)
{
const int ITMAX = 100;
const double EPS = 3.0e-7;
double gold = 0, g, fac = 1.0, b1 = 1.0;
double b0 = 0, anf, ana, an, a1, a0 = 1.0;
double gln = gammaln(a);
a1 = x;
for (int n = 1; n <= ITMAX; ++n)
{
an = 1.0 * n;
ana = an - a;
a0 = (a1 + a0*ana) * fac;
b0 = (b1 + b0*ana) * fac;
anf = an * fac;
a1 = x * a0 + anf * a1;
b1 = x * b0 + anf * b1;
if (fabs(a1) > 0.0)
{
fac = 1.0 / a1;
g = b1 * fac;
if (fabs((g-gold)/g) < EPS)
return exp(-x+a*log(x)-gln) * g;
gold = g;
};
};
return 0;
}
void gammacf(double * gcf, double a, double x)
{
int i, ITMAX = 100;
double an, b, c, d, del, h, gln, eps = DBL_EPSILON, FPMIN = DBL_MIN;
gln=gammaln(a);
b = x+1.0-a;
c = 1.0/FPMIN;
d = 1.0/b;
h = d;
for (i = 1; i <= ITMAX; ++i) {
an = -i*(i-a);
b += 2.0;
d = an*d+b;
if (fabs(d) < FPMIN)
d = FPMIN;
c = b+an/c;
if (fabs(c) < FPMIN)
c = FPMIN;
d = 1.0/d;
del = d*c;
h *= del;
if (fabs(del-1.0) <= eps)
break;
}
if (i > ITMAX)
puts("uwerr: a too large, ITMAX too small in gammacf.");
*gcf = exp(-x+a*log(x)-gln)*h;
}
void gammaser(double * gser, double a, double x)
{
int n, ITMAX = 100;
double sum, del, ap, gln, eps = DBL_EPSILON;
gln = gammaln(a);
if (x <= 0.0) {
if (x < 0.0)
puts("uwerr: x less than 0 in gammaser.");
*gser = 0.0;
return;
} else {
ap = a;
del = sum = 1.0/a;
for (n = 0; n < ITMAX; ++n) {
++ap;
del *= x/ap;
sum += del;
if (fabs(del) < fabs(sum)*eps) {
*gser = sum*exp(-x+a*log(x)-gln);
return;
}
}
puts("uwerr: a too large, ITMAX too small in gammaser.");
}
}
// x/2 is actual gammaln parameter
void precomputeGammaLn(int size)
{
int i;
new (&gl_pc) Vector(size);
for (i=0;i<gl_pc.n;i++)
gl_pc[i] = gammaln(i/2.0);
}
double logbetai(double a, double b, double x){
double bt;
if(x <= 0.0 || x >= 1.0){
printf("Invalid x in function logbetai\n");
return(0.0);
}
bt = gammaln(a + b) - gammaln(a) - gammaln(b) + a * log(x) + b * log(1.0 - x);
if(x < (a+1.0)/(a+b+2.0)){
return bt + log(betacf(a,b,x)) - log(a);
}
else{
return log(1.0 - exp(bt) * betacf(b,a,1.0 - x) / b);
}
}
void SciCalc::factorial() {
double lg, alpha;
/* uses gamma functions to get result for non-integer values */
alpha = value[top] + 1.0;
if ((floor(alpha) == alpha)&&(alpha <= 0.0))
{
init_value(0);
leddisplay->label("Error: -ve integer ");
leddisplay->redraw();
}
else
if (alpha > 32)
{
lg = exp(gammaln(alpha));
value[top] = lg;
set_display(value[top],NORM);
ready = 1;
}
else
if (alpha > 1.0)
{
int n = (int)truncf(alpha);
lg = 1.0;
for (int i = 1; i <n; i++) lg *= i;
value[top] = lg;
set_display(value[top],NORM);
ready = 1;
}
}
void mexFunction(int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[])
{
int ndims, len, i;
int *dims;
double *indata, *outdata, d;
if((nlhs > 1) || (nrhs < 1) || (nrhs > 2))
mexErrMsgTxt("Usage: x = gammaln(n) or gammaln(n,d)");
/* prhs[0] is first argument.
* mxGetPr returns double* (data, col-major)
*/
ndims = mxGetNumberOfDimensions(prhs[0]);
dims = (int*)mxGetDimensions(prhs[0]);
indata = mxGetPr(prhs[0]);
len = mxGetNumberOfElements(prhs[0]);
if(mxIsSparse(prhs[0]))
mexErrMsgTxt("Cannot handle sparse matrices. Sorry.");
/* plhs[0] is first output */
plhs[0] = mxCreateNumericArray(ndims, dims, mxDOUBLE_CLASS, mxREAL);
outdata = mxGetPr(plhs[0]);
/* compute gammaln of every element */
if(nrhs == 1) {
for(i=0;i<len;i++)
*outdata++ = gammaln(*indata++);
} else {
d = *mxGetPr(prhs[1]);
for(i=0;i<len;i++)
*outdata++ = gammaln2(*indata++,d);
}
}
// Compute raw log likelihood per element
double perDatumLogLikelihood(const double *czx, int numz, int numx) {
double cx;
int z,x;
double f,N;
N = 0.;
f = 0.;
for (x=0;x<numx;x++) {
cx = 0.;
for (z=0;z<numz;z++) {
cx += czx[z+x*numz];
f += gammaln(czx[z+x*numz]+1);
}
N += cx;
f -= gammaln(cx + numz);
}
return f/N;
}
double lnfact(int n)
/* static variables are guaranteed to be initialized to zero */
{
static double lnft[MAX_LN_FACT];
assert(n < MAX_LN_FACT);
if (n <= 1) return 0.0;
if (n <= 50) return lnft[n] ? lnft[n] : (lnft[n] = gammaln(n + 1.0));
else return lnft[n]? lnft[n] : (lnft[n] = stirlingln(n));
}
/* generates a poisson distribution given mean mu
* (ref. Numerical Recipies in C : Pg 294 */
double linsched_gen_poisson_dist(struct rand_dist *rdist)
{
int mu = ((struct poisson_dist *) rdist->dist)->mu;
unsigned int *rand_state =
((struct poisson_dist *) rdist->dist)->rand_state;
double sq = 0.0, alxm = 0.0, g = 0.0, oldm = (-1.0);
double em, t, y;
if (mu < 12.0) {
if (mu != oldm) {
oldm = mu;
g = exp(-mu);
}
em = -1;
t = 1.0;
do {
++em;
t *= linsched_rand(rand_state);
} while (t > g);
} else {
if (mu != oldm) {
oldm = mu;
sq = sqrt(2.0 * mu);
alxm = log(mu);
g = mu * alxm - gammaln(mu + 1.0);
}
do {
do {
y = tan(M_PI * linsched_rand(rand_state));
em = sq * y + mu;
} while (em < 0.0);
em = floor(em);
t = 0.9 * (1.0 + y * y) * exp(em * alxm -
gammaln(em + 1.0)
- g);
} while (linsched_rand(rand_state) > t);
}
return em;
}
// Returns the incomplete beta function Ix(a; b)
float betai(float a, float b, float x)
{
float bt;
if (x < 0.0 || x > 1.0 || a==0.0 || b==0.0)
{
// cout << "Bad x in routine betai" << '\n';
return -999;
}
if (x == 0.0 || x == 1.0)
bt=0.0;
else
// Factors in front of the continued fraction.
bt = exp(gammaln(a+b)-gammaln(a)-gammaln(b)+a*log(x)+b*log(1.0-x));
if (x < (a+1.0)/(a+b+2.0))
// Use continued fraction directly.
return bt*betacf(a,b,x)/a;
else
// Use continued fraction after making the symmetry
// transformation.
return 1.0-bt*betacf(b,a,1.0-x)/b;
}
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
if (nrhs!=1)
mexErrMsgTxt("Expected 1argument\n");
double n = get_double(prhs[0]);
plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL);
double* ret = mxGetPr(plhs[0]);
if (n<0)
mexErrMsgTxt("gammaln function only defined for positive values");
else
*ret = gammaln(n);
}
double wind_power_calculator::turbine_output_using_weibull(double weibull_k, double , double avg_speed, double ref_height, double energy_turbine[])
{ // returns same units as 'power_curve'
double hub_ht_windspeed = pow((m_dHubHeight / ref_height), m_dShearExponent) * avg_speed;
double denom = exp(gammaln(1+(1/weibull_k))); //fixed jmf 2/18/15- weibull_k was accidentally replaced with hub_ht_windspeed previously
double lambda = hub_ht_windspeed/denom;
//double air_density = physics::Pa_PER_Atm * pow( (1-((0.0065*elevation)/288.0)), (physics::GRAVITY_MS2/(0.0065*287.15)) ) / (287.15*(288.0-0.0065*elevation));
// 'RUN' MODEL ****************************************************************************************
double total_energy_turbine=0;//, total_energy_generic=0;
std::vector<double> weibull_cummulative(m_iLengthOfTurbinePowerCurveArray, 0);
std::vector<double> weibull_bin(m_iLengthOfTurbinePowerCurveArray, 0);
//std::vector<double> weibull_probability(m_iLengthOfTurbinePowerCurveArray, 0);
//std::vector<double> energy_turbine(m_iLengthOfTurbinePowerCurveArray, 0); // energy from turbine chosen from library
// weibull_k = 2.10; // used for testing: this is off in the 5th significant digit when passed into SSC from samwx
// CHANGE IN METHODOLOGY JMF 3/17/15
/* The cost and scaling model calculates the POINT weibull probability and multiplies it by the width of the bin (0.25 m/s)- implemented by dividing by 4 in "Energy Capture" result.
This is effectively a midpoint integration. We were effectively calculating a right-hand integration by assuming that the cumulative weibull_bin (more accurate)
should be paired with the power curve at the upper end of the bin. To fix this, we will calculate the weibull probabilities shifted up by half of the bin width
(0.5 * 0.25 m/s = 0.125 m/s), so that the WS lies at the midpoint of the probability bin.
*/
weibull_cummulative[0] = 1.0 - exp(-pow((0.125) / lambda, weibull_k)); //first bin is probability from 0 to 0.125 m/s
weibull_bin[0] = weibull_cummulative[0]; //first bin is equal to first cumulative calculation
energy_turbine[0] = 0.0;
for (size_t i=1; i<m_iLengthOfTurbinePowerCurveArray; i++)
{
// calculate Weibull likelihood of the wind blowing in the range from windspeed[i - 0.5*bin_width] to windspeed[i + 0.5*bin_width]
weibull_cummulative[i] = 1.0 - exp(-pow((m_adPowerCurveWS[i]+0.125)/lambda,weibull_k)); //the 0.125 shifts the probability bin so that the WS lies at the midpoint of the bin
weibull_bin[i] = weibull_cummulative[i] - weibull_cummulative[i-1];
// calculate annual energy from turbine at this wind speed = (hours per year at this wind speed) X (turbine output at wind speed)
energy_turbine[i] = (8760.0 * weibull_bin[i]) * m_adPowerCurveKW[i];
// keep track of cummulative output
total_energy_turbine += energy_turbine[i];
}
// calculate output accounting for losses
return total_energy_turbine;
}
void mexFunction(int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[])
{
mwSize ndims, len, i, nnz;
mwSize *dims;
double *indata, *outdata, d;
if((nlhs > 1) || (nrhs < 1) || (nrhs > 2))
mexErrMsgTxt("Usage: x = gammaln(n) or gammaln(n,d)");
/* prhs[0] is first argument.
* mxGetPr returns double* (data, col-major)
*/
ndims = mxGetNumberOfDimensions(prhs[0]);
dims = (mwSize*)mxGetDimensions(prhs[0]);
indata = mxGetPr(prhs[0]);
len = mxGetNumberOfElements(prhs[0]);
if(mxIsSparse(prhs[0])) {
plhs[0] = mxDuplicateArray(prhs[0]);
/* number of nonzero entries */
nnz = mxGetJc(prhs[0])[mxGetN(prhs[0])];
if(nnz != mxGetNumberOfElements(prhs[0])) {
mexErrMsgTxt("Cannot handle sparse n.");
}
} else {
/* plhs[0] is first output */
plhs[0] = mxCreateNumericArray(ndims, dims, mxDOUBLE_CLASS, mxREAL);
}
outdata = mxGetPr(plhs[0]);
/* compute gammaln of every element */
if(nrhs == 1) {
for(i=0;i<len;i++)
*outdata++ = gammaln(*indata++);
} else {
if(mxGetNumberOfElements(prhs[1]) != 1) mexErrMsgTxt("d is not scalar.");
d = *mxGetPr(prhs[1]);
for(i=0;i<len;i++)
*outdata++ = gammaln2(*indata++,d);
}
}
/*
Returns the incomplete gamma function P(a; x)
evaluated by its series representation as gamser.
Also returns ln
*/
double gser(const double a, const double x)
{
const int ITMAX = 100;
const double EPS = 3.0e-7;
double gln = gammaln(a);
double ap = a;
double del, sum;
if (a > 0.0 || a < 0.0)
{
del = sum = 1.0 / a;
for (int n = 1; n <= ITMAX; ++n)
{
ap += 1.0;
del *= x/ap;
sum += del;
if (fabs(del) < fabs(sum)*EPS)
return sum*exp(-x+a*log(x)-gln);
}
}
return 0;
}
void npem_ll(double *y, int *n_plates, double *c, int *n_groups,
int *n, int *ns, int *len_plate, int *len_group,
double *ests, double *loglik, int *maxk)
{
int i, j, r, p;
double f, g, du;
int *ns_cur;
int absig_loc;
/* calculate log likelihood */
*loglik = 0.0;
ns_cur = ns;
absig_loc = *n_groups;
/* p goes through the plates */
for(p=0; p<*n_plates; p++, absig_loc += 3) {
/* i goes through the lambda groups */
for(i=0; i<*n_groups; i++, ns_cur++) {
/* j goes through the y within a lambda group */
for(j= *ns_cur; j< *(ns_cur+1); j++) {
f = 0.0;
for(r=0; r < (*maxk); r++) {
g = (y[j] - ests[absig_loc] - ests[absig_loc+1]
* ((double)r)) / ests[absig_loc+2];
du = gammaln((double)(r+1));
f += exp(-0.5*g*g + ((double)r)*log(ests[i]*c[j]) - du);
}
if(f <= 1e-50) f = 1e-50;
(*loglik) += (log(f) - ests[i]*c[j]);
}
(*loglik) -= ( (double)n[i] * log(ests[absig_loc+2]) );
}
}
}
double lognchoosek(size_t n, size_t k)
{
return gammaln(n + 1) - gammaln(n - k + 1) - gammaln(k + 1);
}
float betalog(float x, float y)
{return gammaln(x)+gammaln(y)-gammaln(x+y);}
double factln(float h)
{
return gammaln(h+1.0);
}
double sinvchi2_lpdf(const double x, const double nu, const double s2){
double nu_2 = 0.5 * nu;
return log(nu_2) * nu_2 - gammaln(nu_2) + log(s2) * nu_2
- log(x) * (nu_2 + 1) - nu_2 * s2 / x;
}
