PetscErrorCode PetscViewerMathematicaPutMatrix(PetscViewer viewer, int m, int n, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
char *name;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Send the dense matrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "Transpose", 1);
MLPutFunction(link, "Partition", 2);
MLPutRealList(link, a, m*n);
MLPutInteger(link, m);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
void mat_process_iterable_object(PyObject *obj, char *error_msg)
{
int length;
PyObject *iterator, *item;
length = PyObject_Length(obj);
MLPutFunction(stdlink, "List", 1);
MLPutFunction(stdlink, "Sequence", length);
iterator = PyObject_GetIter(obj);
if(iterator==NULL) {
MLPutString(stdlink, error_msg);
return;
}
while(item = PyIter_Next(iterator)) {
python_to_mathematica_object(item);
Py_DECREF(item);
}
Py_DECREF(iterator);
return;
}
/*@C
PetscViewerMathematicaPutVector - Send a vector to Mathematica
Input Parameters:
+ viewer - The Mathematica viewer
- v - The vector
Level: intermediate
.keywords PetscViewer, Mathematica, vector
.seealso VecView(), PetscViewerMathematicaGetVector()
@*/
PetscErrorCode PetscViewerMathematicaPutVector(PetscViewer viewer, Vec v)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
char *name;
PetscScalar *array;
int n;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "vec";
else name = (char*) vmath->objName;
ierr = VecGetLocalSize(v, &n);
CHKERRQ(ierr);
ierr = VecGetArray(v, &array);
CHKERRQ(ierr);
/* Send the Vector object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutRealList(link, array, n);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
ierr = VecRestoreArray(v, &array);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int mlput(K x,K y){
int fstype=y->t,fsint=y->i,i=0,funcerr=0;
K z;
char b[2]={0,0};
mlint64 j={0,0};
//printf("%s:%d,%d\n","mlput",x->t,x->n);
switch(x->t){
case -KB:
case -KG:
case -KC:b[0]=x->g;R MLPutString(ml_lp,b);
case -KH:R MLPutInteger16(ml_lp,x->h);
case -KI:R MLPutInteger32(ml_lp,x->i);
case -KJ:*(J*)&j=x->j;R MLPutInteger64(ml_lp,j);
case -KE:R MLPutReal32(ml_lp,x->e);
case -KF:R MLPutReal64(ml_lp,x->f);
case -KS:R MLPutSymbol(ml_lp,x->s);
case KB:
case KG:
case KC:R MLPutByteString(ml_lp,kG(x),x->n);
case KH:R MLPutInteger16List(ml_lp,kH(x),x->n);
case KI:R MLPutInteger32List(ml_lp,kI(x),x->n);
case KJ:R MLPutInteger64List(ml_lp,(mlint64*)kJ(x),x->n);
case KE:R MLPutReal32List(ml_lp,kE(x),x->n);
case KF:R MLPutReal64List(ml_lp,kF(x),x->n);
case KS:if(!MLPutFunction(ml_lp,"List",x->n)){
R 0;
}else{
for(i=0;i<x->n;i++)if(!MLPutSymbol(ml_lp,kS(x)[i]))R 0;
}
break;
case 0:
if(0==x->n){
R MLPutFunction(ml_lp, "List",0);
}else if((3==x->n)&&(fstype==kK(x)[0]->t)){
z=kK(x)[2];
if(!MLPutFunction(ml_lp,kK(x)[1]->s,z->n)){R 0;}else{
switch(z->t){
case 0:for(i=0;i<z->n;i++)if(!mlput(kK(z)[i],y))R 0;break;
case KH:for(i=0;i<z->n;i++)if(!MLPutInteger16(ml_lp,kH(z)[i]))R 0;break;
case KI:for(i=0;i<z->n;i++)if(!MLPutInteger32(ml_lp,kI(z)[i]))R 0;break;
case KJ:for(i=0;i<z->n;i++){*(J*)&j=kJ(z)[i];if(!MLPutInteger64(ml_lp,j))R 0;}break;
case KE:for(i=0;i<z->n;i++)if(!MLPutReal32(ml_lp,kE(z)[i]))R 0;break;
case KF:for(i=0;i<z->n;i++)if(!MLPutReal64(ml_lp,kF(z)[i]))R 0;break;
case KS:for(i=0;i<z->n;i++)if(!MLPutSymbol(ml_lp,kS(z)[i]))R 0;break;
case KC:for(i=0;i<z->n;i++){b[0]=kC(z)[i];if(!MLPutString(ml_lp,b))R 0;}break;
default:break;
}
}
}else{
if(!MLPutFunction(ml_lp,"List",x->n)){R 0;}else{for(i=0;i<x->n;i++)if(!mlput(kK(x)[i],y)){MLPutSymbol(ml_lp,"ParaErr");funcerr=1;}if(funcerr)R 0;}
}
break;
default:
R 0;
}
R 1;
}
void EchoIt(MLINK stdlink,MLINK ml,bool b) {
bool inCompound = false;
int i;
double d;
char * s = 0;
char * t = 0;
long m,n;
switch(MLGetType(stdlink)) {
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKSYMB;
MLGetSymbol(stdlink,&s);
t = new char[strlen(s)+4];
strcpy(t,s);
strcat(t,"MXS");
MLPutSymbol(ml,t);
delete [] t;
MLDisownSymbol(stdlink,s);
break;
case MLTKSTR;
MLGetString(stdlink,&s);
MLPutString(ml,s);
MLDisownString(stdlink,s);
break;
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKFUNC;
MLGetFunction(stdlink,&s,m);
strcpy(t,s);
strcat(t,"MXS");
if(strcmp(s,"CompoundExpression")==0 && b) {
inCompound = true;
MLPutFunction(ml,t,2*m);
} else {
MLPutFunction(ml,t,m);
};
delete [] t;
for(long n=1;n<=m;++n) {
if(inCompound) {
MLPutFunction(ml,"Print",4L);
MLPutString(ml,"Function:");
MLPutString(ml,s);
MLPutString(ml," ");
MLPutInteger(ml,s_number);
++s_number;
};
EchoIt(stdlink,ml,b);
};
inCompound = false;
break;
default:
DBG();
break;
};
};
void MLReturnError(const char *fname, const char *msgtag){
MLPutFunction(stdlink,"CompoundExpression",2);
MLPutFunction(stdlink,"Message",1);
MLPutFunction(stdlink,"MessageName",2);
MLPutSymbol(stdlink,fname);
MLPutString(stdlink,msgtag);
MLPutSymbol(stdlink,"$Failed");
}
void dd_MLWriteError(dd_PolyhedraPtr poly)
{
MLPutFunction(stdlink,"List",3);
MLPutFunction(stdlink,"List",0);
MLPutFunction(stdlink,"List",1);
MLPutString(stdlink,"Error occured: code");
MLPutFunction(stdlink,"List",1);
MLPutInteger(stdlink,poly->child->Error);
}
void dd_MLWriteSetFamily(dd_SetFamilyPtr F)
{
long i,j;
if (F!=NULL){
MLPutFunction(stdlink,"List",F->famsize);
for (i=0; i < F->famsize; i++) {
MLPutFunction(stdlink,"List",set_card(F->set[i]));
for (j=1; j <= F->setsize; j++) {
if (set_member(j, F->set[i])) MLPutLongInteger(stdlink, j);
}
}
}
}
void MmaSink::put(const Field & x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:number " << this << '\n';
#endif
/* New version by MAURICIO that uses strings */
MLPutFunction(d_mlink, "ToExpression", 1);
MLPutString(d_mlink, x.str().c_str());
/* COMMENTED BY MAURICIO, NOV 09
const long long & num = x.numerator().internal();
const long long & den = x.denominator().internal();
if(den==1L) {
MLPutInteger(d_mlink,num);
} else {
MLPutFunction(d_mlink,"Rational",2L);
MLPutInteger(d_mlink,num);
MLPutInteger(d_mlink,den);
};
*/
#ifdef DEBUG_MMASINK
checkforerror();
#endif
++d_count;
};
void allfacets(int n_input, int d_input, double *g_input)
/* output facets and incidences */
{
dd_PolyhedraPtr poly;
dd_MatrixPtr A=NULL,G=NULL;
dd_SetFamilyPtr AI=NULL;
dd_rowrange i,n;
dd_colrange j,d;
dd_ErrorType err;
n=(dd_rowrange)n_input; d=(dd_colrange)d_input;
G=dd_CreateMatrix(n,d);
for (i=0; i<n; i++){
for (j=0; j<d; j++) dd_set_d(G->matrix[i][j],g_input[i*d+j]);
}
G->representation=dd_Generator;
poly=dd_DDMatrix2Poly(G, &err);
/* compute the second (inequality) representation */
if (err==dd_NoError){
A=dd_CopyInequalities(poly);
AI=dd_CopyIncidence(poly);
MLPutFunction(stdlink,"List",2);
dd_MLWriteMatrix(A);
dd_MLWriteSetFamily(AI);
} else {
dd_MLWriteError(poly);
}
dd_FreeMatrix(A);
dd_FreeMatrix(G);
dd_FreeSetFamily(AI);
}
void allvertices(int m_input, int d_input, double *a_input)
/* output vertices and incidences */
{
dd_PolyhedraPtr poly;
dd_MatrixPtr A=NULL,G=NULL;
dd_SetFamilyPtr GI=NULL;
dd_rowrange i,m;
dd_colrange j,d;
dd_ErrorType err;
m=(dd_rowrange)m_input; d=(dd_colrange)d_input;
A=dd_CreateMatrix(m,d);
for (i=0; i<m; i++){
for (j=0; j<d; j++) dd_set_d(A->matrix[i][j],a_input[i*d+j]);
}
A->representation=dd_Inequality;
poly=dd_DDMatrix2Poly(A, &err);
/* compute the second (generator) representation */
if (err==dd_NoError) {
G=dd_CopyGenerators(poly);
GI=dd_CopyIncidence(poly);
MLPutFunction(stdlink,"List",2);
dd_MLWriteMatrix(G);
dd_MLWriteSetFamily(GI);
} else {
dd_MLWriteError(poly);
}
dd_FreeMatrix(A);
dd_FreeMatrix(G);
dd_FreeSetFamily(GI);
}
/*@C
PetscViewerMathematicaGetVector - Retrieve a vector from Mathematica
Input Parameter:
. viewer - The Mathematica viewer
Output Parameter:
. v - The vector
Level: intermediate
.keywords PetscViewer, Mathematica, vector
.seealso VecView(), PetscViewerMathematicaPutVector()
@*/
PetscErrorCode PetscViewerMathematicaGetVector(PetscViewer viewer, Vec v)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link; /* The link to Mathematica */
char *name;
PetscScalar *mArray,*array;
long mSize;
int n;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID,1);
PetscValidHeaderSpecific(v, VEC_CLASSID,2);
/* Determine the object name */
if (!vmath->objName) name = "vec";
else name = (char*) vmath->objName;
link = vmath->link;
ierr = VecGetLocalSize(v, &n);CHKERRQ(ierr);
ierr = VecGetArray(v, &array);CHKERRQ(ierr);
MLPutFunction(link, "EvaluatePacket", 1);
MLPutSymbol(link, name);
MLEndPacket(link);
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);CHKERRQ(ierr);
MLGetRealList(link, &mArray, &mSize);
if (n != mSize) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG, "Incompatible vector sizes %d %d",n,mSize);
ierr = PetscMemcpy(array, mArray, mSize * sizeof(double));CHKERRQ(ierr);
MLDisownRealList(link, mArray, mSize);
ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void dd_MLWriteAmatrix(dd_Amatrix A, long rowmax, long colmax)
{
long i,j;
double a;
if (A==NULL){
rowmax=0; colmax=0;
}
MLPutFunction(stdlink,"List",rowmax);
for (i=0; i < rowmax; i++) {
MLPutFunction(stdlink,"List",colmax);
for (j=0; j < colmax; j++) {
a=dd_get_d(A[i][j]);
MLPutDouble(stdlink, a);
}
}
}
void dd_MLWriteSet(set_type S)
{
long j;
MLPutFunction(stdlink,"List",set_card(S));
for (j=1; j <= S[0]; j++) {
if (set_member(j, S)) MLPutLongInteger(stdlink, j);
}
}
Alias<ISink> MmaSink::outputFunction(const char* x,long L) {
if(!MLPutFunction(d_mlink,x,L)) errorc(__LINE__);
++d_count;
// DO NOT INCLUDE d_count -= L; since this will be done by the new MmaSink
Alias<ISink> al(new MmaSink(*this),Adopt::s_dummy);
#ifdef DEBUG_MMASINK
checkforerror();
#endif
return al;
};
void MmaSink::put(const Variable& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:variable " << this << x.cstring() << '\n';
#endif
MLPutFunction(d_mlink,"ToExpression",1L);
MLPutString(d_mlink,x.cstring());
#ifdef DEBUG_MMASINK
checkforerror();
#endif
++d_count;
};
void MmaSink::put(const GroebnerRule& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:rule " << this << ' ' << x << '\n';
#endif
MLPutFunction(d_mlink,"Rule",2L);
put(x.LHS());
put(x.RHS());
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
void MmaSink::put(const Term& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:term " << this << ' ' << x << '\n';
#endif
MLPutFunction(d_mlink,"Times",2L);
++d_count;
d_count -= 2;
put(x.CoefficientPart());
put(x.MonomialPart());
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
void dd_MLWriteAmatrix(dd_Amatrix A, long rowmax, long colmax)
{
long i,j;
double a;
char *str=NULL;
if (A==NULL){
rowmax=0; colmax=0;
}
MLPutFunction(stdlink,"List",rowmax);
for (i=0; i < rowmax; i++) {
MLPutFunction(stdlink,"List",colmax);
for (j=0; j < colmax; j++) {
#if defined GMPRATIONAL
str=dd_MLGetStrForNumber(A[i][j]);
MLPutString(stdlink, str);
if (str!=NULL) free(str);
#else
a=dd_get_d(A[i][j]);
MLPutDouble(stdlink, a);
#endif
}
}
}
void time_evo(double* eta, long eta_len,
double* ps_in, long ps_len,
double* O_eta, long O_eta_len,
double* O_k, long O_k_len,
double* OmegaBulk, long OBulk_len,
double* opts, long opts_len
){
double ps_out[2*ps_len*(eta_len-1)];
double growth_out[1000];
time_evolution_c(eta, (int*)&eta_len, ps_in, (int*)&ps_len,
O_eta, (int*)&O_eta_len, O_k, (int*)&O_k_len,
OmegaBulk, (int*)&OBulk_len, (double*)ps_out,
(double*)growth_out, opts);
MLPutFunction(stdlink, "List", 2);
MLPutReal64List(stdlink, (double*)ps_out, 2*ps_len*(eta_len-1));
MLPutReal64List(stdlink, (double*)growth_out, 1000);
MLEndPacket(stdlink);
MLFlush(stdlink);
}
void MmaSink::put(const Monomial& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:monomial " << this << ' ' << x << '\n';
#endif
int len = x.numberOfFactors();
if(len==0) {
MLPutInteger(d_mlink,1);
++d_count;
} else if(len==1) {
put(*x.begin());
} else {
MLPutFunction(d_mlink,"NonCommutativeMultiply",len);
++d_count;
d_count -= len;
MonomialIterator w = x.begin();
while(len) {
put(*w);
--len;++w;
};
};
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
void MmaSink::put(const Polynomial& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:polynomial " << this << ' ' << x << '\n';
#endif
int len = x.numberOfTerms();
if(len==0) {
MLPutInteger(d_mlink,0);
++d_count;
} else if(len==1) {
put(*x.begin());
} else {
MLPutFunction(d_mlink,"Plus",len);
++d_count;
d_count -= len;
PolynomialIterator w = x.begin();
while(len) {
put(*w);
--len;++w;
};
};
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
// return list of live handles to Mathematica
// used for debugging
void eng_get_handles() {
MLPutFunction(stdlink, "List", handles.data.size());
for (MatlabHandleSet::mbmap::iterator i = handles.data.begin(); i != handles.data.end(); ++i)
MLPutInteger(stdlink, i->first);
}
void putUnknown(const mxArray *var, MLINK link) {
const char *classname = mxGetClassName(var);
MLPutFunction(link, CONTEXT "matUnknown", 1);
MLPutString(link, classname);
}
void dd_MLWriteMatrix(dd_MatrixPtr M)
{
MLPutFunction(stdlink,"List",2);
dd_MLWriteAmatrix(M->matrix, M->rowsize, M->colsize);
dd_MLWriteSet(M->linset);
}
// Takes a MATLAB variable and writes in in Mathematica form to link
void toMma(const mxArray *var, MLINK link) {
// the following may occur when retrieving empty struct fields
// it showsup as [] in MATLAB so we return {}
// note that non-existent variables are caught and handled in eng_get()
if (var == NULL) {
MLPutFunction(link, "List", 0);
return;
}
// get size information
mwSize depth = mxGetNumberOfDimensions(var);
const mwSize *mbDims = mxGetDimensions(var);
// handle zero-size arrays
if (mxIsEmpty(var)) {
if (mxIsChar(var))
MLPutString(link, "");
else
MLPutFunction(link, "List", 0);
return;
}
// translate dimension information to Mathematica order
std::vector<int> mmDimsVec(depth);
std::reverse_copy(mbDims, mbDims + depth, mmDimsVec.begin());
int *mmDims = &mmDimsVec[0];
int len = mxGetNumberOfElements(var);
// numerical (sparse or dense)
if (mxIsNumeric(var)) {
mxClassID classid = mxGetClassID(var);
// verify that var is of a supported class
switch (classid) {
case mxDOUBLE_CLASS:
case mxSINGLE_CLASS:
case mxINT32_CLASS:
case mxINT16_CLASS:
case mxUINT16_CLASS:
case mxINT8_CLASS:
case mxUINT8_CLASS:
break;
default:
putUnknown(var, link);
return;
}
if (mxIsSparse(var)) {
// Note: I realised that sparse arrays can only hold double precision numerical types
// in MATLAB R2013a. I will leave the below implementation for single precision & integer
// types in case future versions of MATLAB will add support for them.
int ncols = mxGetN(var); // number of columns
mwIndex *jc = mxGetJc(var);
mwIndex *ir = mxGetIr(var);
int nnz = jc[ncols]; // number of nonzeros
MLPutFunction(link, CONTEXT "matSparseArray", 4);
mlpPutIntegerList(link, jc, ncols + 1);
mlpPutIntegerList(link, ir, nnz);
// if complex, put as im*I + re
if (mxIsComplex(var)) {
MLPutFunction(link, "Plus", 2);
MLPutFunction(link, "Times", 2);
MLPutSymbol(link, "I");
switch (classid) {
case mxDOUBLE_CLASS:
MLPutReal64List(link, mxGetPi(var), nnz); break;
case mxSINGLE_CLASS:
MLPutReal32List(link, (float *) mxGetImagData(var), nnz); break;
case mxINT16_CLASS:
MLPutInteger16List(link, (short *) mxGetImagData(var), nnz); break;
case mxINT32_CLASS:
MLPutInteger32List(link, (int *) mxGetImagData(var), nnz); break;
default:
assert(false); // should never reach here
}
}
switch (classid) {
case mxDOUBLE_CLASS:
MLPutReal64List(link, mxGetPr(var), nnz); break;
case mxSINGLE_CLASS:
MLPutReal32List(link, (float *) mxGetData(var), nnz); break;
case mxINT16_CLASS:
MLPutInteger16List(link, (short *) mxGetData(var), nnz); break;
case mxINT32_CLASS:
MLPutInteger32List(link, (int *) mxGetData(var), nnz); break;
default:
assert(false); // should never reach here
}
MLPutInteger32List(link, mmDims, depth);
}
else // not sparse
{
MLPutFunction(link, CONTEXT "matArray", 2);
// if complex, put as im*I + re
if (mxIsComplex(var)) {
MLPutFunction(link, "Plus", 2);
MLPutFunction(link, "Times", 2);
MLPutSymbol(link, "I");
switch (classid) {
case mxDOUBLE_CLASS:
MLPutReal64Array(link, mxGetPi(var), mmDims, NULL, depth); break;
case mxSINGLE_CLASS:
MLPutReal32Array(link, (float *) mxGetImagData(var), mmDims, NULL, depth); break;
case mxINT32_CLASS:
MLPutInteger32Array(link, (int *) mxGetImagData(var), mmDims, NULL, depth); break;
case mxINT16_CLASS:
MLPutInteger16Array(link, (short *) mxGetImagData(var), mmDims, NULL, depth); break;
case mxUINT16_CLASS:
{
int *arr = new int[len];
unsigned short *mbData = (unsigned short *) mxGetImagData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger32Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
case mxINT8_CLASS:
{
short *arr = new short[len];
char *mbData = (char *) mxGetImagData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger16Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
case mxUINT8_CLASS:
{
short *arr = new short[len];
unsigned char *mbData = (unsigned char *) mxGetImagData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger16Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
default:
assert(false); // should never reach here
}
}
switch (classid) {
case mxDOUBLE_CLASS:
MLPutReal64Array(link, mxGetPr(var), mmDims, NULL, depth); break;
case mxSINGLE_CLASS:
MLPutReal32Array(link, (float *) mxGetData(var), mmDims, NULL, depth); break;
case mxINT32_CLASS:
MLPutInteger32Array(link, (int *) mxGetData(var), mmDims, NULL, depth); break;
case mxINT16_CLASS:
MLPutInteger16Array(link, (short *) mxGetData(var), mmDims, NULL, depth); break;
case mxUINT16_CLASS:
{
int *arr = new int[len];
unsigned short *mbData = (unsigned short *) mxGetData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger32Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
case mxINT8_CLASS:
{
short *arr = new short[len];
char *mbData = (char *) mxGetData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger16Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
case mxUINT8_CLASS:
{
short *arr = new short[len];
unsigned char *mbData = (unsigned char *) mxGetData(var);
std::copy(mbData, mbData + len, arr);
MLPutInteger16Array(link, arr, mmDims, NULL, depth);
delete [] arr;
break;
}
default:
assert(false); // should never reach here
}
MLPutInteger32List(link, mmDims, depth);
}
}
// logical (sparse or dense)
else if (mxIsLogical(var))
if (mxIsSparse(var)) {
int ncols = mxGetN(var); // number of columns
mwIndex *jc = mxGetJc(var);
mwIndex *ir = mxGetIr(var);
mxLogical *logicals = mxGetLogicals(var);
int nnz = jc[ncols]; // number of nonzeros
MLPutFunction(link, CONTEXT "matSparseLogical", 4);
mlpPutIntegerList(link, jc, ncols + 1);
mlpPutIntegerList(link, ir, nnz);
short *integers = new short[nnz];
std::copy(logicals, logicals+nnz, integers);
MLPutInteger16List(link, integers, nnz);
MLPutInteger32List(link, mmDims, depth);
delete [] integers;
}
else // not sparse
{
mxLogical *logicals = mxGetLogicals(var);
short *integers = new short[len];
std::copy(logicals, logicals+len, integers);
MLPutFunction(link, CONTEXT "matLogical", 2);
MLPutInteger16Array(link, integers, mmDims, NULL, depth);
MLPutInteger32List(link, mmDims, depth);
delete [] integers;
}
// char array
else if (mxIsChar(var)) {
assert(sizeof(mxChar) == sizeof(unsigned short));
// 1 by N char arrays (row vectors) are sent as a string
if (depth == 2 && mbDims[0] == 1) {
const mxChar *str = mxGetChars(var);
MLPutFunction(link, CONTEXT "matString", 1);
MLPutUTF16String(link, reinterpret_cast<const unsigned short *>(str), len); // cast may be required on other platforms: (mxChar *) str
}
// general char arrays are sent as an array of characters
else {
MLPutFunction(link, CONTEXT "matCharArray", 2);
const mxChar *str = mxGetChars(var);
MLPutFunction(link, "List", len);
for (int i=0; i < len; ++i)
MLPutUTF16String(link, reinterpret_cast<const unsigned short *>(str + i), 1);
MLPutInteger32List(link, mmDims, depth);
}
}
// struct
else if (mxIsStruct(var)) {
int nfields = mxGetNumberOfFields(var);
MLPutFunction(link, CONTEXT "matStruct", 2);
MLPutFunction(link, "List", len);
for (int j=0; j < len; ++j) {
MLPutFunction(link, "List", nfields);
for (int i=0; i < nfields; ++i) {
const char *fieldname;
fieldname = mxGetFieldNameByNumber(var, i);
MLPutFunction(link, "Rule", 2);
MLPutString(link, fieldname);
toMma(mxGetFieldByNumber(var, j, i), link);
}
}
MLPutInteger32List(link, mmDims, depth);
}
// cell
else if (mxIsCell(var)) {
MLPutFunction(link, CONTEXT "matCell", 2);
MLPutFunction(link, "List", len);
for (int i=0; i < len; ++i)
toMma(mxGetCell(var, i), link);
MLPutInteger32List(link, mmDims, depth);
}
// unknown or failure; TODO distinguish between unknown and failure
else
{
putUnknown(var, link);
}
}
void engget(const char* VarName)
{
mxArray* MxVar = NULL; //pointer for the variable to get
const mwSize* dimlab = NULL; //MATLAB dimension
long* dimma = NULL; //Mathematica dimension
int Depth = 0; //depth
double* Pr = NULL; //pointer to real
double* Pi = NULL; //pointer to imaginary
bool SUCCESS = true; //status flag
int i; //for loop
if (NULL == Eng) //if MATLAB not opened
{
msg("eng::noMLB"); //message no start
SUCCESS = false;
goto epilog;
}
if (NULL == (MxVar = engGetVariable(Eng, VarName))) //get variable
{
msg("engGet::erget");
SUCCESS = false;
goto epilog;
}
if(!mxIsNumeric(MxVar))
{
msg("engGet::ertp");
SUCCESS = false;
goto epilog;
}
//retrive size information
Depth = mxGetNumberOfDimensions(MxVar);
dimlab = mxGetDimensions(MxVar);
//translate dimension information to Mathematica
dimma = mxCalloc(Depth, sizeof(long));
for(i=0; i<Depth; ++i)
dimma[i] = dimlab[Depth - 1 - i];
//data pointer
Pr = (double*)mxGetPr(MxVar);
Pi = (double*)mxGetPi(MxVar);
epilog:
if(SUCCESS)
{
if(mxIsComplex(MxVar))
{
//output re+im*I
MLPutFunction(stdlink, "Plus", 2);
MLPutRealArray(stdlink, Pr, dimma, NULL, Depth);
MLPutFunction(stdlink, "Times", 2);
MLPutRealArray(stdlink, Pi, dimma, NULL, Depth);
MLPutSymbol(stdlink, "I");
}
else
MLPutRealArray(stdlink, Pr, dimma, NULL, Depth);
//clean
mxDestroyArray(MxVar);
mxFree(dimma);
}
else
{
if(NULL != MxVar)
mxDestroyArray(MxVar);
if(NULL != dimma)
mxFree(dimma);
MLPutSymbol(stdlink, "$Failed");
}
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
typedef struct pool {
struct pool *next;
Region region[POOLSIZE];
} Pool;
count dim, comp, ncur, ipool, npool;
int fail;
Totals totals[NCOMP];
Pool *cur = NULL, *pool;
Region *region;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Cuhre input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n"
" key " COUNT,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->mineval, t->maxeval,
t->key);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
t->epsabs = Max(t->epsabs, NOTZERO);
RuleAlloc(t);
t->mineval = IMax(t->mineval, t->rule.n + 1);
FrameAlloc(t, ShmRm(t));
ForkCores(t);
if( (fail = setjmp(t->abort)) ) goto abort;
Alloc(cur, 1);
cur->next = NULL;
ncur = 1;
region = cur->region;
region->div = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = ®ion->bounds[dim];
b->lower = 0;
b->upper = 1;
}
Sample(t, region);
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
Result *r = ®ion->result[comp];
tot->avg = tot->lastavg = tot->guess = r->avg;
tot->err = tot->lasterr = r->err;
tot->weightsum = 1/Max(Sq(r->err), NOTZERO);
tot->avgsum = tot->weightsum*r->avg;
tot->chisq = tot->chisqsum = tot->chisum = 0;
}
for( t->nregions = 1; ; ++t->nregions ) {
count maxcomp, bisectdim;
real maxratio, maxerr;
Result result[NCOMP];
Region *regionL, *regionR;
Bounds *bL, *bR;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
t->nregions, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, t->nregions - 1);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && t->neval >= t->mineval ) break;
if( t->neval >= t->maxeval ) {
fail = 1;
break;
}
maxerr = -INFTY;
regionL = cur->region;
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region *region = &pool->region[ipool];
creal err = region->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
regionL = region;
}
}
if( ncur == POOLSIZE ) {
Pool *prev = cur;
Alloc(cur, 1);
cur->next = prev;
ncur = 0;
}
regionR = &cur->region[ncur++];
regionR->div = ++regionL->div;
FCopy(result, regionL->result);
XCopy(regionR->bounds, regionL->bounds);
bisectdim = result[maxcomp].bisectdim;
bL = ®ionL->bounds[bisectdim];
bR = ®ionR->bounds[bisectdim];
bL->upper = bR->lower = .5*(bL->upper + bL->lower);
Sample(t, regionL);
Sample(t, regionR);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = &result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Totals *tot = &totals[comp];
real diff, err, w, avg, sigsq;
tot->lastavg += diff = rL->avg + rR->avg - r->avg;
diff = fabs(.25*diff);
err = rL->err + rR->err;
if( err > 0 ) {
creal c = 1 + 2*diff/err;
rL->err *= c;
rR->err *= c;
}
rL->err += diff;
rR->err += diff;
tot->lasterr += rL->err + rR->err - r->err;
tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO);
sigsq = 1/tot->weightsum;
tot->avgsum += w*tot->lastavg;
avg = sigsq*tot->avgsum;
tot->chisum += w *= tot->lastavg - tot->guess;
tot->chisqsum += w*tot->lastavg;
tot->chisq = tot->chisqsum - avg*tot->chisum;
if( LAST ) {
tot->avg = tot->lastavg;
tot->err = tot->lasterr;
}
else {
tot->avg = avg;
tot->err = sqrt(sigsq);
}
}
}
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
integral[comp] = tot->avg;
error[comp] = tot->err;
prob[comp] = ChiSquare(tot->chisq, t->nregions - 1);
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", t->nregions);
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region const *region = &pool->region[ipool];
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
lower[dim] = b->lower;
upper[dim] = b->upper;
}
MLPutFunction(stdlink, "Cuba`Cuhre`region", 3);
MLPutRealList(stdlink, lower, t->ndim);
MLPutRealList(stdlink, upper, t->ndim);
MLPutFunction(stdlink, "List", t->ncomp);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
real res[] = {r->avg, r->err};
MLPutRealList(stdlink, res, Elements(res));
}
}
}
#endif
abort:
while( (pool = cur) ) {
cur = cur->next;
free(pool);
}
WaitCores(t);
FrameFree(t);
RuleFree(t);
return fail;
}
PetscErrorCode PetscViewerMathematicaPutCSRMatrix(PetscViewer viewer, int m, int n, int *i, int *j, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
const char *symbol;
char *name;
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Make sure Mathematica recognizes sparse matrices */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Needs", 1);
MLPutString(link, "LinearAlgebra`CSRMatrix`");
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Send the CSRMatrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "CSRMatrix", 5);
MLPutInteger(link, m);
MLPutInteger(link, n);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, i, m+1);
MLPutInteger(link, 1);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, j, i[m]);
MLPutInteger(link, 1);
MLPutRealList(link, a, i[m]);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Check that matrix is valid */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "ValidQ", 1);
MLPutSymbol(link, name);
MLEndPacket(link);
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
MLGetSymbol(link, &symbol);
ierr = PetscStrcmp("True", (char*) symbol, &match);
CHKERRQ(ierr);
if (!match) {
MLDisownSymbol(link, symbol);
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid CSR matrix in Mathematica");
}
MLDisownSymbol(link, symbol);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
void sload(const char *fn, int *SZ, long SZlen) {
uint16_t numberChannels;
size_t k=0;
size_t numberSamples;
double samplerate;
double *t;
char *str = NULL;
#ifdef _WIN32
long int sz[2];
#else
size_t sz[2];
#endif
biosig_data_type *data;
#ifdef __LIBBIOSIG2_H__
size_t rowcol[2];
#endif
HDRTYPE *hdr = constructHDR(0,0);
if (VERBOSE_LEVEL > 5)
fprintf(stdout,"=== start sload ===\n");
/* contains [experiment,series,sweep,trace] numbers for selecting data. */
while ((k < SZlen) && (k < 5)) {
#ifdef __LIBBIOSIG2_H__
biosig_set_segment_selection(hdr, k+1, SZ[k]);
#else
hdr->AS.SegSel[k] = (uint32_t)SZ[k];
#endif
k++;
}
// ********* open file and read header ************
hdr = sopen(fn, "r", hdr);
if (serror2(hdr)) {
destructHDR(hdr);
fprintf(stdout,"Cannot open file <%s>\n", fn);
return;
}
#ifdef __LIBBIOSIG2_H__
numberChannels = biosig_get_number_of_channels(hdr);
numberSamples = biosig_get_number_of_samples(hdr);
samplerate = biosig_get_samplerate(hdr);
biosig_reset_flag(hdr, BIOSIG_FLAG_ROW_BASED_CHANNELS);
#else
numberChannels = hdr->NS;
numberSamples = hdr->NRec * hdr->SPR
samplerate = hdr->SampleRate;
hdr->FLAG.ROW_BASED_CHANNELS = 0;
#endif
if (VERBOSE_LEVEL > 5)
fprintf(stdout,"open filename <%s>NoOfChans=%i\n", fn, numberChannels);
// ********** read data ********************
sread(NULL, 0, numberSamples, hdr);
if (serror2(hdr)) {
destructHDR(hdr);
fprintf(stdout,"Error reading data from file <%s>\n", fn);
return;
}
#ifdef __LIBBIOSIG2_H__
biosig_get_datablock(hdr, &data, &rowcol[0], &rowcol[1]);
sz[0] = rowcol[1];
sz[1] = rowcol[0];
#else
sz[0] = hdr->data.size[1];
sz[1] = hdr->data.size[0];
data = hdr->data.block;
#endif
MLPutFunction(stdlink, "List", 3);
// write data matrix
MLPutRealArray(stdlink, data, sz, NULL, 2);
// generate and write time axis
t = (double*)malloc(numberSamples * sizeof(double));
for (k=0; k < numberSamples;) {
t[k] = (++k)/samplerate;
}
MLPutRealList(stdlink, t, numberSamples);
free(t);
// generate and write header information in JSON format
asprintf_hdr2json(&str, hdr);
MLPutString(stdlink, str);
free(str);
if (VERBOSE_LEVEL > 5) {
for (k=0; k<numberChannels; k++)
fprintf(stdout,"%f ",data[k]);
fprintf(stdout,"\n\nopen filename <%s>@%p sz=[%i,%i]\n", fn, data, sz[1],sz[0]);
}
// *********** close file *********************
sclose(hdr);
destructHDR(hdr);
return;
}
