/**
Allocate variable vector of matrices with dimensions
[sl to sh] x ([nrl to nrh] x [ncl to nch])
where nch is a vector of indexes.
\param sl lower index of vector
\param sh upper index of vector
\param nrl lower row index for matrix
\param nrh upper row index for matrix
\param ncl lower column index for matrix
\param nch upper column index for matrix
*/
void dvar3_array::allocate(int sl,int sh,int nrl,int nrh,int ncl,int nch)
{
if (sh < sl)
{
allocate();
return;
}
#ifdef DIAG
myheapcheck("Entering dvar3_array matrix(sl,sh,nrl,nrh,ncl,nch)" );
#endif
if ((shape = new three_array_shape(sl, sh)) == 0)
{
cerr << " Error allocating memory in dvar3_array contructor" << endl;
}
if ((t = new dvar_matrix[slicesize()]) == 0)
{
cerr << " Error allocating memory in dvar3_array contructor" << endl;
ad_exit(21);
}
t -= slicemin();
for (int i = sl; i <= sh; ++i)
{
t[i].allocate(nrl, nrh, ncl, nch);
}
}
/** Negative bionomial density; variable objects.
A local parameter r is used to make it robust.
\f$ r=\frac{\mu}{10.0^{-120}+\tau-1.0} \f$
\ingroup PDF
\param x
\param mu
\param tau
\return Log of NegativeBinomial density. \f$ \frac{\Gamma(x+r)}{\Gamma(r)x!}(\frac{r}{r+\mu})^r(\frac{\mu}{r+\mu})^x \f$
*/
dvariable negbinomial_density(double x,const prevariable& mu,
const prevariable& tau)
{
if (value(tau)-1.0<=0.0)
{
cerr << "tau <=1 in log_negbinomial_density " << endl;
ad_exit(1);
}
RETURN_ARRAYS_INCREMENT();
dvariable r=mu/(1.e-120+(tau-1));
dvariable tmp;
//tmp=exp(gammln(x+r)-gammln(r) -gammln(x+1)
// +r*log(r)+x*log(mu)-(r+x)*log(r+mu));
tmp=gammln(x+r);
tmp-=gammln(r);
tmp-=gammln(x+1);
tmp+=r*log(r);
tmp+=x*log(mu);
tmp-=(r+x)*log(r+mu);
tmp=exp(tmp);
RETURN_ARRAYS_DECREMENT();
return tmp;
}
/**
* Description not yet available.
* \param
*/
void * ts_vector_shapex::operator new(size_t n)
{
if (xpool==0)
{
pthread_mutex_lock(&mutex_dfpool);
if (xpool==0)
{
xpool = new pts_vector_shape_pool[max_number_threads];
for (int i=0;i<max_number_threads;i++)
{
xpool[i]=0;
}
pthread_mutex_unlock(&mutex_dfpool);
}
}
int pnum=get_pthread_number();
if (xpool[pnum]==0)
{
xpool[pnum]=new ts_vector_shape_pool(sizeof(ts_vector_shapex));
}
# if defined(SAFE_ALL)
if (n != xpool[pnum]->size)
{
cerr << "incorrect size requested in dfpool" << endl;
ad_exit(1);
}
# endif
return xpool[pnum]->alloc();
}
/**
Return reference to the dmatrix element at d3_array(i).
\param i index
*/
const dmatrix& d3_array::operator[](int i) const
{
if (i < slicemin())
{
cerr << "matrix bound exceeded -- row index too low in "
<< "d3_array::operator[]" << "value was" << i;
ad_exit(1);
}
if (i > slicemax())
{
cerr << "matrix bound exceeded -- row index too high in "
<< "d3_array::operator[]" << "value was" << i;
ad_exit(1);
}
return t[i];
}
/**
* Description not yet available.
* \param
*/
dvector solve_trans(const lower_triangular_dmatrix& M,const dvector& y)
{
int mmin=M.indexmin();
int mmax=M.indexmax();
if (y.indexmin() !=mmin || y.indexmax() !=mmax)
{
cerr << "incompatible size in solve_trans" << endl;
ad_exit(1);
}
dvector x(mmin,mmax);
int i,j;
for (i=mmax;i>=mmin;i--)
{
double sum=0.0;
for (j=i+1;j<=mmax;j++)
{
sum+=M(j,i)*x(j);
}
x(i)=(y(i)-sum)/M(i,i);
}
return x;
}
/**
* Description not yet available.
* \param
*/
ivector& ivector::operator=(const ivector& t)
{
// disconnect ivector pointer from old array
if (::allocated(*this))
{
if (v != t.v)
{
if (indexmin() != t.indexmin() || indexmax() != t.indexmax())
{
cerr << " Array sizes do not match in ivector operator"
" =(const ivector&)" << endl;
ad_exit(1);
}
for ( int i=indexmin(); i<=indexmax(); i++)
{
elem(i) = t.elem(i);
}
}
}
else
{
shallow_copy(t);
}
return (*this);
}
/**
* Description not yet available.
* \param
*/
void arr_remove(arr_link ** pptr)
{
arr_link * tmp = *pptr;
// This routine removes the link pointed to by tmp
if (tmp->next) // Make the one after it point to tmp->prev
{
tmp->next->prev = tmp->prev;
}
if (tmp->prev) // Make the one before it point to tmp->next
{
tmp->prev->next = tmp->next;
}
if (tmp == NULL)
{
cout <<" Error -- tried to delete NULL arr_link in arr_remove\n";
ad_exit(23);
}
else
{
#ifdef DIAG
#ifdef __ZTC__
cout <<"Deleting an arr_link with adress "<<_farptr_tolong(tmp)<<"\n";
#else
cout <<"Deleting an arr_link with adress "<<farptr_tolong(tmp)<<"\n";
#endif
#endif
delete tmp;
tmp=NULL;
}
gradient_structure::ARR_LIST1->number_arr_links -= 1;
//cout << "after delete number_arr_links = "
//<< gradient_structure::ARR_LIST1->number_arr_links <<"\n";
}
/**
* Description not yet available.
* \param
*/
void dvar6_array::allocate(const ad_integer& hsl,const ad_integer& hsu,
const index_type& sl,const index_type& sh,const index_type& nrl,
const index_type& nrh,const index_type& ncl,const index_type& nch,
const index_type& l5,const index_type& u5,
const index_type& l6,const index_type& u6)
{
if ( (shape=new vector_shape (hsl,hsu)) == 0)
{
cerr << " Error allocating memory in dvar5_array contructor\n";
}
int ss=size();
if ( (t = new dvar5_array[ss]) == 0)
{
cerr << " Error allocating memory in dvar5_array contructor\n";
ad_exit(21);
}
t -= indexmin();
int il=hsl;
int iu=hsu;
for (int i=il; i<=iu; i++)
{
t[i].allocate(ad_integer(sl(i)),ad_integer(sh(i)),nrl(i),nrh(i),
ncl(i),nch(i),l5(i),u5(i),l6(i),u6(i));
}
}
/**
* Description not yet available.
* \param
*/
void fixed_smartlist2::write_buffer_one_less(void)
{
int _nbytes=adptr_diff(bptr,buffer);
if (_nbytes > 0)
{
unsigned int nbytes = (unsigned int)_nbytes;
written_flag=1;
// get the current file position
off_t pos=lseek(fp,0L,SEEK_CUR);
// write the size of the next record into the file
ssize_t ret = ::write(fp,&nbytes,sizeof(unsigned int));
assert(ret != -1);
// write the record into the file
ssize_t nw = ::write(fp,buffer,nbytes);
if (nw < _nbytes)
{
cerr << "Error writing to file " << filename << endl;
ad_exit(1);
}
// reset the pointer to the beginning of the buffer
bptr=buffer;
// now write the previous file position into the file so we can back up
// when we want to.
ret = ::write(fp,&pos,sizeof(off_t));
assert(ret != -1);
endof_file_ptr=lseek(fp,0L,SEEK_CUR);
//cout << lseek(fp,0L,SEEK_CUR) << endl;
}
}
void param_init_bounded_number_matrix::allocate(int rowmin, int rowmax,
int colmin, int colmax,
const dmatrix& bmin, const dmatrix& bmax,
const imatrix& phase_start,
const char* s)
{
#ifndef OPT_LIB
assert(v == NULL);
#endif
int size = rowmax - rowmin + 1;
if (size > 0)
{
index_min = rowmin;
index_max = rowmax;
v = new param_init_bounded_number_vector[size];
if (!v)
{
cerr << " error trying to allocate memory in "
"param_init_bounded_number_vector " << endl;
ad_exit(1);
}
v -= index_min;
for (int i = index_min; i <= index_max; i++)
{
/*if (it) v[i].set_initial_value(it[i]);*/
adstring a = s + adstring("[") + str(i) + adstring("]");
v[i].allocate(colmin, colmax, bmin[i], bmax[i], phase_start[i],
(char*)(a));
}
}
}
/**
* Description not yet available.
* \param
*/
void fixed_smartlist2::allocate(const size_t _bufsize,
const adstring& _filename)
{
nentries=_bufsize/sizeof(int);
end_saved=0;
eof_flag=0;
noreadflag=0;
written_flag=0;
direction=0;
bufsize=_bufsize;
filename=_filename;
AD_ALLOCATE(true_buffer,int,nentries+2,df1b2_gradlist)
true_buffend=true_buffer+nentries+1;
buffer=true_buffer+1;
buffend=true_buffend-1;
bptr=buffer;
fp=open((char*)(filename), O_RDWR | O_CREAT | O_TRUNC |
O_BINARY, S_IREAD | S_IWRITE);
if (fp == -1)
{
cerr << "Error trying to open file " << filename
<< " in class fixed_smartlist2 " << endl;
ad_exit(1);
}
/*off_t pos=*/lseek(fp,0L,SEEK_CUR);
}
/**
* Description not yet available.
* \param
*/
dmatrix& dmatrix::operator=(const dmatrix& m1)
{
if (allocated(*this))
{
if (rowmin() != m1.rowmin() || rowmax() != m1.rowmax() ||
colmin() != m1.colmin() || colmax() != m1.colmax() )
{
cerr << " Incompatible array bounds in "
"dmatrix& operator = (const dmatrix&)\n";
ad_exit(21);
}
if (m != m1.m) // check for condition that both matrices
{ // point to the same object
for (int i=rowmin();i<=rowmax();i++)
{
*(m+i) = m1[i];
}
}
}
else
{
index_min=m1.index_min;
index_max=m1.index_max;
shape=m1.shape;
if (shape)
{
(shape->ncopies)++;
}
m = m1.m;
}
return(*this);
}
/**
\todo Need Test case
*/
void fixed_smartlist2::rewind(void)
{
bptr=buffer;
eof_flag=0;
if (written_flag)
{
lseek(fp,0L,SEEK_SET);
// get the record size
unsigned int nbytes = 0;
ssize_t ret = ::read(fp,&nbytes,sizeof(unsigned int));
assert(ret != -1);
if (nbytes > bufsize)
{
cerr << "Error -- record size in file seems to be larger than"
" the buffer it was created from " << endl
<< " buffer size is " << bufsize << " record size is supposedly "
<< nbytes << endl;
ad_exit(1);
}
// now read the record into the buffer
ret = ::read(fp,buffer,nbytes);
assert(ret != -1);
//cout << "Number of bytes read " << nr << endl;
// skip over file postion entry in file
// so we are ready to read second record
lseek(fp,(off_t)sizeof(off_t),SEEK_CUR);
}
}
/**
* Description not yet available.
* \param
*/
dmatrix choleski_decomp_neghess_error(const dmatrix& MM, int& ierror)
{
ierror=0;
// kludge to deal with constantness
dmatrix & M= * (dmatrix *) &MM;
if (M.colsize() != M.rowsize())
{
cerr << "Error in chol_decomp. Matrix not square" << endl;
ad_exit(1);
}
int rowsave=M.rowmin();
int colsave=M.colmin();
M.rowshift(1);
M.colshift(1);
int n=M.rowmax();
dmatrix L(1,n,1,n);
#ifndef SAFE_INITIALIZE
L.initialize();
#endif
int i,j,k;
double tmp;
if (M(1,1)>=0)
{
return onerror(L,ierror);
}
L(1,1)=sqrt(-M(1,1));
for (i=2;i<=n;i++)
{
L(i,1)=-M(i,1)/L(1,1);
}
for (i=2;i<=n;i++)
{
for (j=2;j<=i-1;j++)
{
tmp=-M(i,j);
for (k=1;k<=j-1;k++)
{
tmp-=L(i,k)*L(j,k);
}
L(i,j)=tmp/L(j,j);
}
tmp=-M(i,i);
for (k=1;k<=i-1;k++)
{
tmp-=L(i,k)*L(i,k);
}
if (tmp<=0)
{
return onerror(L,ierror);
}
L(i,i)=sqrt(tmp);
}
L.rowshift(rowsave);
L.colshift(colsave);
return L;
}
/**
Return reference to the dvector element at d3_array(i, j).
\param i index
\param j index
*/
const dvector& d3_array::operator()(int i, int j) const
{
if (i < slicemin())
{
cerr << "array bound exceeded -- slice index too low in "
<< "d3_array::operator(int, int)";
ad_exit(1);
}
if (i > slicemax())
{
cerr << "array bound exceeded -- slice index too high in "
<< "d3_array::operator(int, int)";
ad_exit(1);
}
return elem(i)(j);
}
/**
* Description not yet available.
* \param
*/
const ivector& i3_array::operator()(int k, int i) const
{
if (k<slicemin())
{
cerr << "array bound exceeded -- slice index too low in "
"i3_array::operator(int,int)";
ad_exit(1);
}
if (k>slicemax())
{
cerr << "array bound exceeded -- slice index too high in "
"i3_array::operator(int,int)";
ad_exit(1);
}
return ( (elem(k))(i) );
}
void function_minimizer::hess_routine(void)
{
if (random_effects_flag && lapprox !=0 )
{
hess_routine_random_effects();
}
else
{
#if defined(USE_ADPVM)
if (!ad_comm::pvm_manager)
{
hess_routine_noparallel();
}
else
{
switch (ad_comm::pvm_manager->mode)
{
case 1: // master
hess_routine_master();
break;
case 2: // slave
hess_routine_slave();
break;
default:
cerr << "Error: Illegal value for pvm_manager->mode." << endl;
ad_exit(1);
}
cout << "finished hess routine" << endl;
}
#else
hess_routine_noparallel();
#endif
}
}
/**
Allocate matrix on integers with dimension [nrl to nrh] x [ncl to nch].
\param nrl lower row matrix index
\param nrh upper row matrix index
\param ncl lower column matrix index
\param nch upper column matrix index
*/
void imatrix::allocate(
const ad_integer& nrl, const ad_integer& nrh,
const index_type& ncl, const index_type& nch)
{
if (nrl > nrh)
{
allocate();
}
else
{
index_min = nrl;
index_max = nrh;
if ((ncl.isinteger() && (nrl != ncl.indexmin() || nrh != ncl.indexmax()))
|| (nch.isinteger() && (nrl != nch.indexmin() || nrh != nch.indexmax())))
{
cerr << "Incompatible imatrix bounds in " << __FILE__ << ':' << __LINE__ << ".\n";
if(nrh==0)
{
// Some models use 0 for columns to "turn off" a parameter, so we
// don't want to exit in this case, just throw error.
cerr << "0 columns - was this intentional?\n" ;
}
else
{
ad_exit(1);
}
}
unsigned int ss = static_cast<unsigned int>(nrh - nrl + 1);
if ((m = new ivector[ss]) == 0)
{
cerr << " Error: imatrix unable to allocate memory in "
<< __FILE__ << ':' << __LINE__ << '\n';
ad_exit(1);
}
if ((shape = new mat_shapex(m)) == 0)
{
cerr << " Error: imatrix unable to allocate memory in "
<< __FILE__ << ':' << __LINE__ << '\n';
ad_exit(1);
}
m -= int(nrl);
for (int i = nrl; i <= nrh; ++i)
{
m[i].allocate(ncl(i), nch(i));
}
}
}
dvar_matrix function_minimizer::user_d2frandeff(const dvar_vector& x)
{
cout << "You must define the function user_d2frandeff in your TPL"
" file to use the random effects optimization" << endl;
ad_exit(1);
dvar_matrix u;
return u;
}
/**
Allocate memory for link*.
*/
void* adpool::alloc(void)
{
if (!head)
{
grow();
}
link* p = head;
#if defined(__CHECK_MEMORY__)
if(bad(p))
{
cerr << "Error in adpool structure" << endl;
ad_exit(1);
}
if (p->next)
{
if(bad(p->next))
{
cerr << "Error in adpool structure" << endl;
ad_exit(1);
}
}
#endif
head = p->next;
num_allocated++;
#if defined(__CHECK_MEMORY__)
if (p == pchecker)
{
cout << "trying to allocate already allocated object " << endl;
}
#endif
#ifndef OPT_LIB
assert(nvar <= SHRT_MAX);
#endif
((twointsandptr*)p)->nvar=(short)nvar;
((twointsandptr*)p)->ptr=this;
#if defined (INCLUDE_BLOCKSIZE)
((twointsandptr*)p)->blocksize=size;
#endif
return p;
}
void df1_one_vector::allocate(int min,int max)
{
index_min=min;
index_max=max;
v=new df1_one_variable[max-min+1];
if (v==0)
{
cerr << "error allocating memory in df1_one_vector" << endl;
ad_exit(1);
}
if ( (shape=new vector_shapex(min,max,v)) == NULL)
{
cerr << "Error trying to allocate memory for df1_one_vector"
<< endl;;
ad_exit(1);
}
v-=min;
}
/**
* Description not yet available.
* \param
*/
const double& d5_array::operator()(int i, int j, int k, int l, int m) const
{
if (i<indexmin()||i>indexmax())
{ cerr << "Error hslice index out of bounds in\n"
"dvector& d5_array::operator ( )" << endl;
ad_exit(1);
}
return elem(i)(j,k,l,m);
}
/**
* Description not yet available.
* \param
*/
const dmatrix& d5_array::operator()(int i, int j, int k) const
{
if (i<indexmin()||i>indexmax())
{ cerr << "Error index out of bounds in\n"
"d3_array& d5_array::operator ( )" << endl;
ad_exit(1);
}
return elem(i)(j,k);
}
/**
* Set the the maximum amount of memory (in bytes) available for
* the autodif variable type container class objects
* \param i value in bytes
*/
void gradient_structure::set_ARRAY_MEMBLOCK_SIZE(unsigned long i)
{
cerr << " This is not the way to set the ARRAY_MEMBLOCK_SIZE -- sorry\n"
" You set it by declaring the number of bytes you want in the\n";
cerr << " declaration gradient_structure gs(num_bytes)\n"
" in your program .. the default value is 100000L\n";
ad_exit(1);
check_set_error("ARRAY_MEMBLOCK_SIZE");
}
/**
* Produce error if gradient structure hasn't been set
* \param variable_name string with variable name
*/
void gradient_structure::check_set_error(const char* variable_name)
{
if (instances > 0)
{
cerr << "Error -- variable '" << variable_name <<"' must be set before\n"
"declaration of gradient_structure object.\n";
ad_exit(1);
}
}
/**
Determine if the lower and upper bounds of two evctors match in a specified
function.
\param v1 a data vector
\param v2 a data vector
\param function_nam a pointer to the name of the function in question.
*/
void shape_check(const dvector& v1, const dvector& v2,
const char *function_name)
{
if (v1.indexmin() != v2.indexmin() || v1.indexmax() != v2.indexmax())
{
cerr << " Vector sizes do no match in" << function_name << "\n";
ad_exit(1);
}
}
/**
* Description not yet available.
* \param
*/
const dvar_matrix& dvar3_array::operator()(int i) const
{
if (i<slicemin())
{
cerr << "matrix bound exceeded -- row index too low in "
"3d_array::operator[]"
<< "value was" << i;
ad_exit(21);
}
if (i>slicemax())
{
cerr << "matrix bound exceeded -- row index too high in "
"3d_array::operator[]"
<< "value was" << i;
ad_exit(22);
}
return( t[i]);
}
/**
* Description not yet available.
* \param
*/
const dvar_matrix& dvar6_array::operator()(int i, int j, int k, int l) const
{
if (i<indexmin()||i>indexmax())
{ cerr << "Error hslice index out of bounds in\n"
"dvar-vector& dvar4_array::operator ( )" << endl;
ad_exit(1);
}
return elem(i)(j,k,l);
}
/**
* Description not yet available.
* \param
*/
const dvar5_array& dvar6_array::operator[](int i) const
{
if (i<indexmin()||i>indexmax())
{ cerr << "Error index out of bounds in\n"
"dvar5_array& dvar6_array::operator []" << endl;
ad_exit(1);
}
return t[i];
}
/**
* Description not yet available.
* \param
*/
void df1b2variable::increment_adpool_counter(void)
{
adpool_counter++;
if (adpool_counter> _FIVE_ -2)
{
cerr << "need to increase adpool_counter" << endl;
ad_exit(1);
}
}
