update tests/TODO
[valse.git] / src / adapters / a.EMGrank.c
1 #include <R.h>
2 #include <Rdefines.h>
3 #include "EMGrank.h"
4
5 SEXP EMGrank(
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 ) {
15 // Get matrices dimensions
16 SEXP dimX = getAttrib(X_, R_DimSymbol);
17 int n = INTEGER(dimX)[0];
18 int p = INTEGER(dimX)[1];
19 SEXP dimRho = getAttrib(Rho_, R_DimSymbol);
20 int m = INTEGER(dimRho)[0];
21 int k = INTEGER(dimRho)[2];
22
23 ////////////
24 // INPUTS //
25 ////////////
26
27 // get scalar parameters
28 int mini = INTEGER_VALUE(mini_);
29 int maxi = INTEGER_VALUE(maxi_);
30 double tau = NUMERIC_VALUE(tau_);
31
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_);
37 int* rank = INTEGER(rank_);
38
39 /////////////
40 // OUTPUTS //
41 /////////////
42
43 SEXP phi, LLF, dimPhi;
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));
49 double *pPhi=REAL(phi), *pLLF=REAL(LLF);
50
51 /////////////////////
52 // Call to EMGrank //
53 /////////////////////
54
55 EMGrank_core(Pi, Rho, mini, maxi, X, Y, tau, rank,
56 pPhi,pLLF,
57 n,p,m,k);
58
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);
67 SET_VECTOR_ELT(listParams, 0, phi);
68 SET_VECTOR_ELT(listParams, 1, LLF);
69
70 UNPROTECT(5);
71 return listParams;
72 }