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