/************************************************************/
/*         Common header file for cplm functions            */
/*              Author:  Wayne Zhang                        */
/*            actuary_zhang@hotmail.com                     */
/************************************************************/

/**
 * @file common.h
 * @brief header files to be included in the cplm C functions
 * @author Wayne Zhang                         
*/

#ifndef CPLM_COMMON_H 
#define CPLM_COMMON_H 

/* common headers for R related definitions */
#include <R.h>
#include <Rinternals.h>
#include <Rmath.h>
#include <R_ext/Lapack.h>        /* for BLAS and Lapack related */
#include "Matrix.h"		 /* for cholmod functions and S4 structures (GET_SLOT)*/

/** zero an array */
#define AZERO(x, n) {int _I_, _SZ_ = (n); for(_I_ = 0; _I_ < _SZ_; _I_++) (x)[_I_] = 0;}

/* When appropriate, alloca is cleaner than malloc/free.  The storage
 * is freed automatically on return from a function. When using gcc the
 * builtin version is much faster. */
#ifdef __GNUC__
#undef alloca
#define alloca(x) __builtin_alloca((x))
#else
/* this is necessary (and sufficient) for Solaris 10: */
#ifdef __sun
#include <alloca.h>
#endif
#endif

/** alloca n elements of type t */
#define Alloca(n, t)   (t *) alloca( (size_t) ( (n) * sizeof(t) ) )

/** Allow for translation of error messages */
#ifdef ENABLE_NLS		
#include <libintl.h>
#define _(String) dgettext ("cplm", String)
#else
#define _(String) (String)
#endif


/**
 * Extract the slot named str from the object obj and return a null pointer
 * if the slot has length 0 or a pointer to the REAL contents.
 *
 * @param obj pointer to an S4 object
 * @param str pointer to a symbol naming the slot to extract
 *
 * @return pointer to the REAL contents, if nonzero length, otherwise
 * a NULL pointer
 *
 */
static R_INLINE double *SLOT_REAL_NULL(SEXP obj, char *str)
{
    SEXP pt = GET_SLOT(obj, install(str));
    return LENGTH(pt) ? REAL(pt) : (double*) NULL; 
}

/************************************************/
/*           Slots used in cpglmm               */  
/************************************************/

/** Return the double pointer to the X slot */
#define X_SLOT(x) SLOT_REAL_NULL(x, "X")

/** Return the double pointer to the y slot */
#define Y_SLOT(x) SLOT_REAL_NULL(x, "y")

/** Allocate (alloca) a cholmod_sparse struct, populate it with values
 * from the Zt slot and return the pointer. */
#define Zt_SLOT(x) AS_CHM_SP(GET_SLOT(x, install("Zt")))

/** Return the double pointer to the offset slot or (double*) NULL if
 * offset has length 0) */
#define OFFSET_SLOT(x) SLOT_REAL_NULL(x, "offset")

/** Return the double pointer to the pWt slot or (double*) NULL if
 * pWt has length 0) */
#define PWT_SLOT(x) SLOT_REAL_NULL(x, "pWt")

/** Return the integer pointer to the dims slot */
#define DIMS_SLOT(x) INTEGER(GET_SLOT(x, install("dims")))

/** Return the double pointer to the fixef slot */
#define FIXEF_SLOT(x) SLOT_REAL_NULL(x, "fixef")

/** Return the double pointer to the u slot */
#define U_SLOT(x) SLOT_REAL_NULL(x, "u")

/** Return the double pointer to the eta slot */
#define ETA_SLOT(x) SLOT_REAL_NULL(x, "eta")

/** Return the double pointer to the mu slot */
#define MU_SLOT(x) SLOT_REAL_NULL(x, "mu")

/** Return the double pointer to the muEta slot or (double*) NULL if
 * muEta has length 0) */
#define MUETA_SLOT(x) SLOT_REAL_NULL(x, "muEta")

/** Return the double pointer to the var slot or (double*) NULL if
 * var has length 0) */
#define VAR_SLOT(x) SLOT_REAL_NULL(x, "var")

/** Return the double pointer to the resid slot */
#define RESID_SLOT(x) SLOT_REAL_NULL(x, "resid")

/** Allocate (alloca) a cholmod_sparse struct, populate it with values
 * from the A slot and return the pointer. */
#define A_SLOT(x) AS_CHM_SP(GET_SLOT(x, install("A")))

/** Allocate (alloca) a cholmod_factor struct, populate it with values
 * from the L slot and return the pointer. */
#define L_SLOT(x) AS_CHM_FR(GET_SLOT(x, install("L")))

/** Return the integer pointer to the Gp slot */
#define Gp_SLOT(x) INTEGER(GET_SLOT(x, install("Gp")))

/** Return the double pointer to the Cx slot or (double*) NULL if
 * Cx has length 0) */
#define Cx_SLOT(x) SLOT_REAL_NULL(x, "Cx")

/** Return the double pointer to the deviance slot */
#define DEV_SLOT(x) SLOT_REAL_NULL(x, "deviance")

/** Return the double pointer to the sqrtrWt slot or (double*) NULL if
 *  sqrtrWt has length 0) */
#define SRWT_SLOT(x) SLOT_REAL_NULL(x, "sqrtrWt")

/** Return the double pointer to the sqrtXWt slot or (double*) NULL if
 *  sqrtXWt has length 0) */
#define SXWT_SLOT(x) SLOT_REAL_NULL(x, "sqrtXWt")

/** Return the double pointer to the p slot or (double*) NULL if
 *  sqrtXWt has length 0) */
#define P_SLOT(x) SLOT_REAL_NULL(x, "p")

/** Return the double pointer to the phi slot or (double*) NULL if
 *  sqrtXWt has length 0) */
#define PHI_SLOT(x) SLOT_REAL_NULL(x, "phi")

/** Return the double pointer to the link.power slot or (double*) NULL if
 *  sqrtXWt has length 0) */
#define LKP_SLOT(x) SLOT_REAL_NULL(x, "link.power")

/** Return the double pointer to the bound.p slot  */
#define BDP_SLOT(x) SLOT_REAL_NULL(x, "bound.p")

/** Return the integer pointer to the permutation vector in the L slot */
#define PERM_VEC(x) INTEGER(GET_SLOT(GET_SLOT(x, install("L")), install("perm")))

/** Return the double pointer to the ranef slot or (double*) NULL if
 *  ranef has length 0) */
#define RANEF_SLOT(x) SLOT_REAL_NULL(x, "ranef")

/** Return the double pointer to the ghw slot */
#define GHW_SLOT(x) SLOT_REAL_NULL(x, "ghw")

/** Return the double pointer to the ghx slot */
#define GHX_SLOT(x) SLOT_REAL_NULL(x, "ghx")

/************************************************/
/*       Additional slots used in bcplm         */  
/************************************************/

/** Return the integer pointer to the ygt0 slot or (double*) NULL if
 * pWt has length 0) */
#define YPO_SLOT(x) INTEGER(GET_SLOT(x, install("ygt0")))

/** Return the double pointer to the bound.phi slot  */
#define BDPHI_SLOT(x) SLOT_REAL_NULL(x, "bound.phi")

/** Return the double pointer to the pbeta.mean slot  */
#define PBM_SLOT(x) SLOT_REAL_NULL(x, "pbeta.mean")

/** Return the double pointer to the pbeta.var slot  */
#define PBV_SLOT(x) SLOT_REAL_NULL(x, "pbeta.var")

/** Return the double pointer to the mh.sd slot  */
#define MHSD_SLOT(x) SLOT_REAL_NULL(x, "mh.sd")

/** Return the integer pointer to the k slot */
#define K_SLOT(x) INTEGER(GET_SLOT(x, install("k")))

/** Return the double pointer to the cllik slot  */
#define CLLIK_SLOT(x) SLOT_REAL_NULL(x, "cllik")

/** Return the double pointer to the Xb slot  */
#define XB_SLOT(x) SLOT_REAL_NULL(x, "Xb")

/** Return the double pointer to the Zu slot  */
#define ZU_SLOT(x) SLOT_REAL_NULL(x, "Zu")

/** Return the integer pointer to the ncol slot */
#define NCOL_SLOT(x) INTEGER(GET_SLOT(x, install("ncol")))

/** Return the integer pointer to the nlev slot */
#define NLEV_SLOT(x) INTEGER(GET_SLOT(x, install("nlev")))

/** Return the double pointer to the accept slot  */
#define ACC_SLOT(x) SLOT_REAL_NULL(x, "accept")

#endif