Auto-detect if tape use atomic functions when calculating hessian.

- Only form models without random effects.
kaskr · Mar 13, 2015 · d83a59a · d83a59a
1 parent d8bd9b2
commit d83a59a
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 1 deletion.
diff --git a/TMB/R/TMB.R b/TMB/R/TMB.R
@@ -330,6 +330,9 @@ MakeADFun <- function(data,parameters,map=list(),
   }
 
   retape()
+
+  ## Has atomic functions been generated for the tapes ?
+  usingAtomics <- function().Call("usingAtomics", PACKAGE=DLL)
 
   f <- function(theta=par,order=0,type=c("ADdouble","double","ADGrad"),
                 cols=NULL,rows=NULL,
@@ -673,7 +676,7 @@ MakeADFun <- function(data,parameters,map=list(),
                   if(tracemgc)cat("outer mgc: ",max(abs(ans)),"\n")
                   ans
                 },
-                he=function(x=last.par,atomic=TRUE){
+                he=function(x=last.par,atomic=usingAtomics()){
                     ## If no atomics on tape we have all orders implemented:
                     if(!atomic) return( f(x,order=2) )
                     ## Otherwise, get Hessian as 1st order derivative of gradient:

diff --git a/TMB/inst/include/atomic_macro.hpp b/TMB/inst/include/atomic_macro.hpp
@@ -6,6 +6,9 @@
 #define CSKIP(x) x
 #endif
 
+/* Flag to detect if any atomic functions have been created */
+bool atomicFunctionGenerated = false;
+
 /** \brief Construct atomic vector function based on known derivatives */
 #define TMB_ATOMIC_VECTOR_FUNCTION(ATOMIC_NAME,OUTPUT_DIM,ATOMIC_DOUBLE,ATOMIC_REVERSE) \
 CppAD::vector<double> ATOMIC_NAME(CppAD::vector<double> tx)CSKIP({	\
@@ -19,6 +22,7 @@ template <class Type>							\
 class atomic##ATOMIC_NAME : public CppAD::atomic_base<Type> {		\
 public:									\
   atomic##ATOMIC_NAME(const char* name) : CppAD::atomic_base<Type>(name){ \
+    atomicFunctionGenerated = true;					\
     std::cout << "Constructing atomic " << #ATOMIC_NAME << "\n" ;	\
     this->option(CppAD::atomic_base<Type>::bool_sparsity_enum);		\
   }									\

diff --git a/TMB/inst/include/tmb_core.hpp b/TMB/inst/include/tmb_core.hpp
@@ -1313,6 +1313,17 @@ extern "C"
 #endif
 }
 
+extern "C"
+{
+  SEXP usingAtomics(){
+    SEXP ans;
+    PROTECT(ans = allocVector(INTSXP,1));
+    INTEGER(ans)[0] = atomic::atomicFunctionGenerated;
+    UNPROTECT(1);
+    return ans;
+  }
+}
+
 #endif /* #ifndef WITH_LIBTMB */
 
 
@@ -1333,6 +1344,7 @@ extern "C"
   SEXP getParameterOrder(SEXP data, SEXP parameters, SEXP report);
   SEXP MakeADGradObject(SEXP data, SEXP parameters, SEXP report);
   SEXP MakeADHessObject2(SEXP data, SEXP parameters, SEXP report, SEXP skip);
+  SEXP usingAtomics();
 }
 
 #endif /* #ifdef WITH_LIBTMB */