/*
* hand written interface
* Interface for cdfchn
* Non-central Chi-Square
*/
int cdfchnI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mDf = 0, nDf = 0, lDf = 0, i = 0;
double *Df = NULL;
Nbvars = 0;
CheckRhs(4, 5);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[5] = {3, 4, 0, 1, 2};
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 3);
}
CdfBase(fname, 3, 2, callpos, "PQ", _("X,Df and Pnonc"), 1, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "X") == 0)
{
static int callpos[5] = {2, 3, 4, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 2);
}
CdfBase(fname, 4, 1, callpos, "X", _("Df,Pnonc,P and Q"), 2, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Df") == 0)
{
static int callpos[5] = {1, 2, 3, 4, 0};
CdfBase(fname, 4, 1, callpos, "Df", _("Pnonc,P,Q and X"), 3, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Pnonc") == 0)
{
static int callpos[5] = {0, 1, 2, 3, 4};
GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 5);
}
CdfBase(fname, 4, 1, callpos, "Pnonc", _("P,Q,X and Df"), 4, C2F(cdfchn),
cdfchnErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "X", "Df", "Pnonc");
}
return 0;
}
/*--------------------------------------------------------------------------*/
int cdfpoiI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mS = 0, nS = 0, lS = 0, i = 0;
double *S = NULL;
Nbvars = 0;
CheckRhs(3, 4);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[4] = {2, 3, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 2);
return 0;
}
CdfBase(fname, 2, 2, callpos, "PQ", _("S and Xlam"), 1, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "S") == 0)
{
static int callpos[4] = {1, 2, 3, 0};
CdfBase(fname, 3, 1, callpos, "S", _("Xlam,P and Q"), 2, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "Xlam") == 0)
{
static int callpos[4] = {0, 1, 2, 3};
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 4);
return 0;
}
CdfBase(fname, 3, 1, callpos, "Xlam", _("P,Q and S"), 3, C2F(cdfpoi),
cdfpoiErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "S", "Xlam");
}
return 0;
}
int cdf_generic(char *fname, void* pvApiCtx, struct cdf_descriptor *cdf)
{
int iErr = 0;
struct cdf_item const * it;
char *option;
CheckRhs(cdf->minrhs, cdf->maxrhs);
CheckLhs(cdf->minlhs, cdf->maxlhs);
option = create_string(pvApiCtx, 1);
for (it = cdf->items; it != cdf->end_item; ++it)
{
if (strcmp(option, it->option) == 0)
{
/* "which" argument (5th) inferred from position in item list */
iErr = CdfBase(fname, pvApiCtx, it->inarg, it->oarg, it->shift, it - cdf->items + 1, cdf->fun);
break;
}
}
destroy_string(option);
if (it == cdf->end_item)
{
/* no target found */
char *optlist;
optlist = cdf_options(cdf);
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), fname, 1, optlist);
FREE(optlist);
return 1;
}
return iErr;
}
/*--------------------------------------------------------------------------*/
int cdfbinI(char* fname,unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0;
Nbvars = 0;
CheckRhs(5,6);
CheckLhs(1,2);
GetRhsVar(1,STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1),"PQ")==0)
{
static int callpos[6] = {4,5,0,1,2,3};
CdfBase(fname,4,2,callpos,"PQ",_("S,Xn,Pr and Ompr"),1,C2F(cdfbin),
cdfbinErr);
}
else if ( strcmp(cstk(l1),"S")==0)
{
static int callpos[6] = {3,4,5,0,1,2};
CdfBase(fname,5,1,callpos,"S",_("Xn,Pr,Ompr,P and Q"),2,C2F(cdfbin),
cdfbinErr);
}
else if ( strcmp(cstk(l1),"Xn")==0)
{
static int callpos[6] = {2,3,4,5,0,1};
CdfBase(fname,5,1,callpos,"Xn",_("Pr,OMPr,P,Q and S"),3,C2F(cdfbin),
cdfbinErr);
}
else if ( strcmp(cstk(l1),"PrOmpr")==0)
{
static int callpos[6] = {0,1,2,3,4,5};
CdfBase(fname,4,2,callpos,"PrOmpr",_("P,Q,S and Xn"),4,C2F(cdfbin),
cdfbinErr);
}
else
{
Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"),fname,1,"PQ","S","Xn","PrOmpr");
}
return 0;
}
/*--------------------------------------------------------------------------*/
int cdfnorI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0;
Nbvars = 0;
CheckRhs(4, 5);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[5] = {3, 4, 0, 1, 2};
CdfBase(fname, 3, 2, callpos, "PQ", _("X,Mean and Std"), 1, C2F(cdfnor),
cdfnorErr);
}
else if ( strcmp(cstk(l1), "X") == 0)
{
static int callpos[5] = {2, 3, 4, 0, 1};
CdfBase(fname, 4, 1, callpos, "X", _("Mean,Std,P and Q"), 2, C2F(cdfnor),
cdfnorErr);
}
else if ( strcmp(cstk(l1), "Mean") == 0)
{
static int callpos[5] = {1, 2, 3, 4, 0};
CdfBase(fname, 4, 1, callpos, "Mean", _("Std,P,Q and X"), 3, C2F(cdfnor),
cdfnorErr);
}
else if ( strcmp(cstk(l1), "Std") == 0)
{
static int callpos[5] = {0, 1, 2, 3, 4};
CdfBase(fname, 4, 1, callpos, "Std", _("P,Q,X and Mean"), 4, C2F(cdfnor),
cdfnorErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "X", "Mean", "Std");
}
return 0;
}
/*--------------------------------------------------------------------------*/
int cdfbetI(char* fname, unsigned long l)
{
int minrhs = 5, maxrhs = 6, minlhs = 1, maxlhs = 2, m1 = 0, n1 = 0, l1 = 0;
Nbvars = 0;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[6] = {4, 5, 0, 1, 2, 3};
CdfBase(fname, 4, 2, callpos, "PQ", _("X,Y,A and B"), 1, C2F(cdfbet),
cdfbetErr);
}
else if ( strcmp(cstk(l1), "XY") == 0)
{
static int callpos[6] = {2, 3, 4, 5, 0, 1};
CdfBase(fname, 4, 2, callpos, "XY", _("A,B,P and Q"), 2, C2F(cdfbet),
cdfbetErr);
}
else if ( strcmp(cstk(l1), "A") == 0)
{
static int callpos[6] = {1, 2, 3, 4, 5, 0};
CdfBase(fname, 5, 1, callpos, "A", _("B,P,Q,X and Y"), 3, C2F(cdfbet),
cdfbetErr);
}
else if ( strcmp(cstk(l1), "B") == 0)
{
static int callpos[6] = {0, 1, 2, 3, 4, 5};
CdfBase(fname, 5, 1, callpos, "B", _("P,Q,X,Y and A"), 4, C2F(cdfbet),
cdfbetErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "XY", "A", "B");
}
return 0;
}
/*--------------------------------------------------------------------------*/
int cdffncI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mDfd = 0, nDfd = 0, lDfd = 0, mDfn = 0, nDfn = 0, lDfn = 0, i = 0;
double *Dfd = NULL, *Dfn = NULL;
Nbvars = 0;
CheckRhs(5, 6);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[6] = {4, 5, 0, 1, 2, 3};
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mDfn, &nDfn, &lDfn);
Dfn = stk(lDfn);
for (i = 0; i < mDfn * nDfn; ++i)
if ((int) Dfn[i] - Dfn[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 3);
}
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mDfd, &nDfd, &lDfd);
Dfd = stk(lDfd);
for (i = 0; i < mDfd * nDfd; ++i)
if ((int) Dfd[i] - Dfd[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 4);
}
CdfBase(fname, 4, 2, callpos, "PQ", _("F,Dfn,Dfd and Pnonc"), 1, C2F(cdffnc),
cdffncErr);
}
else if ( strcmp(cstk(l1), "F") == 0)
{
static int callpos[6] = {3, 4, 5, 0, 1, 2};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mDfn, &nDfn, &lDfn);
Dfn = stk(lDfn);
for (i = 0; i < mDfn * nDfn; ++i)
if ((int) Dfn[i] - Dfn[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 2);
}
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mDfd, &nDfd, &lDfd);
Dfd = stk(lDfd);
for (i = 0; i < mDfd * nDfd; ++i)
if ((int) Dfd[i] - Dfd[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 3);
}
CdfBase(fname, 5, 1, callpos, "F", _("Dfn,Dfd,Pnonc,P and Q"), 2, C2F(cdffnc),
cdffncErr);
}
else if ( strcmp(cstk(l1), "Dfn") == 0)
{
static int callpos[6] = {2, 3, 4, 5, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mDfd, &nDfd, &lDfd);
Dfd = stk(lDfd);
for (i = 0; i < mDfd * nDfd; ++i)
if ((int) Dfd[i] - Dfd[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 2);
}
CdfBase(fname, 5, 1, callpos, "Dfn", _("Dfd,Pnonc,P,Q and F"), 3, C2F(cdffnc),
cdffncErr);
}
else if ( strcmp(cstk(l1), "Dfd") == 0)
{
static int callpos[6] = {1, 2, 3, 4, 5, 0};
GetRhsVar(6, MATRIX_OF_DOUBLE_DATATYPE, &mDfn, &nDfn, &lDfn);
Dfn = stk(lDfn);
for (i = 0; i < mDfn * nDfn; ++i)
if ((int) Dfn[i] - Dfn[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 6);
}
CdfBase(fname, 5, 1, callpos, "Dfd", _("Pnonc,P,Q,F and Dfn"), 4, C2F(cdffnc),
cdffncErr);
}
else if ( strcmp(cstk(l1), "Pnonc") == 0)
{
static int callpos[6] = {0, 1, 2, 3, 4, 5};
GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mDfn, &nDfn, &lDfn);
Dfn = stk(lDfn);
for (i = 0; i < mDfn * nDfn; ++i)
if ((int) Dfn[i] - Dfn[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 5);
}
GetRhsVar(6, MATRIX_OF_DOUBLE_DATATYPE, &mDfd, &nDfd, &lDfd);
Dfd = stk(lDfd);
for (i = 0; i < mDfd * nDfd; ++i)
if ((int) Dfd[i] - Dfd[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 6);
}
CdfBase(fname, 5, 1, callpos, "Pnonc", _("P,Q,F,Dfn and Dfd"), 5, C2F(cdffnc),
cdffncErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "F", "Dfn", "Dfd", "Pnonc");
}
return 0;
}
