X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=src%2Fadapters%2Fa.EMGrank.c;fp=src%2Fadapters%2Fa.EMGrank.c;h=0000000000000000000000000000000000000000;hb=f87ff0f5116c0c1c59c5608e46563ff0f79e5d43;hp=469349c344756a4221444c027ead3b40aef382c6;hpb=53fa233d8fbeaf4d51a4874ba69d8472d01d04ba;p=valse.git diff --git a/src/adapters/a.EMGrank.c b/src/adapters/a.EMGrank.c deleted file mode 100644 index 469349c..0000000 --- a/src/adapters/a.EMGrank.c +++ /dev/null @@ -1,72 +0,0 @@ -#include -#include -#include "EMGrank.h" - -SEXP EMGrank( - SEXP Pi_, - SEXP Rho_, - SEXP mini_, - SEXP maxi_, - SEXP X_, - SEXP Y_, - SEXP tau_, - SEXP rank_ -) { - // Get matrices dimensions - 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 // - //////////// - - // get scalar parameters - int mini = INTEGER_VALUE(mini_); - int maxi = INTEGER_VALUE(maxi_); - double tau = NUMERIC_VALUE(tau_); - - // Get pointers from SEXP arrays ; WARNING: by columns ! - double* Pi = REAL(Pi_); - double* Rho = REAL(Rho_); - double* X = REAL(X_); - double* Y = REAL(Y_); - int* rank = INTEGER(rank_); - - ///////////// - // OUTPUTS // - ///////////// - - SEXP phi, LLF, dimPhi; - 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_core(Pi, Rho, mini, maxi, X, Y, tau, rank, - pPhi,pLLF, - n,p,m,k); - - // 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_VECTOR_ELT(listParams, 0, phi); - SET_VECTOR_ELT(listParams, 1, LLF); - - UNPROTECT(5); - return listParams; -}