Commit | Line | Data |
---|---|---|
3453829e BA |
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) | |
6 | SEXP 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 | } |