Commit | Line | Data |
---|---|---|
552b00e2 BA |
1 | #include <R.h> |
2 | #include <Rdefines.h> | |
8e92c49c | 3 | #include "constructionModelesLassoMLE.h" |
552b00e2 | 4 | |
09ab3c16 | 5 | SEXP constructionModelesLassoMLE( |
552b00e2 BA |
6 | SEXP phiInit_, |
7 | SEXP rhoInit_, | |
8 | SEXP piInit_, | |
9 | SEXP gamInit_, | |
10 | SEXP mini_, | |
11 | SEXP maxi_, | |
12 | SEXP gamma_, | |
13 | SEXP glambda_, | |
14 | SEXP X_, | |
15 | SEXP Y_, | |
16 | SEXP seuil_, | |
17 | SEXP tau_, | |
18 | SEXP A1_, | |
19 | SEXP A2_ | |
20 | ) { | |
1d3c1faa | 21 | // Get matrices dimensions |
552b00e2 | 22 | int n = INTEGER(getAttrib(X_, R_DimSymbol))[0]; |
8e92c49c | 23 | SEXP dim = getAttrib(phiInit_, R_DimSymbol); |
552b00e2 BA |
24 | int p = INTEGER(dim)[0]; |
25 | int m = INTEGER(dim)[1]; | |
26 | int k = INTEGER(dim)[2]; | |
09ab3c16 | 27 | int L = length(glambda_); |
552b00e2 | 28 | |
1d3c1faa BA |
29 | //////////// |
30 | // INPUTS // | |
31 | //////////// | |
32 | ||
552b00e2 BA |
33 | // get scalar parameters |
34 | int mini = INTEGER_VALUE(mini_); | |
35 | int maxi = INTEGER_VALUE(maxi_); | |
36 | double gamma = NUMERIC_VALUE(gamma_); | |
37 | double seuil = NUMERIC_VALUE(seuil_); | |
38 | double tau = NUMERIC_VALUE(tau_); | |
39 | ||
40 | // Get pointers from SEXP arrays ; WARNING: by columns ! | |
41 | double* phiInit = REAL(phiInit_); | |
42 | double* rhoInit = REAL(rhoInit_); | |
43 | double* piInit = REAL(piInit_); | |
44 | double* gamInit = REAL(gamInit_); | |
45 | double* glambda = REAL(glambda_); | |
46 | double* X = REAL(X_); | |
47 | double* Y = REAL(Y_); | |
09ab3c16 BA |
48 | int* A1 = INTEGER(A1_); |
49 | int* A2 = INTEGER(A2_); | |
1d3c1faa | 50 | |
1d3c1faa BA |
51 | ///////////// |
52 | // OUTPUTS // | |
53 | ///////////// | |
1d3c1faa | 54 | |
552b00e2 BA |
55 | SEXP phi, rho, pi, lvraisemblance, dimPhi, dimRho; |
56 | PROTECT(dimPhi = allocVector(INTSXP, 4)); | |
57 | int* pDimPhi = INTEGER(dimPhi); | |
58 | pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k; pDimPhi[3] = L; | |
59 | PROTECT(dimRho = allocVector(INTSXP, 4)); | |
60 | int* pDimRho = INTEGER(dimRho); | |
61 | pDimRho[0] = m; pDimRho[1] = m; pDimRho[2] = k; pDimRho[3] = L; | |
62 | PROTECT(phi = allocArray(REALSXP, dimPhi)); | |
63 | PROTECT(rho = allocArray(REALSXP, dimRho)); | |
64 | PROTECT(pi = allocMatrix(REALSXP, k, L)); | |
65 | PROTECT(lvraisemblance = allocMatrix(REALSXP, L, 2)); | |
8e92c49c | 66 | double *pPhi=REAL(phi), *pRho=REAL(rho), *pPi=REAL(pi), *pLvraisemblance=REAL(lvraisemblance); |
1d3c1faa BA |
67 | |
68 | ///////////////////////////////////////// | |
69 | // Call to constructionModelesLassoMLE // | |
70 | ///////////////////////////////////////// | |
71 | ||
09ab3c16 | 72 | constructionModelesLassoMLE_core( |
552b00e2 BA |
73 | phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2, |
74 | pPhi,pRho,pPi,pLvraisemblance, | |
1d3c1faa | 75 | n,p,m,k,L); |
1d3c1faa | 76 | |
552b00e2 BA |
77 | // Build list from OUT params and return it |
78 | SEXP listParams, listNames; | |
79 | PROTECT(listParams = allocVector(VECSXP, 4)); | |
3ec579a0 | 80 | char* lnames[4] = {"phi", "rho", "pi", "lvraisemblance"}; //lists labels |
552b00e2 BA |
81 | PROTECT(listNames = allocVector(STRSXP,4)); |
82 | for (int i=0; i<4; i++) | |
83 | SET_STRING_ELT(listNames,i,mkChar(lnames[i])); | |
84 | setAttrib(listParams, R_NamesSymbol, listNames); | |
09ab3c16 BA |
85 | SET_VECTOR_ELT(listParams, 0, phi); |
86 | SET_VECTOR_ELT(listParams, 1, rho); | |
87 | SET_VECTOR_ELT(listParams, 2, pi); | |
552b00e2 BA |
88 | SET_VECTOR_ELT(listParams, 3, lvraisemblance); |
89 | ||
90 | UNPROTECT(8); | |
91 | return listParams; | |
1d3c1faa | 92 | } |