projects / valse.git / blame
| Commit | Line | Data |
|---|---|---|
| cb51adb8 BA |
1 | #include <R.h> |
| 2 | #include <Rdefines.h> | |
| 8e92c49c | 3 | #include "EMGLLF.h" |
| cb51adb8 | 4 | |
| 4fed76cc | 5 | // See comments in src/sources/EMGLLF.c and R/EMGLLF.R (wrapper) |
| cb51adb8 | 6 | SEXP EMGLLF( |
| 4cab944a BA |
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 tau_ | |
| cb51adb8 | 18 | ) { |
| cb51adb8 | 19 | // Get matrices dimensions |
| 4cab944a | 20 | int n = INTEGER(getAttrib(X_, R_DimSymbol))[0]; |
| 8e92c49c | 21 | SEXP dim = getAttrib(phiInit_, R_DimSymbol); |
| 4cab944a BA |
22 | int p = INTEGER(dim)[0]; |
| 23 | int m = INTEGER(dim)[1]; | |
| 24 | int k = INTEGER(dim)[2]; | |
| cb51adb8 BA |
25 | |
| 26 | //////////// | |
| 27 | // INPUTS // | |
| 28 | //////////// | |
| 29 | ||
| 4cab944a BA |
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 tau = NUMERIC_VALUE(tau_); | |
| 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_); | |
| cb51adb8 BA |
44 | |
| 45 | ///////////// | |
| 46 | // OUTPUTS // | |
| 47 | ///////////// | |
| 48 | ||
| 8be79c46 | 49 | SEXP phi, rho, pi, LLF, S, affec, dimPhiS, dimRho; |
| 4cab944a BA |
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(LLF = allocVector(REALSXP, maxi-mini+1)); | |
| 60 | PROTECT(S = allocArray(REALSXP, dimPhiS)); | |
| 8be79c46 | 61 | PROTECT(affec = allocVector(INTSXP, n)); |
| 8e92c49c | 62 | double *pPhi=REAL(phi), *pRho=REAL(rho), *pPi=REAL(pi), *pLLF=REAL(LLF), *pS=REAL(S); |
| 8be79c46 | 63 | int *pAffec=INTEGER(affec); |
| cb51adb8 BA |
64 | |
| 65 | //////////////////// | |
| 66 | // Call to EMGLLF // | |
| 67 | //////////////////// | |
| 68 | ||
| 09ab3c16 | 69 | EMGLLF_core(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau, |
| 8be79c46 | 70 | pPhi,pRho,pPi,pLLF,pS,pAffec, |
| cb51adb8 | 71 | n,p,m,k); |
| cb51adb8 | 72 | |
| 4cab944a BA |
73 | // Build list from OUT params and return it |
| 74 | SEXP listParams, listNames; | |
| 8be79c46 BA |
75 | int nouts = 6; |
| 76 | PROTECT(listParams = allocVector(VECSXP, nouts)); | |
| 77 | char* lnames[6] = {"phi", "rho", "pi", "LLF", "S", "affec"}; //lists labels | |
| 78 | PROTECT(listNames = allocVector(STRSXP,nouts)); | |
| 79 | for (int i=0; i<nouts; i++) | |
| 4cab944a BA |
80 | SET_STRING_ELT(listNames,i,mkChar(lnames[i])); |
| 81 | setAttrib(listParams, R_NamesSymbol, listNames); | |
| 09ab3c16 BA |
82 | SET_VECTOR_ELT(listParams, 0, phi); |
| 83 | SET_VECTOR_ELT(listParams, 1, rho); | |
| 84 | SET_VECTOR_ELT(listParams, 2, pi); | |
| 4cab944a | 85 | SET_VECTOR_ELT(listParams, 3, LLF); |
| 09ab3c16 | 86 | SET_VECTOR_ELT(listParams, 4, S); |
| 8be79c46 | 87 | SET_VECTOR_ELT(listParams, 5, affec); |
| cb51adb8 | 88 | |
| 8be79c46 | 89 | UNPROTECT(10); |
| 4cab944a | 90 | return listParams; |
| cb51adb8 | 91 | } |