projects / valse.git / blame
| Commit | Line | Data |
|---|---|---|
| 552b00e2 BA |
1 | #include <R.h> |
| 2 | #include <Rdefines.h> | |
| 3 | #include "sources/EMGLLF.h" | |
| 4 | ||
| 5 | SEXP EMGLLF( | |
| 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 | ) { | |
| 19 | // Get matrices dimensions | |
| 20 | SEXP dimX = getAttrib(X_, R_DimSymbol); | |
| 21 | int n = INTEGER(dimX)[0]; | |
| 22 | int p = INTEGER(dimX)[1]; | |
| 23 | SEXP dimRho = getAttrib(rhoInit_, R_DimSymbol) | |
| 24 | int m = INTEGER(dimRho)[0]; | |
| 25 | int k = INTEGER(dimRho)[2]; | |
| 26 | int L = INTEGER(getAttrib(glambda_, R_LengthSymbol))[0]; | |
| 1d3c1faa BA |
27 | |
| 28 | //////////// | |
| 29 | // INPUTS // | |
| 30 | //////////// | |
| 31 | ||
| 552b00e2 BA |
32 | // get scalar parameters |
| 33 | int mini = INTEGER_VALUE(mini_); | |
| 34 | int maxi = INTEGER_VALUE(maxi_); | |
| 35 | double gamma = NUMERIC_VALUE(gamma_); | |
| 36 | double seuil = NUMERIC_VALUE(seuil_); | |
| 37 | double tau = NUMERIC_VALUE(tau_); | |
| 38 | ||
| 39 | // Get pointers from SEXP arrays ; WARNING: by columns ! | |
| 40 | double* piInit = REAL(phiInit_); | |
| 41 | double* rhoInit = REAL(rhoInit_); | |
| 42 | double* piInit = REAL(piInit_); | |
| 43 | double* gamInit = REAL(gamInit_); | |
| 44 | double* glambda = REAL(glambda_); | |
| 45 | double* X = REAL(X_); | |
| 46 | double* Y = REAL(Y_); | |
| 1d3c1faa BA |
47 | |
| 48 | ///////////// | |
| 49 | // OUTPUTS // | |
| 50 | ///////////// | |
| 1d3c1faa | 51 | |
| 552b00e2 BA |
52 | int Size = pow(rangmax-rangmin+1,k); |
| 53 | SEXP A1, A2, rho, pi, dimA; | |
| 54 | PROTECT(dimA = allocVector(INTSXP, 3)); | |
| 55 | int* pDimA = INTEGER(dimA); | |
| 56 | pDimA[0] = p; pDimA[1] = m+1; pDimA[2] = L; | |
| 57 | PROTECT(A1 = allocArray(REALSXP, dimA)); | |
| 58 | PROTECT(A2 = allocArray(REALSXP, dimA)); | |
| 59 | PROTECT(rho = allocArray(REALSXP, dimRho); | |
| 60 | PROTECT(pi = allocMatrix(REALSXP, k, L)); | |
| 61 | double* pA1=REAL(A1), pA2=REAL(A2), pRho=REAL(rho), pPi=REAL(pi); | |
| 1d3c1faa BA |
62 | |
| 63 | ///////////////////////////// | |
| 64 | // Call to selectiontotale // | |
| 65 | ///////////////////////////// | |
| 66 | ||
| 552b00e2 BA |
67 | selectiontotale( |
| 68 | phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau, | |
| 69 | pA1,pA2,pRho,pPi, | |
| 1d3c1faa | 70 | n,p,m,k,L); |
| 1d3c1faa | 71 | |
| 552b00e2 BA |
72 | // Build list from OUT params and return it |
| 73 | SEXP listParams, listNames; | |
| 74 | PROTECT(listParams = allocVector(VECSXP, 4)); | |
| 75 | char* lnames[4] = { "A1", "A2", "rho", "pi" }; //lists labels | |
| 76 | PROTECT(listNames = allocVector(STRSXP, 4)); | |
| 77 | for (int i=0; i<4; i++) | |
| 78 | SET_STRING_ELT(listNames,i,mkChar(lnames[i])); | |
| 79 | setAttrib(listParams, R_NamesSymbol, listNames); | |
| 80 | SET_ARRAY_ELT(listParams, 0, A1); | |
| 81 | SET_ARRAY_ELT(listParams, 1, A2); | |
| 82 | SET_ARRAY_ELT(listParams, 2, rho); | |
| 83 | SET_MATRIX_ELT(listParams, 3, pi); | |
| 84 | ||
| 85 | UNPROTECT(7); | |
| 86 | return listParams; | |
| 1d3c1faa | 87 | } |