New linkage

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: n1qn1
 Title: Port of the 'Scilab' 'n1qn1' Module for Unconstrained BFGS Optimization
-Version: 6.0.1-11
+Version: 6.0.1-12
 Authors@R: c(person("Matthew", "Fidler", role=c("aut","cre"), email= "[email protected]"),
         person("Wenping", "Wang", role = "aut", email = "[email protected]"),
         person("Claude","Lemarechal", role=c("aut","ctb")),
@@ -17,7 +17,7 @@ Authors@R: c(person("Matthew", "Fidler", role=c("aut","cre"), email= "matthew.fi
 Maintainer: Matthew Fidler <[email protected]>
 Description: Provides 'Scilab' 'n1qn1'. This takes more memory than traditional L-BFGS.  The n1qn1 routine is useful since it allows prespecification of a Hessian.
        If the Hessian is near enough the truth in optimization it can speed up the optimization problem. The algorithm is described in the
-       'Scilab' optimization documentation located at 
+       'Scilab' optimization documentation located at
        <https://www.scilab.org/sites/default/files/optimization_in_scilab.pdf>. This version uses manually modified code from 'f2c' to make this a C only binary.
 URL: https://github.com/nlmixr2/n1qn1c
 BugReports: https://github.com/nlmixr2/n1qn1c/issues
@@ -29,4 +29,4 @@ Biarch: true
 NeedsCompilation: yes
 LinkingTo: RcppArmadillo (>= 0.5.600.2.0), Rcpp (>= 0.12.3)
 Encoding: UTF-8
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(.n1qn1ptr)
 export(n1qn1)
 importFrom(Rcpp,evalCpp)
 useDynLib(n1qn1, .registration=TRUE)

NEWS.md

@@ -1,3 +1,8 @@
+# n1qn1 6.0.1-12
+
+* Add non binary (function pointer) interface/api so that `nlmixr2est`
+  will not have to be re submitted when changes to this package occur.
+
 # n1qn1 6.0.1-11
 
 * Added strict prototype fixes as requested by CRAN

R/n1qn1.R

@@ -1,3 +1,23 @@
+#' This gives the function pointers in the n1qn1 library
+#'
+#' Using this will allow C-level linking by function pointers instead
+#' of abi.
+#'
+#' @return list of pointers to the n1qn1 functions
+#'
+#' @export
+#'
+#' @author Matthew L. Fidler
+#'
+#' @examples
+#'
+#' .n1qn1ptr()
+#'
+.n1qn1ptr <- function() {
+  .Call(`_n1qn1_ptr`, PACKAGE = "n1qn1")
+}
+
+
 ##' n1qn1 optimization
 ##'
 ##' This is an R port of the n1qn1 optimization procedure in scilab.

inst/include/n1qn1c.h

@@ -0,0 +1,50 @@
+#ifndef __N1QN1C_H__
+#define __N1QN1C_H__
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+
+typedef int (*S_fp) (int *, int *, double *, double *, double *, int *, float *, double *, int *);
+typedef void (*S2_fp) (int *, int *, double *, double *, double *, int *, float *, double *, int *);
+typedef  int (*U_fp)(int *, int *, double *, double *, double *, int *, float *, double *, int *);
+
+
+typedef void (*n1qn1F_t)(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
+                         int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[],
+                         float rzs[], double dzs[]);
+extern n1qn1F_t n1qn1F;
+
+typedef void (*n1qn1F2_t)(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
+int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[],
+                     float rzs[], double dzs[]);
+extern n1qn1F2_t n1qn1F2;
+
+typedef void (*n1qn1__t)(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
+                           int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[],
+                           float rzs[], double dzs[], int id[]);
+extern n1qn1__t n1qn1_;
+
+static inline SEXP iniN1qn1cPtrs0(SEXP p) {
+  if (n1qn1F == NULL) {
+    n1qn1F = (n1qn1F_t) R_ExternalPtrAddrFn(VECTOR_ELT(p, 0));
+    n1qn1F2 = (n1qn1F2_t) R_ExternalPtrAddrFn(VECTOR_ELT(p, 1));
+    n1qn1_ = (n1qn1__t) R_ExternalPtrAddrFn(VECTOR_ELT(p, 2));
+  }
+}
+
+#define iniN1qn1c              \
+  n1qn1F_t n1qn1F = NULL;      \
+  n1qn1F2_t n1qn1F2 = NULL;    \
+  n1qn1__t n1qn1_ = NULL;      \
+  SEXP iniN1qn1cPtrs(SEXP p) { \
+    iniN1qn1cPtrs0(p);          \
+    return R_NilValue;          \
+  }
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif // __N1QN1C_H__

src/init.c

@@ -6,27 +6,65 @@
 #include "n1qn1.h"
 
 extern void n1qn1_(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
-		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[], 
+		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[],
 		   float rzs[], double dzs[], int id[]);
 void n1qn1F(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
-		   int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[], 
+		   int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[],
 		   float rzs[], double dzs[]) {
   int id = 0;
   n1qn1_(simul, n, x, f, g, var, eps, mode, niter, nsim, imp, zm, izs, rzs, dzs, &id);
 }
 
 void n1qn1F2(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
-		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[], 
+		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[],
 		   float rzs[], double dzs[]) {
   int id = 0;
   n1qn1_(simul, n, x, f, g, var, eps, mode, niter, nsim, imp, zm, izs, rzs, dzs, &id);
 }
 /* .C calls */
 extern SEXP n1qn1_wrap(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 
+SEXP _n1qn1_ptr(void) {
+  int pro = 0;  // Counter for the number of PROTECT calls
+
+  // Create an external pointer
+  SEXP n1qn1c_n1qn1F = PROTECT(R_MakeExternalPtrFn((DL_FUNC)&n1qn1F, R_NilValue, R_NilValue)); pro++;
+
+  SEXP n1qn1c_n1qn1F2 = PROTECT(R_MakeExternalPtrFn((DL_FUNC)&n1qn1F2, R_NilValue, R_NilValue)); pro++;
+
+  SEXP n1qn1c_n1qn1_ = PROTECT(R_MakeExternalPtrFn((DL_FUNC)&n1qn1_, R_NilValue, R_NilValue)); pro++;
+
+#define nVec 3
+
+  SEXP ret = PROTECT(Rf_allocVector(VECSXP, nVec)); pro++;
+  SEXP retN = PROTECT(Rf_allocVector(STRSXP, nVec)); pro++;
+
+  SET_VECTOR_ELT(ret, 0, n1qn1c_n1qn1F);
+  SET_STRING_ELT(retN, 0, Rf_mkChar("n1qn1F"));
+
+  SET_VECTOR_ELT(ret, 1, n1qn1c_n1qn1F2);
+  SET_STRING_ELT(retN, 1, Rf_mkChar("n1qn1F2"));
+
+  SET_VECTOR_ELT(ret, 2, n1qn1c_n1qn1_);
+  SET_STRING_ELT(retN, 2, Rf_mkChar("n1qn1_"));
+
+#undef nVec
+
+  // Set the names attribute of the list
+  Rf_setAttrib(ret, R_NamesSymbol, retN);
+
+  // Unprotect all protected objects
+  UNPROTECT(pro);
+
+  // Return the list of external pointers
+  return ret;
+
+}
+
 void R_init_n1qn1(DllInfo *dll)
 {
   R_CallMethodDef callMethods[]  = {
+    {"_n1qn1_ptr", (DL_FUNC) &_n1qn1_ptr, 0},
     {"n1qn1_wrap", (DL_FUNC) &n1qn1_wrap, 13},
     {NULL, NULL, 0}
   };
@@ -35,4 +73,4 @@ void R_init_n1qn1(DllInfo *dll)
   R_RegisterCCallable("n1qn1","n1qn1_", (DL_FUNC) &n1qn1_);
   R_registerRoutines(dll, NULL, callMethods, NULL, NULL);
   R_useDynamicSymbols(dll, FALSE);
-} 
+}