Adjustments for CRAN upload
[valse.git] / pkg / src / a.EMGLLF.c
... / ...
CommitLineData
1#include <R.h>
2#include <Rdefines.h>
3#include "EMGLLF.h"
4
5// See comments in src/sources/EMGLLF.c and R/EMGLLF.R (wrapper)
6SEXP EMGLLF(
7 SEXP phiInit_,
8 SEXP rhoInit_,
9 SEXP piInit_,
10 SEXP gamInit_,
11 SEXP mini_,
12 SEXP maxi_,
13 SEXP gamma_,
14 SEXP lambda_,
15 SEXP X_,
16 SEXP Y_,
17 SEXP eps_
18) {
19 // Get matrices dimensions
20 int n = INTEGER(getAttrib(X_, R_DimSymbol))[0];
21 SEXP dim = getAttrib(phiInit_, R_DimSymbol);
22 int p = INTEGER(dim)[0];
23 int m = INTEGER(dim)[1];
24 int k = INTEGER(dim)[2];
25
26 ////////////
27 // INPUTS //
28 ////////////
29
30 // get scalar parameters
31 int mini = INTEGER_VALUE(mini_);
32 int maxi = INTEGER_VALUE(maxi_);
33 double gamma = NUMERIC_VALUE(gamma_);
34 double lambda = NUMERIC_VALUE(lambda_);
35 double eps = NUMERIC_VALUE(eps_);
36
37 // Get pointers from SEXP arrays ; WARNING: by columns !
38 double* phiInit = REAL(phiInit_);
39 double* rhoInit = REAL(rhoInit_);
40 double* piInit = REAL(piInit_);
41 double* gamInit = REAL(gamInit_);
42 double* X = REAL(X_);
43 double* Y = REAL(Y_);
44
45 /////////////
46 // OUTPUTS //
47 /////////////
48
49 SEXP phi, rho, pi, llh, S, affec, dimPhiS, dimRho;
50 PROTECT(dimPhiS = allocVector(INTSXP, 3));
51 int* pDimPhiS = INTEGER(dimPhiS);
52 pDimPhiS[0] = p; pDimPhiS[1] = m; pDimPhiS[2] = k;
53 PROTECT(dimRho = allocVector(INTSXP, 3));
54 int* pDimRho = INTEGER(dimRho);
55 pDimRho[0] = m; pDimRho[1] = m; pDimRho[2] = k;
56 PROTECT(phi = allocArray(REALSXP, dimPhiS));
57 PROTECT(rho = allocArray(REALSXP, dimRho));
58 PROTECT(pi = allocVector(REALSXP, k));
59 PROTECT(llh = allocVector(REALSXP, 1));
60 PROTECT(S = allocArray(REALSXP, dimPhiS));
61 PROTECT(affec = allocVector(INTSXP, n));
62 double *pPhi=REAL(phi), *pRho=REAL(rho), *pPi=REAL(pi), *pLlh=REAL(llh), *pS=REAL(S);
63 int *pAffec=INTEGER(affec);
64
65 ////////////////////
66 // Call to EMGLLF //
67 ////////////////////
68
69 EMGLLF_core(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,eps,
70 pPhi,pRho,pPi,pLlh,pS,pAffec,
71 n,p,m,k);
72
73 // Build list from OUT params and return it
74 SEXP listParams, listNames;
75 int nouts = 6;
76 PROTECT(listParams = allocVector(VECSXP, nouts));
77 char* lnames[6] = {"phi", "rho", "pi", "llh", "S", "affec"}; //lists labels
78 PROTECT(listNames = allocVector(STRSXP,nouts));
79 for (int i=0; i<nouts; i++)
80 SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
81 setAttrib(listParams, R_NamesSymbol, listNames);
82 SET_VECTOR_ELT(listParams, 0, phi);
83 SET_VECTOR_ELT(listParams, 1, rho);
84 SET_VECTOR_ELT(listParams, 2, pi);
85 SET_VECTOR_ELT(listParams, 3, llh);
86 SET_VECTOR_ELT(listParams, 4, S);
87 SET_VECTOR_ELT(listParams, 5, affec);
88
89 UNPROTECT(10);
90 return listParams;
91}