constructionModelLassoLME.R
[valse.git] / src / adapters / a.constructionModelesLassoMLE.c
CommitLineData
552b00e2
BA
1#include <R.h>
2#include <Rdefines.h>
8e92c49c 3#include "constructionModelesLassoMLE.h"
552b00e2 4
09ab3c16 5SEXP constructionModelesLassoMLE(
552b00e2
BA
6 SEXP phiInit_,
7 SEXP rhoInit_,
8 SEXP piInit_,
9 SEXP gamInit_,
10 SEXP mini_,
11 SEXP maxi_,
12 SEXP gamma_,
13 SEXP glambda_,
14 SEXP X_,
15 SEXP Y_,
16 SEXP seuil_,
17 SEXP tau_,
18 SEXP A1_,
19 SEXP A2_
20) {
1d3c1faa 21 // Get matrices dimensions
552b00e2 22 int n = INTEGER(getAttrib(X_, R_DimSymbol))[0];
8e92c49c 23 SEXP dim = getAttrib(phiInit_, R_DimSymbol);
552b00e2
BA
24 int p = INTEGER(dim)[0];
25 int m = INTEGER(dim)[1];
26 int k = INTEGER(dim)[2];
09ab3c16 27 int L = length(glambda_);
552b00e2 28
1d3c1faa
BA
29 ////////////
30 // INPUTS //
31 ////////////
32
552b00e2
BA
33 // get scalar parameters
34 int mini = INTEGER_VALUE(mini_);
35 int maxi = INTEGER_VALUE(maxi_);
36 double gamma = NUMERIC_VALUE(gamma_);
37 double seuil = NUMERIC_VALUE(seuil_);
38 double tau = NUMERIC_VALUE(tau_);
39
40 // Get pointers from SEXP arrays ; WARNING: by columns !
41 double* phiInit = REAL(phiInit_);
42 double* rhoInit = REAL(rhoInit_);
43 double* piInit = REAL(piInit_);
44 double* gamInit = REAL(gamInit_);
45 double* glambda = REAL(glambda_);
46 double* X = REAL(X_);
47 double* Y = REAL(Y_);
09ab3c16
BA
48 int* A1 = INTEGER(A1_);
49 int* A2 = INTEGER(A2_);
1d3c1faa 50
1d3c1faa
BA
51 /////////////
52 // OUTPUTS //
53 /////////////
1d3c1faa 54
552b00e2
BA
55 SEXP phi, rho, pi, lvraisemblance, dimPhi, dimRho;
56 PROTECT(dimPhi = allocVector(INTSXP, 4));
57 int* pDimPhi = INTEGER(dimPhi);
58 pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k; pDimPhi[3] = L;
59 PROTECT(dimRho = allocVector(INTSXP, 4));
60 int* pDimRho = INTEGER(dimRho);
61 pDimRho[0] = m; pDimRho[1] = m; pDimRho[2] = k; pDimRho[3] = L;
62 PROTECT(phi = allocArray(REALSXP, dimPhi));
63 PROTECT(rho = allocArray(REALSXP, dimRho));
64 PROTECT(pi = allocMatrix(REALSXP, k, L));
65 PROTECT(lvraisemblance = allocMatrix(REALSXP, L, 2));
8e92c49c 66 double *pPhi=REAL(phi), *pRho=REAL(rho), *pPi=REAL(pi), *pLvraisemblance=REAL(lvraisemblance);
1d3c1faa
BA
67
68 /////////////////////////////////////////
69 // Call to constructionModelesLassoMLE //
70 /////////////////////////////////////////
71
09ab3c16 72 constructionModelesLassoMLE_core(
552b00e2
BA
73 phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2,
74 pPhi,pRho,pPi,pLvraisemblance,
1d3c1faa 75 n,p,m,k,L);
1d3c1faa 76
552b00e2
BA
77 // Build list from OUT params and return it
78 SEXP listParams, listNames;
79 PROTECT(listParams = allocVector(VECSXP, 4));
3ec579a0 80 char* lnames[4] = {"phi", "rho", "pi", "lvraisemblance"}; //lists labels
552b00e2
BA
81 PROTECT(listNames = allocVector(STRSXP,4));
82 for (int i=0; i<4; i++)
83 SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
84 setAttrib(listParams, R_NamesSymbol, listNames);
09ab3c16
BA
85 SET_VECTOR_ELT(listParams, 0, phi);
86 SET_VECTOR_ELT(listParams, 1, rho);
87 SET_VECTOR_ELT(listParams, 2, pi);
552b00e2
BA
88 SET_VECTOR_ELT(listParams, 3, lvraisemblance);
89
90 UNPROTECT(8);
91 return listParams;
1d3c1faa 92}