src/adapters/a.constructionModelesLassoMLE.c

   1 #include <R.h>
   2 #include <Rdefines.h>
   3 #include "sources/EMGLLF.h"
   4
   5 SEXP EMGLLF(
   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 ) {
  21     // Get matrices dimensions
  22     int n = INTEGER(getAttrib(X_, R_DimSymbol))[0];
  23     SEXP dim = getAttrib(phiInit_, R_DimSymbol)
  24     int p = INTEGER(dim)[0];
  25     int m = INTEGER(dim)[1];
  26     int k = INTEGER(dim)[2];
  27     int L = INTEGER(getAttrib(glambda_, R_LengthSymbol))[0];
  28
  29     ////////////
  30     // INPUTS //
  31     ////////////
  32
  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_);
  48     double* A1 = REAL(A1_);
  49     double* A2 = REAL(A2_);
  50
  51     /////////////
  52     // OUTPUTS //
  53     /////////////
  54
  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));
  66     double* pPhi=REAL(phi), pRho=REAL(rho), pPi=REAL(pi), pLvraisemblance=REAL(lvraisemblance);
  67
  68     /////////////////////////////////////////
  69     // Call to constructionModelesLassoMLE //
  70     /////////////////////////////////////////
  71
  72     constructionModelesLassoMLE(
  73         phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2,
  74         pPhi,pRho,pPi,pLvraisemblance,
  75         n,p,m,k,L);
  76
  77     // Build list from OUT params and return it
  78     SEXP listParams, listNames;
  79     PROTECT(listParams = allocVector(VECSXP, 4));
  80     char* lnames[4] = {"phi", "rho", "pi", "lvraisemblance}; //lists labels
  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);
  85     SET_ARRAY_ELT(listParams, 0, phi);
  86     SET_ARRAY_ELT(listParams, 1, rho);
  87     SET_MATRIX_ELT(listParams, 2, pi);
  88     SET_VECTOR_ELT(listParams, 3, lvraisemblance);
  89
  90     UNPROTECT(8);
  91     return listParams;
  92 }