[valse.git] / src / adapters / a.constructionModelesLassoMLE.c

#include <R.h>
#include <Rdefines.h>
#include "sources/EMGLLF.h"

SEXP EMGLLF(
	SEXP phiInit_,
	SEXP rhoInit_,
	SEXP piInit_,
	SEXP gamInit_,
	SEXP mini_,
	SEXP maxi_,
	SEXP gamma_,
	SEXP glambda_,
	SEXP X_,
	SEXP Y_,
	SEXP seuil_,
	SEXP tau_,
	SEXP A1_,
	SEXP A2_
) {
	// Get matrices dimensions
	int n = INTEGER(getAttrib(X_, R_DimSymbol))[0];
	SEXP dim = getAttrib(phiInit_, R_DimSymbol)
	int p = INTEGER(dim)[0];
	int m = INTEGER(dim)[1];
	int k = INTEGER(dim)[2];
	int L = INTEGER(getAttrib(glambda_, R_LengthSymbol))[0];

	////////////
	// INPUTS //
	////////////

	// get scalar parameters
	int mini = INTEGER_VALUE(mini_);
	int maxi = INTEGER_VALUE(maxi_);
	double gamma = NUMERIC_VALUE(gamma_);
	double seuil = NUMERIC_VALUE(seuil_);
	double tau = NUMERIC_VALUE(tau_);

	// Get pointers from SEXP arrays ; WARNING: by columns !
	double* phiInit = REAL(phiInit_);
	double* rhoInit = REAL(rhoInit_);
	double* piInit = REAL(piInit_);
	double* gamInit = REAL(gamInit_);
	double* glambda = REAL(glambda_);
	double* X = REAL(X_);
	double* Y = REAL(Y_);
	double* A1 = REAL(A1_);
	double* A2 = REAL(A2_);

	/////////////
	// OUTPUTS //
	/////////////

	SEXP phi, rho, pi, lvraisemblance, dimPhi, dimRho;
	PROTECT(dimPhi = allocVector(INTSXP, 4));
	int* pDimPhi = INTEGER(dimPhi);
	pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k; pDimPhi[3] = L;
	PROTECT(dimRho = allocVector(INTSXP, 4));
	int* pDimRho = INTEGER(dimRho);
	pDimRho[0] = m; pDimRho[1] = m; pDimRho[2] = k; pDimRho[3] = L;
	PROTECT(phi = allocArray(REALSXP, dimPhi));
	PROTECT(rho = allocArray(REALSXP, dimRho));
	PROTECT(pi = allocMatrix(REALSXP, k, L));
	PROTECT(lvraisemblance = allocMatrix(REALSXP, L, 2));
	double* pPhi=REAL(phi), pRho=REAL(rho), pPi=REAL(pi), pLvraisemblance=REAL(lvraisemblance);

	/////////////////////////////////////////
	// Call to constructionModelesLassoMLE //
	/////////////////////////////////////////

	constructionModelesLassoMLE(
		phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2,
		pPhi,pRho,pPi,pLvraisemblance,
		n,p,m,k,L);

	// Build list from OUT params and return it
	SEXP listParams, listNames;
	PROTECT(listParams = allocVector(VECSXP, 4));
	char* lnames[4] = {"phi", "rho", "pi", "lvraisemblance}; //lists labels
	PROTECT(listNames = allocVector(STRSXP,4));
	for (int i=0; i<4; i++)
		SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
	setAttrib(listParams, R_NamesSymbol, listNames);
	SET_ARRAY_ELT(listParams, 0, phi);
	SET_ARRAY_ELT(listParams, 1, rho);
	SET_MATRIX_ELT(listParams, 2, pi);
	SET_VECTOR_ELT(listParams, 3, lvraisemblance);

	UNPROTECT(8);
	return listParams;
}
Commit	Line	Data
552b00e2 BA	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	) {
1d3c1faa	21	// Get matrices dimensions
552b00e2 BA	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
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_);
	48	double* A1 = REAL(A1_);
	49	double* A2 = REAL(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));
	66	double* pPhi=REAL(phi), pRho=REAL(rho), pPi=REAL(pi), pLvraisemblance=REAL(lvraisemblance);
1d3c1faa BA	67
	68	/////////////////////////////////////////
	69	// Call to constructionModelesLassoMLE //
	70	/////////////////////////////////////////
	71
	72	constructionModelesLassoMLE(
552b00e2 BA	73	phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau,A1,A2,
552b00e2 BA	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));
	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;
1d3c1faa	92	}