projects / valse.git / blame
| 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 | |
| c3bc4705 | 55 | SEXP phi, rho, pi, llh, dimPhi, dimRho; |
| 552b00e2 BA |
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)); | |
| c3bc4705 BA |
65 | PROTECT(llh = allocMatrix(REALSXP, L, 2)); |
| 66 | double *pPhi=REAL(phi), *pRho=REAL(rho), *pPi=REAL(pi), *pllh=REAL(llh); | |
| 1d3c1faa BA |
67 | |
| 68 | ///////////////////////////////////////// | |
| 69 | // Call to constructionModelesLassoMLE // | |
| 70 | ///////////////////////////////////////// | |
| 71 | ||
| 09ab3c16 | 72 | constructionModelesLassoMLE_core( |
| 552b00e2 | 73 | phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2, |
| c3bc4705 | 74 | pPhi,pRho,pPi,pllh, |
| 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)); | |
| c3bc4705 | 80 | char* lnames[4] = {"phi", "rho", "pi", "llh"}; //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); | |
| c3bc4705 | 88 | SET_VECTOR_ELT(listParams, 3, llh); |
| 552b00e2 BA |
89 | |
| 90 | UNPROTECT(8); | |
| 91 | return listParams; | |
| 1d3c1faa | 92 | } |