| 1 | #include <R.h> |
| 2 | #include <Rdefines.h> |
| 3 | #include "sources/EMGLLF.h" |
| 4 | |
| 5 | SEXP EMGLLF( |
| 6 | SEXP Pi_, |
| 7 | SEXP Rho_, |
| 8 | SEXP mini_, |
| 9 | SEXP maxi_, |
| 10 | SEXP X_, |
| 11 | SEXP Y_, |
| 12 | SEXP tau_, |
| 13 | SEXP A1_, |
| 14 | SEXP rangmin_, |
| 15 | SEXP rangmax |
| 16 | ) { |
| 17 | // Get matrices dimensions |
| 18 | SEXP dimX = getAttrib(X_, R_DimSymbol); |
| 19 | int n = INTEGER(dimX)[0]; |
| 20 | int p = INTEGER(dimX)[1]; |
| 21 | SEXP dimRho = getAttrib(Rho_, R_DimSymbol) |
| 22 | int m = INTEGER(dimRho)[0]; |
| 23 | int k = INTEGER(dimRho)[2]; |
| 24 | int L = INTEGER(getAttrib(A1_, R_DimSymbol))[1]; |
| 25 | |
| 26 | //////////// |
| 27 | // INPUTS // |
| 28 | //////////// |
| 29 | |
| 30 | // get scalar parameters |
| 31 | int mini = INTEGER_VALUE(mini_); |
| 32 | int maxi = INTEGER_VALUE(maxi_); |
| 33 | double tau = NUMERIC_VALUE(tau_); |
| 34 | double rangmin = NUMERIC_VALUE(rangmin_); |
| 35 | double rangmax = NUMERIC_VALUE(rangmax_); |
| 36 | |
| 37 | // Get pointers from SEXP arrays ; WARNING: by columns ! |
| 38 | double* Pi = REAL(Pi_); |
| 39 | double* Rho = REAL(Rho_); |
| 40 | double* X = REAL(X_); |
| 41 | double* Y = REAL(Y_); |
| 42 | double* A1 = REAL(A1_); |
| 43 | |
| 44 | ///////////// |
| 45 | // OUTPUTS // |
| 46 | ///////////// |
| 47 | |
| 48 | int Size = pow(rangmax-rangmin+1,k); |
| 49 | SEXP phi, lvraisemblance, dimPhi; |
| 50 | PROTECT(dimPhi = allocVector(INTSXP, 4)); |
| 51 | int* pDimPhi = INTEGER(dimPhi); |
| 52 | pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k; pDimPhi[3] = L*Size; |
| 53 | PROTECT(phi = allocArray(REALSXP, dimPhi)); |
| 54 | PROTECT(lvraisemblance = allocMatrix(REALSXP, L*Size, 2)); |
| 55 | double* pPhi=REAL(phi), pLvraisemblance=REAL(lvraisemblance); |
| 56 | |
| 57 | ////////////////////////////////////////// |
| 58 | // Call to constructionModelesLassoRank // |
| 59 | ////////////////////////////////////////// |
| 60 | |
| 61 | constructionModelesLassoRank( |
| 62 | Pi,Rho,mini,maxi,X,Y,tau,A1,rangmin,rangmax, |
| 63 | pPhi,pLvraisemblance, |
| 64 | n,p,m,k,L); |
| 65 | |
| 66 | // Build list from OUT params and return it |
| 67 | SEXP listParams, listNames; |
| 68 | PROTECT(listParams = allocVector(VECSXP, 2)); |
| 69 | char* lnames[2] = {"phi", "lvraisemblance"}; //lists labels |
| 70 | PROTECT(listNames = allocVector(STRSXP,2)); |
| 71 | for (int i=0; i<2; i++) |
| 72 | SET_STRING_ELT(listNames,i,mkChar(lnames[i])); |
| 73 | setAttrib(listParams, R_NamesSymbol, listNames); |
| 74 | SET_ARRAY_ELT(listParams, 0, phi); |
| 75 | SET_VECTOR_ELT(listParams, 1, lvraisemblance); |
| 76 | |
| 77 | UNPROTECT(5); |
| 78 | return listParams; |
| 79 | } |