finish adapters ; almost finished sources
[valse.git] / src / adapters / a.constructionModelesLassoRank.c
1 #include <R.h>
2 #include <Rdefines.h>
3 #include "sources/EMGLLF.h"
4
5 SEXP EMGLLF(
6 SEXP Pi_,
7 SEXP Rho_,
8 SEXP mini_,
9 SEXP maxi_,
10 SEXP X_,
11 SEXP Y_,
12 SEXP tau_,
13 SEXP A1_,
14 SEXP rangmin_,
15 SEXP rangmax
16 ) {
17 // Get matrices dimensions
18 SEXP dimX = getAttrib(X_, R_DimSymbol);
19 int n = INTEGER(dimX)[0];
20 int p = INTEGER(dimX)[1];
21 SEXP dimRho = getAttrib(Rho_, R_DimSymbol)
22 int m = INTEGER(dimRho)[0];
23 int k = INTEGER(dimRho)[2];
24 int L = INTEGER(getAttrib(A1_, R_DimSymbol))[1];
25
26 ////////////
27 // INPUTS //
28 ////////////
29
30 // get scalar parameters
31 int mini = INTEGER_VALUE(mini_);
32 int maxi = INTEGER_VALUE(maxi_);
33 double tau = NUMERIC_VALUE(tau_);
34 double rangmin = NUMERIC_VALUE(rangmin_);
35 double rangmax = NUMERIC_VALUE(rangmax_);
36
37 // Get pointers from SEXP arrays ; WARNING: by columns !
38 double* Pi = REAL(Pi_);
39 double* Rho = REAL(Rho_);
40 double* X = REAL(X_);
41 double* Y = REAL(Y_);
42 double* A1 = REAL(A1_);
43
44 /////////////
45 // OUTPUTS //
46 /////////////
47
48 int Size = pow(rangmax-rangmin+1,k);
49 SEXP phi, lvraisemblance, dimPhi;
50 PROTECT(dimPhi = allocVector(INTSXP, 4));
51 int* pDimPhi = INTEGER(dimPhi);
52 pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k; pDimPhi[3] = L*Size;
53 PROTECT(phi = allocArray(REALSXP, dimPhi));
54 PROTECT(lvraisemblance = allocMatrix(REALSXP, L*Size, 2));
55 double* pPhi=REAL(phi), pLvraisemblance=REAL(lvraisemblance);
56
57 //////////////////////////////////////////
58 // Call to constructionModelesLassoRank //
59 //////////////////////////////////////////
60
61 constructionModelesLassoRank(
62 Pi,Rho,mini,maxi,X,Y,tau,A1,rangmin,rangmax,
63 pPhi,pLvraisemblance,
64 n,p,m,k,L);
65
66 // Build list from OUT params and return it
67 SEXP listParams, listNames;
68 PROTECT(listParams = allocVector(VECSXP, 2));
69 char* lnames[2] = {"phi", "lvraisemblance"}; //lists labels
70 PROTECT(listNames = allocVector(STRSXP,2));
71 for (int i=0; i<2; i++)
72 SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
73 setAttrib(listParams, R_NamesSymbol, listNames);
74 SET_ARRAY_ELT(listParams, 0, phi);
75 SET_VECTOR_ELT(listParams, 1, lvraisemblance);
76
77 UNPROTECT(5);
78 return listParams;
79 }