/** Ricker function; random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable scalar in a random effects model
\return \f$ axe^{-bx} \f$
\ingroup ECOL
**/
df1b2vector Ricker(const dvector& x, const df1b2vector& a, const df1b2variable& b)
{
df1b2vector y;
y=elem_prod(a, elem_prod(x, exp(-b*x)));
return(y);
}
/** Ricker function; random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable vector in a random effects model
\return \f$ axe^{-bx} \f$
\ingroup ECOL
**/
df1b2vector Ricker(const dvector& x, const df1b2vector& a, const df1b2vector& b)
{
df1b2vector y;
y=elem_prod(a, elem_prod(x, exp(-1.0*elem_prod(b, x))));
return(y);
}
/** ecologically parameterized logistic function with carrying capacity K; random effects vectorized
\param t independent variable; data vector
\param K carrying capacity; differentiable vector in a random effects model
\param r growth rate; differentiable vector in a random effects model
\param n0 initial population size at t=0; differentiable vector in a random effects model
\return \f$ \frac{K}{1+(\frac{K}{n0}-1)e^{-rt}} \f$
\ingroup ECOL
**/
df1b2vector logisticK( const dvector& t, const df1b2vector& K, const df1b2vector& r, const df1b2vector& n0)
{
df1b2vector y;
y=elem_div(K, 1.0 + elem_prod(elem_div(K, n0)-1.0, exp(-1.0*elem_prod(r,t))));
return(y);
}
/** monomoleular function; random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable vector in a random effects model
\return \f$ a(1-e^{-bx}) \f$
\ingroup ECOL
**/
df1b2vector monomolecular(const dvector& x, const df1b2vector& a, const df1b2vector& b)
{
df1b2vector y;
y=elem_prod(a, 1.0-exp(-1.0*elem_prod(b,x)));
return(y);
}
/** ecologically parameterized logistic function with carrying capacity K; random effects vectorized
\param t independent variable; data vector
\param K carrying capacity; differentiable scalar in a random effects model
\param r growth rate; differentiable vector in a random effects model
\param n0 initial population size at t=0; differentiable vector in a random effects model
\return \f$ \frac{K}{1+(\frac{K}{n0}-1)e^{-rt}} \f$
\ingroup ECOL
**/
df1b2vector logisticK( const dvector& t, const df1b2variable& K, const df1b2vector& r, const df1b2vector& n0)
{
df1b2vector y;
y=K/(1.0+elem_prod(K/n0-1.0, exp(-1.0*elem_prod(r,t))));
return(y);
}
/** logistic function; random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable vector in a random effects model
\return \f$ \frac{e^{a+bx}}{(1+e^{a+bx})} \f$
\ingroup ECOL
**/
df1b2vector logistic(const dvector& x, const df1b2vector& a, const df1b2vector& b)
{
df1b2vector y;
y=elem_div(exp(a+elem_prod(b,x)), 1.0+exp(a+elem_prod(b,x)));
return(y);
}
/** generalized Ricker function, first parameerization; random effects vectorized
\param x independent variable; data vector
\param x0 ; differentiable scalar in a random effects model
\param A ; differentiable vector in a random effects model
\param alpha ; differentiable vector in a random effects model
\return \f$ A(\frac{x}{x0}e^{(1.0-\frac{x}{x0})})^{\alpha} \f$
\ingroup ECOL
**/
df1b2vector generalized_Ricker1(const dvector& x, const df1b2variable& x0, const df1b2vector& A, const df1b2vector& alpha)
{
df1b2vector y;
y=elem_prod(A, pow(elem_prod(x/x0, exp(1.0-x/x0)), alpha));
return(y);
}
/** generalized Ricker function, first parameerization; random effects vectorized
\param x independent variable; data vector
\param x0 ; differentiable vector in a random effects model
\param A ; differentiable vector in a random effects model
\param alpha ; differentiable vector in a random effects model
\return \f$ A(\frac{x}{x0}e^{(1.0-\frac{x}{x0})})^{\alpha} \f$
\ingroup ECOL
**/
df1b2vector generalized_Ricker1(const dvector& x, const df1b2vector& x0, const df1b2vector& A, const df1b2vector& alpha)
{
df1b2vector y;
y=elem_prod(A, pow(elem_prod(elem_div(x, x0), exp(1.0-elem_div(x, x0))), alpha));
return(y);
}
/** generalized Ricker function, first parameerization; vectorized
\param x independent variable; data vector
\param x0 ; differentiable vector
\param A ; differentiable vector
\param alpha ; differentiable scalar
\return \f$ A(\frac{x}{x0}e^{(1.0-\frac{x}{x0})})^{\alpha} \f$
\ingroup ECOL
**/
dvar_vector generalized_Ricker1(const dvector& x, const dvar_vector& x0, const dvar_vector& A, const prevariable& alpha)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_prod(A, pow(elem_prod(elem_div(x, x0), exp(1.0-elem_div(x, x0))), alpha));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** Ricker function; vectorized
\param x independent variable; data vector
\param a ; differentiable vector
\param b ; differentiable vector
\return \f$ axe^{-bx} \f$
\ingroup ECOL
**/
dvar_vector Ricker(const dvector& x, const dvar_vector& a, const dvar_vector& b)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_prod(a, elem_prod(x, exp(-1.0*elem_prod(b, x))));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** Ricker function; vectorized
\param x independent variable; data vector
\param a ; differentiable vector
\param b ; differentiable scalar
\return \f$ axe^{-bx} \f$
\ingroup ECOL
**/
dvar_vector Ricker(const dvector& x, const dvar_vector& a, const prevariable& b)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_prod(a, elem_prod(x, exp(-b*x)));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** monomoleular function; vectorized
\param x independent variable; data vector
\param a ; differentiable vector
\param b ; differentiable vector
\return \f$ a(1-e^{-bx}) \f$
\ingroup ECOL
**/
dvar_vector monomolecular(const dvector& x, const dvar_vector& a, const dvar_vector& b)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_prod(a, 1.0-exp(-1.0*elem_prod(b,x)));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** ecologically parameterized logistic function with carrying capacity K; vectorized
\param t independent variable; data vector
\param K carrying capacity; differentiable vector
\param r growth rate; differentiable vector
\param n0 initial population size at t=0; differentiable scalar
\return \f$ \frac{K}{1+(\frac{K}{n0}-1)e^{-rt}} \f$
\ingroup ECOL
**/
dvar_vector logisticK( const dvector& t, const dvar_vector& K, const dvar_vector& r, const prevariable& n0)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_div(K, 1.0 + elem_prod(K/n0-1.0, exp(-1.0*elem_prod(r,t))));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** logistic function; vectorized
\param x independent variable; data vector
\param a ; differentiable vector
\param b ; differentiable vector
\return \f$ \frac{e^{a+bx}}{(1+e^{a+bx})} \f$
\ingroup ECOL
**/
dvar_vector logistic(const dvector& x, const dvar_vector& a, const dvar_vector& b)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_div(exp(a+elem_prod(b,x)), 1.0+exp(a+elem_prod(b,x)));
RETURN_ARRAYS_DECREMENT();
return (y);
}
void model_parameters::userfunction(void)
{
obj_fun =0.0;
int Gtype, L;
FMpar = mfexp(logFM); // estimated F/M
SL50 = mfexp(logSL50);
Delta = mfexp(logDelta);
Vul = 1.0/(1+mfexp(-log(19)*(LenBins-SL50)/Delta));
MkL = Mk * pow(Linf/LenBins, Mpow);
FkL = FMpar * Mk * Vul;
for (Gtype=1;Gtype<=NGTG;Gtype++) {
MKLMat(Gtype) = MkL + kslope*(DiffLinfs(Gtype) - Linf);
ZKLMat(Gtype) = MKLMat(Gtype) + FkL;
currMkL = MKLMat(Gtype);
currZkL = ZKLMat(Gtype);
PUnFished = 0;
PFished = 0;
NUnFished = 0;
NFished = 0 ;
PUnFished(1) = RecProbs(Gtype);
PFished(1) = RecProbs(Gtype);
GTGLinf = DiffLinfs(Gtype);
for (L=2;L<=NLenMids+1;L++) {
if (LenBins(L) < GTGLinf) {
PUnFished(L) = PUnFished(L-1) * pow(((GTGLinf-LenBins(L))/(GTGLinf-LenBins(L-1))),currMkL(L-1));
PFished(L) = PFished(L-1) * pow(((GTGLinf-LenBins(L))/(GTGLinf-LenBins(L-1))),currZkL(L-1));
}
if (LenBins(L) >= GTGLinf) {
PUnFished(L) = 0;
PFished(L) = 0;
}
}
for (L=1;L<=NLenMids;L++) {
NUnFished(L) = (PUnFished(L) - PUnFished(L+1))/currMkL(L);
NFished(L) = (PFished(L) - PFished(L+1))/currZkL(L);
}
UnfishedMatrix(Gtype) = NUnFished;
FishedMatrix(Gtype) = NFished;
EP0_gtg(Gtype) = sum(elem_prod(NUnFished, Fec));
EPf_gtg(Gtype) = sum(elem_prod(NFished, Fec));
}
EP0 = sum(EP0_gtg);
EPf = sum(EPf_gtg);
SPR = EPf/EP0;
PredUnfishedComp = colsum(UnfishedMatrix);
PredUnfishedComp = PredUnfishedComp/sum(PredUnfishedComp);
// cout<<"hello"<<endl;
PredFishedComp = colsum(FishedMatrix);
PredFishedComp = PredFishedComp/sum(PredFishedComp);
PredLenComp = colsum(FishedMatrix);
PredLenComp = elem_prod(PredLenComp, 1.0/(1+mfexp(-log(19)*(LenMids-SL50)/Delta)));
PredLenComp = PredLenComp/sum(PredLenComp);
SL95 = SL50 + Delta;
obj_fun = -sum(elem_prod(ObsLength, log(elem_div(PredLenComp+0.00000001,ObsLength+0.00000001)))); // AP from ADMB living doc
}
void model_parameters::initialization(void)
{
NAreaAge.initialize();
CatchAreaAge.initialize();
CatchNatAge.initialize();
Nage(1,1) = So*Bo/(1+beta*Bo);
for(int i=sage+1 ; i <= nage ; i++)
{
Nage(1,i) = Nage(1,i-1) * mfexp(-za(i-1));
}
VulB(1) = elem_prod(elem_prod(Nage(1),va),wa);
SB(1) = elem_prod(Nage(1),fa)*wa/2;
tBo = Nage(1)*wa;
calcmaxpos(tBo);
varPos = maxPos*cvPos;
PosX(1) = minPos + (maxPos - minPos) * (0.5+0.5*sin(indmonth(1)*PI/6 - mo*PI/6));
VBarea(1,sarea) = VulB(1)* (cnorm(areas(sarea)+0.5,PosX(1),varPos));
for(int r=sarea+1 ; r <= narea-1 ; r++)
{
VBarea(1,r) = VulB(1)* (cnorm(areas(r)+0.5,PosX(1),varPos)-cnorm(areas(r)-0.5,PosX(1),varPos));
NAreaAge(1)(r) = elem_prod(Nage(1)(sage,nage),(cnorm(areas(r)+0.5,PosX(1),varPos)-cnorm(areas(r)-0.5,PosX(1),varPos)));
}
//VBarea(1,narea) = VulB(1)* (1.0-cnorm(areas(narea)-0.5,PosX(1),varPos));
NationVulB(1,1) = sum(VBarea(1)(sarea,sarea+nationareas(1)-1));
NationVulB(1,2) = sum(VBarea(1)(sarea+nationareas(1),narea));
dvar_vector tmp1(sarea,narea);
dvar_vector tmp2(sarea,narea);
dvar_vector tmp3(sarea,narea);
for(int rr= sarea; rr<=narea; rr++)
{
tmp1(rr)= VBarea(1)(rr)/ (NationVulB(1)(indnatarea(rr)) + 0.0001);
tmp2(rr) = tmp1(rr)*TotEffyear(indnatarea(rr))(indyr(1));
Effarea(1)(rr) = tmp2(rr)*TotEffmonth(indnatarea(rr))(indmonth(1));
}
for(int a= sage; a<= nage;a++)
{
dvar_vector propVBarea(sarea,narea);
for(int rr =sarea; rr<=narea; rr++)
{
propVBarea(rr) = (cnorm(areas(rr)+0.5,PosX(1),varPos)-cnorm(areas(rr)-0.5,PosX(1),varPos))(a-sage+1);
CatchAreaAge(1)(rr)(a) = q*Effarea(1)(rr)*va(a)/(q*Effarea(1)(rr)*va(a)+m)*(1-mfexp(-(q*Effarea(1)(rr)*va(a)+m)))*NAreaAge(1)(rr)(a);
CatchNatAge(1)(indnatarea(rr))(a) += CatchAreaAge(1)(rr)(a);
EffNatAge(indnatarea(rr))(1)(sage-2) = 1;
EffNatAge(indnatarea(rr))(1)(sage-1) = indnatarea(rr);
EffNatAge(indnatarea(rr))(1)(a) += Effarea(1)(rr)*propVBarea(rr);
}
//cout<<"propVBarea "<<propVBarea<<endl;
//cout<<"Effarea(1) "<<Effarea(1)<<endl;
Effage(1)(a) = Effarea(1)* propVBarea;
}
}
/** Shepherd function random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable vector in a random effects model
\param c ; differentiable vector in a random effects model
\return \f$ \frac{ax}{b+x^c} \f$
\ingroup ECOL
**/
df1b2vector Shepherd(const dvector& x, const df1b2vector& a, const df1b2vector& b, const df1b2vector& c)
{
df1b2vector y;
y=elem_prod(a, elem_div(x, (b+pow(x,c))));
return(y);
}
/** ecologically parameterized logistic function with carrying capacity K; random effects vectorized
\param t independent variable; data vector
\param K carrying capacity; differentiable vector in a random effects model
\param r growth rate; differentiable scalar in a random effects model
\param n0 initial population size at t=0; differentiable scalar in a random effects model
\return \f$ \frac{K}{1+(\frac{K}{n0}-1)e^{-rt}} \f$
\ingroup ECOL
**/
df1b2vector logisticK( const dvector& t, const df1b2vector& K, const df1b2variable& r, const df1b2variable& n0)
{
df1b2vector y;
y=elem_div(K, 1.0 + elem_prod(K/n0-1.0, exp(-r*t)));
return(y);
}
/** monomoleular function; random effects vectorized
\param x independent variable; data vector
\param a ; differentiable vector in a random effects model
\param b ; differentiable scalar in a random effects model
\return \f$ a(1-e^{-bx}) \f$
\ingroup ECOL
**/
df1b2vector monomolecular(const dvector& x, const df1b2vector& a, const df1b2variable& b)
{
df1b2vector y;
y=elem_prod(a, 1.0-exp(-b*x));
return(y);
}
double eff_N(const dvector& pobs, const dvar_vector& phat)
{
pobs += 0.0001;
phat += 0.0001;
dvar_vector rtmp = elem_div((pobs-phat),sqrt(elem_prod(phat,(1-phat))));
double vtmp;
vtmp = value(norm2(rtmp)/size_count(rtmp));
return 1./vtmp;
}
/** Shepherd function vectorized
\param x independent variable; data vector
\param a ; differentiable vector
\param b ; differentiable vector
\param c ; differentiable scalar
\return \f$ \frac{ax}{b+x^c} \f$
\ingroup ECOL
**/
dvar_vector Shepherd(const dvector& x, const dvar_vector& a, const dvar_vector& b, const prevariable& c)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=elem_prod(a, elem_div(x, (b+pow(x,c))));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/** ecologically parameterized logistic function with carrying capacity K; vectorized
\param t independent variable; data vector
\param K carrying capacity; differentiable scalar
\param r growth rate; differentiable scalar
\param n0 initial population size at t=0; differentiable vector
\return \f$ \frac{K}{1+(\frac{K}{n0}-1)e^{-rt}} \f$
\ingroup ECOL
**/
dvar_vector logisticK( const dvector& t, const prevariable& K, const prevariable& r, const dvar_vector& n0)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=K/(1.0+elem_prod((K/n0-1.0), exp(-r*t)));
RETURN_ARRAYS_DECREMENT();
return (y);
}
/**
* Gauss-Hermite quadature.
* this is normlaized so that standard normal density
* integrates to 1
* \param _x array of abscissa
* \param _w array of corresponding wights
*/
void normalized_gauss_hermite(const dvector& _x, const dvector& _w)
{
dvector& x=(dvector&) _x;
dvector& w=(dvector&) _w;
gauss_hermite(x,w);
w=elem_prod(w,exp(square(x)));
x*=sqrt(2.0);
w*=sqrt(2.0);
}
/** generalized Ricker function, first parameerization; vectorized
\param x independent variable; data vector
\param x0 ; differentiable scalar
\param A ; differentiable scalar
\param alpha ; differentiable scalar
\return \f$ A(\frac{x}{x0}e^{(1.0-\frac{x}{x0})})^{\alpha} \f$
\ingroup ECOL
**/
dvar_vector generalized_Ricker1(const dvector& x, const prevariable& x0, const prevariable& A, const prevariable& alpha)
{
RETURN_ARRAYS_INCREMENT();
dvar_vector y;
y=A*pow(elem_prod(x/x0, exp(1.0-x/x0)), alpha);
RETURN_ARRAYS_DECREMENT();
return (y);
}
dvector norm_res(const dvector& pred, const dvector& obs, double m)
{
RETURN_ARRAYS_INCREMENT();
pred += 0.0001;
obs += 0.0001;
dvector nr(1,size_count(obs));
nr = elem_div(obs-pred,sqrt(elem_prod(pred,(1.-pred))/m));
RETURN_ARRAYS_DECREMENT();
return nr;
}
dvariable dstudent_t( const dvar_vector& residual, const dvar_vector& df)
{
RETURN_ARRAYS_INCREMENT();
double pi = 3.141593;
dvar_vector t1 = 0.5*(df+1);
dvar_vector t2 = gammln(t1);
dvar_vector t3 = 0.5*log(df*pi)+gammln(0.5*df);
dvar_vector t4 = elem_prod(t1,log(1+elem_div(square(residual),df)));
dvariable pdf = sum(t3+t4-t2);
RETURN_ARRAYS_DECREMENT();
return( pdf );
}
void model_parameters::preliminary_calculations(void)
{
admaster_slave_variable_interface(*this);
int X;
double pi = 3.14159265358979323844;
MatDelta = L95 - L50;
Mat = 1.0/(1+mfexp(-log(19)*(LenMids-L50)/MatDelta));
Fec = elem_prod(Mat, pow(LenMids, FecB));
Fec = Fec/max(Fec);
SDLinf = CVLinf * Linf;
LinfdL = ((Linf + MaxSD * SDLinf) - (Linf - MaxSD * SDLinf))/(NGTG-1);
for (X=0;X<NGTG;X++) {
DiffLinfs(X+1) = (Linf - MaxSD * SDLinf) + X * LinfdL;
}
RecProbs = 1/(sqrt(2*pi*SDLinf*SDLinf)) * mfexp(-(elem_prod((DiffLinfs-Linf),(DiffLinfs-Linf)))/(2*SDLinf*SDLinf));
RecProbs = RecProbs/sum(RecProbs);
cout << "damnit" << endl;
}
void initial_params::xinit1(const dvector& _x, const dvector& g)
{
int ii=1;
dvector& x=(dvector&) _x;
for (int i=0;i<num_initial_params;i++)
{
//if ((varsptr[i])->phase_start <= current_phase)
if (withinbound(0,(varsptr[i])->phase_start,current_phase))
{
(varsptr[i])->set_value_inv(x,ii);
(varsptr[i])->set_active_flag();
}
}
x=elem_prod(x,g);
}
/**
* Description not yet available.
* \param
*/
dmatrix elem_prod(const dmatrix& m, const dmatrix& m2)
{
ivector cmin(m.rowmin(),m.rowmax());
ivector cmax(m.rowmin(),m.rowmax());
int i;
for (i=m.rowmin();i<=m.rowmax();i++)
{
cmin(i)=m(i).indexmin();
cmax(i)=m(i).indexmax();
}
dmatrix tmp(m.rowmin(),m.rowmax(),cmin,cmax);
for (i=m.rowmin();i<=m.rowmax();i++)
{
tmp(i)=elem_prod(m(i),m2(i));
}
return tmp;
}
dvariable mult_likelihood(const dmatrix &o, const dvar_matrix &p, dvar_matrix &nu,
const dvariable &log_vn)
{
// kludge to ensure observed and predicted matrixes are the same size
if(o.colsize()!=p.colsize() || o.rowsize()!=p.rowsize())
{
cerr<<"Error in multivariate_t_likelihood, observed and predicted matrixes"
" are not the same size\n";
ad_exit(1);
}
dvariable vn = mfexp(log_vn);
dvariable ff = 0.0;
int r1 = o.rowmin();
int r2 = o.rowmax();
int c1 = o.colmin();
int c2 = o.colmax();
for(int i = r1; i <= r2; i++ )
{
dvar_vector sobs = vn * o(i)/sum(o(i)); //scale observed numbers by effective sample size.
ff -= gammln(vn);
for(int j = c1; j <= c2; j++ )
{
if( value(sobs(j)) > 0.0 )
ff += gammln(sobs(j));
}
ff -= sobs * log(TINY + p(i));
dvar_vector o1=o(i)/sum(o(i));
dvar_vector p1=p(i)/sum(p(i));
nu(i) = elem_div(o1-p1,sqrt(elem_prod(p1,1.-p1)/vn));
}
// exit(1);
return ff;
}
