// Parameter order:
// inits
// params
// duration
EXTERN_C DLLEXPORT int runODE(WolframLibraryData libData, mint argc, MArgument *argv, MArgument aResult)
{
MTensor tensorInits = MArgument_getMTensor(argv[0]);
MTensor tensorParams = MArgument_getMTensor(argv[1]);
double duration = MArgument_getReal(argv[2]);
double dt = MArgument_getReal(argv[3]);
mint rankState = (mint)(sizeof(ODESTATE) / sizeof(double));
mint rankParams = (mint)(sizeof(ODEPARAMETERS) / sizeof(double));
// Trace("state:%d params:%d", rankState, rankParams);
ODESTATE inits;
ODEPARAMETERS parameters;
copyFromTensor(libData, (double*)&inits, rankState, tensorInits);
copyFromTensor(libData, (double*)¶meters, rankParams, tensorParams);
ODESTATE result = runODECore(inits, parameters, duration, dt);
MTensor tensorResult;
libData->MTensor_new(MType_Real, 1, &rankState, &tensorResult);
copyToTensor(libData, tensorResult, (double*)&result, rankState);
MArgument_setMTensor(aResult, tensorResult);
return LIBRARY_NO_ERROR;
}
/* Sets the I0 th element in T0 to its value in T1 */
DLLEXPORT int demo_TTI_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0, T1;
mint I0;
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
T1 = MArgument_getMTensor(Args[1]);
I0 = MArgument_getInteger(Args[2]);
err = libData->MTensor_setMTensor(T0, T1, &I0, 1);
MArgument_setMTensor(Res, T0);
return err;
}
/* Accepts inputs, but returns nothing */
DLLEXPORT int demoNoResult(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
MTensor T = MArgument_getMTensor(Args[0]);
mint *p = libData->MTensor_getIntegerData(T);
*p = MArgument_getAddress(Res) == 0? 0:1;
return LIBRARY_NO_ERROR;
}
/**
* Constructs a copy of the input tensor with the number of elements,
* rank, and type appended at the end.
**/
DLLEXPORT int demo_T_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T_arg, T_res;
mint i, rank, type, num, len;
mint const* dims;
mint* intData;
mint* intDataNew;
mreal* realData;
mreal* realDataNew;
int err = LIBRARY_NO_ERROR;
T_arg = MArgument_getMTensor(Args[0]);
rank = libData->MTensor_getRank(T_arg);
type = libData->MTensor_getType(T_arg);
dims = libData->MTensor_getDimensions(T_arg);
num = libData->MTensor_getFlattenedLength(T_arg);
/*
The result is going to have all the elements, also
the length of each dimension, number of elems, rank and type.
*/
len = num + rank + 3;
err = libData->MTensor_new(type, 1, &len, &T_res);
if (err) return err;
if ( type == MType_Integer) {
intData = libData->MTensor_getIntegerData(T_arg);
intDataNew = libData->MTensor_getIntegerData(T_res);
for ( i = 0; i < num; i++) {
intDataNew[i] = intData[i];
}
for ( i = 0; i < rank; i++) {
intDataNew[i+num] = dims[i];
}
intDataNew[num+rank] = num;
intDataNew[num+rank+1] = rank;
intDataNew[num+rank+2] = type;
}
else if ( type == MType_Real) {
realData = libData->MTensor_getRealData(T_arg);
realDataNew = libData->MTensor_getRealData(T_res);
for ( i = 0; i < num; i++) {
realDataNew[i] = realData[i];
}
for ( i = 0; i < rank; i++) {
realDataNew[i+num] = dims[i];
}
realDataNew[num+rank] = num;
realDataNew[num+rank+1] = rank;
realDataNew[num+rank+2] = type;
}
MArgument_setMTensor(Res, T_res);
return LIBRARY_NO_ERROR;
}
/**
* Same as demo_TI_R, but just to avoid copying
**/
DLLEXPORT int demo_TT_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0, T1, T2;
mint I0;
mreal R0;
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
T1 = MArgument_getMTensor(Args[1]);
I0 = (libData->MTensor_getIntegerData(T1))[0];
err = libData->MTensor_getReal( T0, &I0, &R0);
if (err) return err;
err = libData->MTensor_new(MType_Real, 0, NULL, &T2);
if (err) return err;
(libData->MTensor_getRealData(T2))[0] = R0;
MArgument_setMTensor(Res, T2);
return LIBRARY_NO_ERROR;
}
/* Gets the I0th element of T0, returning that value */
DLLEXPORT int demo_T_I(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0;
mint I0, res;
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
I0 = MArgument_getInteger(Args[1]);
err = libData->MTensor_getInteger(T0, &I0, &res);
MArgument_setInteger(Res, res);
return err;
}
/* Gets the I0 th Real number from the rank 1 tensor T0 */
DLLEXPORT int demo_TI_R( WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0;
mint I0;
mreal R0;
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
I0 = MArgument_getInteger(Args[1]);
err = libData->MTensor_getReal(T0, &I0, &R0);
if (err) return err;
MArgument_setReal(Res, R0);
return LIBRARY_NO_ERROR;
}
/**
* Intended to demonstrate working with rank 0 tensors.
*
* The arguments are three tensors.
* The first is a rank > 0 real tensor.
* The second is a rank 0 integer tensor.
* The third a rank 0 real tensor.
*
* The second argument is used as an index to find
* an element of the first, which is added to the
* third argument to form the result.
*
* The result is returned as a rank 0 real tensor.
**/
DLLEXPORT int demo_TTT_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T_arg, T_I_arg, T_R_arg, T_res;
mint I0;
mreal R0, R1;
int err = LIBRARY_NO_ERROR;
T_arg = MArgument_getMTensor(Args[0]);
T_I_arg = MArgument_getMTensor(Args[1]);
T_R_arg = MArgument_getMTensor(Args[2]);
I0 = (libData->MTensor_getIntegerData(T_I_arg))[0];
R0 = (libData->MTensor_getRealData(T_R_arg))[0];
err = libData->MTensor_getReal( T_arg, &I0, &R1);
if (err) return err;
R0 = R0 + R1;
err = libData->MTensor_new(MType_Integer, 0, NULL, &T_res);
if (err) return err;
(libData->MTensor_getIntegerData( T_res))[0] = (mint) R0;
MArgument_setMTensor(Res, T_res);
return LIBRARY_NO_ERROR;
}
DLLEXPORT int brusselator_pde_jacobian_values(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err;
mint i, j, k, n, nr;
mreal dm;
mreal *u, *v, *jval;
MTensor Tres, Targ;
Targ = MArgument_getMTensor(Args[1]);
if (libData->MTensor_getType(Targ) != MType_Real) return LIBRARY_TYPE_ERROR;
if (libData->MTensor_getRank(Targ) != 1) return LIBRARY_RANK_ERROR;
nr = libData->MTensor_getFlattenedLength(Targ);
n = nr/2;
u = libData->MTensor_getRealData(Targ);
v = u + n;
nr = 4 + 8*(n - 2);
err = libData->MTensor_new(MType_Real, 1, &nr, &Tres);
if (err) return err;
jval = libData->MTensor_getRealData(Tres);
/* Decrement n so loop excludes boundaries */
n--;
dm = (mreal) n;
dm *= alpha*dm;
k = 0;
jval[k++] = -1.; /* u[0] bc */
for (i = 1; i < n; i++) {
/* u equations */
jval[k++] = dm;
jval[k++] = 2.*u[i]*v[i] - 4. - 2.*dm;
jval[k++] = dm;
jval[k++] = u[i]*u[i];
}
jval[k++] = -1.; /* u[n] bc */
jval[k++] = -1.; /* v[0] bc */
for (i = 1; i < n; i++) {
/* v equations */
jval[k++] = 3. - 2.*u[i]*v[i];
jval[k++] = dm;
jval[k++] = -u[i]*u[i] - 2.*dm;
jval[k++] = dm;
}
jval[k++] = -1.; /* v[n] bc */
MArgument_setMTensor(Res, Tres);
return 0;
}
EXTERN_C DLLEXPORT int SendFrame(WolframLibraryData libData, mint Argc, MArgument * Args, MArgument Res) {
MTensor T0 = MArgument_getMTensor(Args[0]);
mint len = libData->MTensor_getFlattenedLength(T0);
// check that we have the right amount of data
UINT32 expectedlength = VW.m_height * VW.m_width * 3;
if (len != (mint) expectedlength)
{
libData->Message("dimensionsfail");
return LIBRARY_FUNCTION_ERROR;
}
// get a buffer
BYTE *pData = NULL;
hr = VW.getWriteBuffer(&pData);
if (FAILED(hr))
{
libData->Message("getwritebufferfail");
return LIBRARY_FUNCTION_ERROR;
}
// fill the buffer
mint *mtdata;
int npixels = len / 3;
mtdata = libData->MTensor_getIntegerData(T0);
for (int i = 0; i < npixels; i++) {
// we read R, G, B bytes and put B, G, R, A into the pixel buffer
pData[4 * i + 2] = (BYTE) mtdata[3 * i ]; // R
pData[4 * i + 1] = (BYTE) mtdata[3 * i + 1]; // G
pData[4 * i ] = (BYTE) mtdata[3 * i + 2]; // B
pData[4 * i + 3] = 0; // A
}
// write the sample
hr = VW.writeFrame(pData);
if (FAILED(hr))
{
libData->Message("writeFramefail");
return LIBRARY_FUNCTION_ERROR;
}
// return the timestamp to Mathematica
MArgument_setInteger(Res, VW.m_rtStart);
return LIBRARY_NO_ERROR;
}
DLLEXPORT int start_mtensor_background_task(WolframLibraryData libData,
mint Argc, MArgument *Args, MArgument Res)
{
mint asyncObjID;
WolframIOLibrary_Functions ioLibrary = libData->ioLibraryFunctions;
MTensorBackgroundArgs threadArg = (MTensorBackgroundArgs)malloc(sizeof(struct MTensorBackgroundArgs_st));
if(Argc != 2)
return LIBRARY_FUNCTION_ERROR;
threadArg->ioLibrary = ioLibrary;
threadArg->pausemillis = MArgument_getInteger(Args[0]);
threadArg->eventdata = MArgument_getMTensor(Args[1]);
asyncObjID = ioLibrary->createAsynchronousTaskWithThread(MTensorBackgroundTask, threadArg);
MArgument_setInteger(Res, asyncObjID);
return LIBRARY_NO_ERROR;
}
/* Gets the subpart of the input tensor starting at the I0,I1 th position */
DLLEXPORT int demo_TII_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0, T1 = 0;
mint I0, I1;
mint pos[2];
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
I0 = MArgument_getInteger(Args[1]);
I1 = MArgument_getInteger(Args[2]);
pos[0] = I0;
pos[1] = I1;
err = libData->MTensor_getMTensor(T0, pos, 2, &T1);
MArgument_setMTensor(Res, T1);
return err;
}
/* Gets the I0,I1 th integer element of T0 returning that value */
DLLEXPORT int demo_TII_I(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0;
mint I0, I1, res;
mint dims[2];
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
I0 = MArgument_getInteger(Args[1]);
I1 = MArgument_getInteger(Args[2]);
dims[0] = I0;
dims[1] = I1;
err = libData->MTensor_getInteger(T0, dims, &res);
MArgument_setInteger(Res, res);
return err;
}
DLLEXPORT int brusselator_pde_jacobian_positions(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err;
mint dims[2];
mint i, j, k, n, nr;
mint *jpos;
MTensor Tres, Targ;
Targ = MArgument_getMTensor(Args[1]);
if (libData->MTensor_getType(Targ) != MType_Real) return LIBRARY_TYPE_ERROR;
if (libData->MTensor_getRank(Targ) != 1) return LIBRARY_RANK_ERROR;
nr = libData->MTensor_getFlattenedLength(Targ);
n = nr/2;
dims[0] = 4 + 8*(n - 2);
dims[1] = 2;
err = libData->MTensor_new(MType_Integer, 2, dims, &Tres);
if (err) return err;
jpos = libData->MTensor_getIntegerData(Tres);
/* Decrement n so loop excludes boundaries */
n--;
k = 0;
jpos[k++] = 1; jpos[k++] = 1; /* u[0] bc */
for (i = 1; i < n; i++) {
/* u equations */
mint r = i + 1;
jpos[k++] = r; jpos[k++] = i;
jpos[k++] = r; jpos[k++] = i + 1;
jpos[k++] = r; jpos[k++] = i + 2;
jpos[k++] = r; jpos[k++] = i + n + 2;
}
jpos[k++] = n + 1; jpos[k++] = n + 1; /* u[n] bc */
jpos[k++] = n + 2; jpos[k++] = n + 2; /* v[0] bc */
for (i = 1; i < n; i++) {
/* v equations */
mint r = i + n + 2;
jpos[k++] = r; jpos[k++] = i + 1;
jpos[k++] = r; jpos[k++] = i + n + 1;
jpos[k++] = r; jpos[k++] = i + n + 2;
jpos[k++] = r; jpos[k++] = i + n + 3;
}
jpos[k++] = 2*(n + 1); jpos[k++] = 2*(n + 1); /* v[n] bc */
MArgument_setMTensor(Res, Tres);
return 0;
}
/* Sets the I0,I1 th real element of T0 with value, returning that position */
DLLEXPORT int demo_TIIR_R(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
MTensor T0;
mint I0, I1;
mreal value, res;
mint dims[2];
int err = LIBRARY_NO_ERROR;
T0 = MArgument_getMTensor(Args[0]);
I0 = MArgument_getInteger(Args[1]);
I1 = MArgument_getInteger(Args[2]);
value = MArgument_getReal(Args[3]);
dims[0] = I0;
dims[1] = I1;
err = libData->MTensor_setReal(T0, dims, value);
if (err) return err;
err = libData->MTensor_getReal(T0, dims, &res);
MArgument_setReal(Res, res);
return err;
}
DLLEXPORT int brusselator_pde_rhs(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err;
mint i, j, n, nr;
mreal dm, uuv;
mreal *u, *v, *up, *vp;
MTensor Tres, Targ;
Targ = MArgument_getMTensor(Args[1]);
if (libData->MTensor_getType(Targ) != MType_Real) return LIBRARY_TYPE_ERROR;
if (libData->MTensor_getRank(Targ) != 1) return LIBRARY_RANK_ERROR;
nr = libData->MTensor_getFlattenedLength(Targ);
n = nr/2;
u = libData->MTensor_getRealData(Targ);
v = u + n;
err = libData->MTensor_new(MType_Real, 1, &nr, &Tres);
if (err) return err;
up = libData->MTensor_getRealData(Tres);
vp = up + n;
/* Decrement n so loop excludes boundaries */
n--;
dm = (mreal) n;
dm *= alpha*dm;
/* Boundary conditions to converge to correct values */
up[0] = 1. - u[0];
up[n] = 1. - u[n];
vp[0] = 3. - v[0];
vp[n] = 3. - v[n];
for (i = 1; i < n; i++) {
mreal uuv = u[i];
uuv *= uuv*v[i];
up[i] = 1. + uuv - 4.*u[i] + dm*(u[i - 1] - 2.*u[i] + u[i + 1]);
vp[i] = 3.*u[i] - uuv + dm*(v[i - 1] - 2.*v[i] + v[i + 1]);
}
MArgument_setMTensor(Res, Tres);
return 0;
}
DLLEXPORT int duffing_crk4(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err = 0;
mint i, n, nh, rank;
mint const *dims;
mreal t0, t1, h;
mreal *x, *xr, *k, *k0, *k1, *k2, *k3;
MTensor Targ, Tres;
Targ = MArgument_getMTensor(Args[0]);
t0 = MArgument_getReal(Args[1]);
t1 = MArgument_getReal(Args[2]);
h = t1 - t0;
if (h < 0) return LIBRARY_FUNCTION_ERROR;
n = (libData->MTensor_getFlattenedLength)(Targ);
nh = n/2;
if (n != nh*2) return LIBRARY_DIMENSION_ERROR;
x = (libData->MTensor_getRealData)(Targ);
k = (mreal *) malloc(4*n*sizeof(mreal));
k0 = k; k1 = k0 + n; k2 = k1 + n; k3 = k2 + n;
for (i = 0; i < n; i++) k0[i] = x[i];
err = duffing_rhs(nh, t0, k0, k0 + nh);
for (i = 0; i < n; i++) {
k0[i] *= h;
k1[i] = x[i] + 0.5*k0[i];
}
err = duffing_rhs(nh, t0 + h/2, k1, k1 + nh);
if (err) goto clean_up;
for (i = 0; i < n; i++) {
k1[i] *= h;
k2[i] = x[i] + 0.5*k1[i];
}
err = duffing_rhs(nh, t0 + h/2, k2, k2 + nh);
if (err) goto clean_up;
for (i = 0; i < n; i++) {
k2[i] *= h;
k3[i] = x[i] + k2[i];
}
err = duffing_rhs(nh, t1, k3, k3 + nh);
if (err) goto clean_up;
rank = (libData->MTensor_getRank)(Targ);
dims = (libData->MTensor_getDimensions)(Targ);
err = (libData->MTensor_new)(MType_Real, rank, dims, &Tres);
if (err) goto clean_up;
xr =(libData->MTensor_getRealData)(Tres);
for (i = 0; i < n; i++)
xr[i] = x[i] + (k0[i] + 2.*(k1[i] + k2[i]) + h*k3[i])/6.;
MArgument_setMTensor(Res, Tres);
clean_up:
free(k);
return err;
}
DLLEXPORT int refine(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err;
mint i, j, k, m, n, nr;
mint const * dims;
mint rdims[2];
mreal dist, distsq;
mreal x1, x2, dx, y1, y2, dy, d, s, ds;
mreal *x, *y, *rx, *ry;
MTensor Targ, Tres;
dist = MArgument_getReal(Args[0]);
distsq = dist*dist*(1. + 1.e-8); /* Avoid adding extra points due to roundoff */
Targ = MArgument_getMTensor(Args[1]);
if (libData->MTensor_getType(Targ) != MType_Real) return LIBRARY_TYPE_ERROR;
if (libData->MTensor_getRank(Targ) != 2) return LIBRARY_RANK_ERROR;
dims = (libData->MTensor_getDimensions)(Targ);
if (dims[0] != 2) return LIBRARY_DIMENSION_ERROR;
n = dims[1];
x = libData->MTensor_getRealData(Targ);
y = x + n;
/* Do a pass to determine the length of the result */
x2 = x[0];
y2 = y[0];
nr = n;
for (i = 1; i < n; i++) {
x1 = x2;
y1 = y2;
x2 = x[i];
y2 = y[i];
dx = x2 - x1;
dy = y2 - y1;
d = dx*dx + dy*dy;
if (d > distsq) {
d = sqrt(d);
k = ((mint) ceil(d/dist)) - 1;
nr += k;
}
}
rdims[0] = 2;
rdims[1] = nr;
err = libData->MTensor_new(MType_Real, 2, rdims, &Tres);
if (err) return err;
rx = libData->MTensor_getRealData(Tres);
ry = rx + nr;
x2 = x[0];
y2 = y[0];
rx[0] = x2;
ry[0] = y2;
for (j = i = 1; i < n; i++, j++) {
x1 = x2;
y1 = y2;
x2 = x[i];
y2 = y[i];
dx = x2 - x1;
dy = y2 - y1;
d = dx*dx + dy*dy;
if (d > distsq) {
d = sqrt(d);
k = ((mint) ceil(d/dist)) - 1;
ds = 1./((mreal) (k + 1));
for (m = 1; m <= k; m++, j++) {
s = m*ds;
rx[j] = x1 + s*dx;
ry[j] = y1 + s*dy;
}
}
rx[j] = x2;
ry[j] = y2;
}
MArgument_setMTensor(Res, Tres);
return 0;
}
