X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=src%2Fadapters%2Fa.EMGrank.c;h=f7fc1923d475c326632ce7aeaee3b303393abb12;hp=778ef67999233ba59807cc09e46242252c297084;hb=552b00e200e8a990c1247989d29e98d4ae8679f3;hpb=f96d2399b96e61f7e9a1d850bb566dd4021aba76

diff --git a/src/adapters/a.EMGrank.c b/src/adapters/a.EMGrank.c
index 778ef67..f7fc192 100644
--- a/src/adapters/a.EMGrank.c
+++ b/src/adapters/a.EMGrank.c
@@ -1,90 +1,72 @@
-#include "ioutils.h"
-#include "EMGrank.h"
-#include <mex.h>
-
-// nlhs, nrhs: resp. numbers of out and in parameters.
-// plhs: array of out parameters, each being a mxArray
-// plhs: array of in parameters (immutable), each being a mxArray
-//
-// MATLAB translates a call [A,B] = fun(C,D) into mexFunction(2,{A,B},2,{C,D}). 
-// Then mxArrayS are adapted to be passed to a regular C function, 
-// and the results are translated back to mxArrayS into plhs.
-void mexFunction(
-	int nlhs, 
-	mxArray* plhs[], 
-	int nrhs, 
-	const mxArray* prhs[])
-{
-	// Basic sanity checks
-	if (nrhs!=8) 
-		mexErrMsgIdAndTxt("select:EMGrank:nrhs","8 inputs required.");
-	if (nlhs!=2) 
-		mexErrMsgIdAndTxt("select:EMGrank:nlhs","3 outputs required.");
+#include <R.h>
+#include <Rdefines.h>
+#include "sources/EMGLLF.h"
 
+SEXP EMGLLF(
+	SEXP Pi_,
+	SEXP Rho_,
+	SEXP mini_,
+	SEXP maxi_,
+	SEXP X_,
+	SEXP Y_,
+	SEXP tau_,
+	SEXP rank_
+) {
 	// Get matrices dimensions
-	const mwSize n = mxGetDimensions(prhs[4])[0];
-	const mwSize p = mxGetDimensions(prhs[4])[1];
-	const mwSize m = mxGetDimensions(prhs[1])[0];
-	const mwSize k = mxGetDimensions(prhs[1])[2];
+	SEXP dimX = getAttrib(X_, R_DimSymbol);
+	int n = INTEGER(dimX)[0];
+	int p = INTEGER(dimX)[1];
+	SEXP dimRho = getAttrib(Rho_, R_DimSymbol)
+	int m = INTEGER(dimRho)[0];
+	int k = INTEGER(dimRho)[2];
 
 	////////////
 	// INPUTS //
 	////////////
 
-	// Pi
-	Real* Pi = mxGetPr(prhs[0]);
-
-	// Rho
-	const mwSize* dimRho = mxGetDimensions(prhs[1]);
-	Real* brRho = matlabToBrArray_real(mxGetPr(prhs[1]), dimRho, 3);
-	
-	// min number of iterations
-	Int mini = ((Int*)mxGetData(prhs[2]))[0];
-
-	// max number of iterations
-	Int maxi = ((Int*)mxGetData(prhs[3]))[0];
+	// get scalar parameters
+	int mini = INTEGER_VALUE(mini_);
+	int maxi = INTEGER_VALUE(maxi_);
+	double tau = NUMERIC_VALUE(tau_);
 
-	// X
-	const mwSize* dimX = mxGetDimensions(prhs[4]);
-	Real* brX = matlabToBrArray_real(mxGetPr(prhs[4]), dimX, 2);
-	
-	// Y
-	const mwSize* dimY = mxGetDimensions(prhs[5]);
-	Real* brY = matlabToBrArray_real(mxGetPr(prhs[5]), dimY, 2);
+	// Get pointers from SEXP arrays ; WARNING: by columns !
+	double* Pi = REAL(Pi_);
+	double* Rho = REAL(Rho_);
+	double* X = REAL(X_);
+	double* Y = REAL(Y_);
+	double* rank = REAL(rank_);
 
-	// tau
-	Real tau = mxGetScalar(prhs[6]);
-
-	// rank
-	Int* rank = (Int*)mxGetData(prhs[7]);
-	
 	/////////////
 	// OUTPUTS //
 	/////////////
 
-	// phi
-	const mwSize dimPhi[] = {p, m, k};
-	plhs[0] = mxCreateNumericArray(3,dimPhi,mxDOUBLE_CLASS,mxREAL);
-	Real* phi = mxGetPr(plhs[0]);
-
-	// LLF
-	plhs[1] = mxCreateNumericMatrix(1,1,mxDOUBLE_CLASS,mxREAL);
-	Real* LLF = mxGetPr(plhs[1]);
+	SEXP phi, LLF;
+	PROTECT(dimPhi = allocVector(INTSXP, 3));
+	int* pDimPhi = INTEGER(dimPhi);
+	pDimPhi[0] = p; pDimPhi[1] = m; pDimPhi[2] = k;
+	PROTECT(phi = allocArray(REALSXP, dimPhi));
+	PROTECT(LLF = allocVector(REALSXP, 1));
+	double* pPhi=REAL(phi), pLLF=REAL(LLF);
 
 	/////////////////////
 	// Call to EMGrank //
 	/////////////////////
 
-	EMGrank(Pi,brRho,mini,maxi,brX,brY,tau,rank,
-		phi,LLF,
+	EMGrank(Pi, Rho, mini, maxi, X, Y, tau, rank,
+		pPhi,pLLF,
 		n,p,m,k);
 
-	free(brRho);
-	free(brX);
-	free(brY);
-	
-	//post-processing: convert by-rows outputs to MATLAB matrices
-	Real* mlPhi = brToMatlabArray_real(phi, dimPhi, 3);
-	copyArray(mlPhi, phi, dimPhi[0]*dimPhi[1]*dimPhi[2]);
-	free(mlPhi);
+	// Build list from OUT params and return it
+	SEXP listParams, listNames;
+	PROTECT(listParams = allocVector(VECSXP, 2));
+	char* lnames[2] = {"phi", "LLF"}; //lists labels
+	PROTECT(listNames = allocVector(STRSXP,2));
+	for (int i=0; i<2; i++)
+		SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
+	setAttrib(listParams, R_NamesSymbol, listNames);
+	SET_ARRAY_ELT(listParams, 0, phi);
+	SET_VECTOR_ELT(listParams, 1, LLF);
+
+	UNPROTECT(5);
+	return listParams;
 }