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