src/adapters/a.constructionModelesLassoRank.c

   1 #include <R.h>
   2 #include <Rdefines.h>
   3 #include "constructionModelesLassoRank.h"
   4
   5 SEXP constructionModelesLassoRank(
   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     int* A1 = INTEGER(A1_);
  43
  44     /////////////
  45     // OUTPUTS //
  46     /////////////
  47
  48     int Size = pow(rangmax-rangmin+1,k);
  49     SEXP phi, llh, 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(llh = allocMatrix(REALSXP, L*Size, 2));
  55     double *pPhi=REAL(phi), *pllh=REAL(llh);
  56
  57     //////////////////////////////////////////
  58     // Call to constructionModelesLassoRank //
  59     //////////////////////////////////////////
  60
  61     constructionModelesLassoRank_core(
  62         Pi,Rho,mini,maxi,X,Y,tau,A1,rangmin,rangmax,
  63         pPhi,pllh,
  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", "llh"}; //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_VECTOR_ELT(listParams, 0, phi);
  75     SET_VECTOR_ELT(listParams, 1, llh);
  76
  77     UNPROTECT(5);
  78     return listParams;
  79 }