constructionModelLassoLME.R
[valse.git] / src / adapters / a.EMGrank.c
CommitLineData
552b00e2
BA
1#include <R.h>
2#include <Rdefines.h>
8e92c49c 3#include "EMGrank.h"
1d3c1faa 4
09ab3c16 5SEXP 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}