SEXP do_cum(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP s, t, ans;
int i;
checkArity(op, args);
if (DispatchGroup("Math", call, op, args, env, &ans))
return ans;
if (isComplex(CAR(args))) {
t = CAR(args);
s = allocVector(CPLXSXP, LENGTH(t));
setAttrib(s, R_NamesSymbol, getAttrib(t, R_NamesSymbol));
for (i = 0 ; i < length(t) ; i++) {
COMPLEX(s)[i].r = NA_REAL;
COMPLEX(s)[i].i = NA_REAL;
}
switch (PRIMVAL(op) ) {
case 1: /* cumsum */
return ccumsum(t, s);
break;
case 2: /* cumprod */
return ccumprod(t, s);
break;
case 3: /* cummax */
case 4: /* cummin */
errorcall(call, _("min/max not defined for complex numbers"));
break;
default:
errorcall(call, _("unknown cumxxx function"));
}
}
else { /* Non-Complex: here, (sh|c)ould differentiate real / int */
PROTECT(t = coerceVector(CAR(args), REALSXP));
s = allocVector(REALSXP, LENGTH(t));
setAttrib(s, R_NamesSymbol, getAttrib(t, R_NamesSymbol));
for(i = 0 ; i < length(t) ; i++)
REAL(s)[i] = NA_REAL;
UNPROTECT(1);
switch (PRIMVAL(op) ) {
case 1: /* cumsum */
return cumsum(t,s);
break;
case 2: /* cumprod */
return cumprod(t,s);
break;
case 3: /* cummax */
return cummax(t,s);
break;
case 4: /* cummin */
return cummin(t,s);
break;
default:
errorcall(call, _("unknown cumxxx function"));
}
}
return R_NilValue; /* for -Wall */
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_cumprod(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDblIn = NULL;
types::Double* pDblOut = NULL;
types::Polynom* pPolyIn = NULL;
types::Polynom* pPolyOut = NULL;
int iOrientation = 0;
int iOuttype = 1; // 1 = native | 2 = double (type of output value)
if (in.size() < 1 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "cumprod", 1, 3);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "cumprod", 1);
return types::Function::Error;
}
bool isCloned = true;
/***** get data *****/
switch (in[0]->getType())
{
case types::InternalType::ScilabDouble :
pDblIn = in[0]->getAs<types::Double>();
isCloned = false;
break;
case types::InternalType::ScilabBool:
pDblIn = getAsDouble(in[0]->getAs<types::Bool>());
iOuttype = 2;
break;
case types::InternalType::ScilabPolynom :
pPolyIn = in[0]->getAs<types::Polynom>();
isCloned = false;
break;
case types::InternalType::ScilabInt8:
pDblIn = getAsDouble(in[0]->getAs<types::Int8>());
break;
case types::InternalType::ScilabInt16:
pDblIn = getAsDouble(in[0]->getAs<types::Int16>());
break;
case types::InternalType::ScilabInt32:
pDblIn = getAsDouble(in[0]->getAs<types::Int32>());
break;
case types::InternalType::ScilabInt64:
pDblIn = getAsDouble(in[0]->getAs<types::Int64>());
break;
case types::InternalType::ScilabUInt8:
pDblIn = getAsDouble(in[0]->getAs<types::UInt8>());
break;
case types::InternalType::ScilabUInt16:
pDblIn = getAsDouble(in[0]->getAs<types::UInt16>());
break;
case types::InternalType::ScilabUInt32:
pDblIn = getAsDouble(in[0]->getAs<types::UInt32>());
break;
case types::InternalType::ScilabUInt64:
pDblIn = getAsDouble(in[0]->getAs<types::UInt64>());
break;
default :
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_cumprod";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
if (in.size() >= 2)
{
if (in[1]->isDouble())
{
types::Double* pDbl = in[1]->getAs<types::Double>();
if (pDbl->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "cumprod", 2);
return types::Function::Error;
}
iOrientation = static_cast<int>(pDbl->get(0));
if (iOrientation <= 0)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "cumprod", 2);
return types::Function::Error;
}
}
else if (in[1]->isString())
{
types::String* pStr = in[1]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "cumprod", 2);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"*") == 0)
{
iOrientation = 0;
}
else if (wcscmp(wcsString, L"r") == 0)
{
iOrientation = 1;
}
else if (wcscmp(wcsString, L"c") == 0)
{
iOrientation = 2;
}
else if (wcscmp(wcsString, L"m") == 0)
{
int iDims = 0;
int* piDimsArray = NULL;
if (pDblIn)
{
iDims = pDblIn->getDims();
piDimsArray = pDblIn->getDimsArray();
}
else
{
iDims = pPolyIn->getDims();
piDimsArray = pPolyIn->getDimsArray();
}
// old function was "mtlsel"
for (int i = 0; i < iDims; i++)
{
if (piDimsArray[i] > 1)
{
iOrientation = i + 1;
break;
}
}
}
else if ((wcscmp(wcsString, L"native") == 0) && (in.size() == 2))
{
iOuttype = 1;
}
else if ((wcscmp(wcsString, L"double") == 0) && (in.size() == 2))
{
iOuttype = 2;
}
else
{
const char* pstrExpected = NULL;
if (in.size() == 2)
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\",\"native\",\"double\"";
}
else
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\"";
}
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "cumprod", 2, pstrExpected);
return types::Function::Error;
}
}
else
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix or a string expected.\n"), "cumprod", 2);
return types::Function::Error;
}
}
if (in.size() == 3)
{
if (in[2]->isString() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "cumprod", 3);
return types::Function::Error;
}
types::String* pStr = in[2]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "cumprod", 3);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"native") == 0)
{
iOuttype = 1;
}
else if (wcscmp(wcsString, L"double") == 0)
{
iOuttype = 2;
}
else
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: %s or %s expected.\n"), "cumprod", 3, "\"native\"", "\"double\"");
return types::Function::Error;
}
}
/***** perform operation *****/
if (pDblIn)
{
if (iOrientation > pDblIn->getDims())
{
if (in[0]->isDouble())
{
pDblOut = pDblIn->clone()->getAs<types::Double>();
}
else
{
pDblOut = pDblIn;
}
if (in[0]->isBool() == false)
{
iOuttype = 2;
}
}
else
{
pDblOut = new types::Double(pDblIn->getDims(), pDblIn->getDimsArray(), pDblIn->isComplex());
cumprod(pDblIn, iOrientation, pDblOut);
if (isCloned)
{
delete pDblIn;
pDblIn = NULL;
}
}
}
else if (pPolyIn)
{
iOuttype = 1;
if (iOrientation > pPolyIn->getDims())
{
pPolyOut = pPolyIn->clone()->getAs<types::Polynom>();
}
else
{
pPolyOut = new types::Polynom(pPolyIn->getVariableName(), pPolyIn->getDims(), pPolyIn->getDimsArray());
cumprod(pPolyIn, iOrientation, pPolyOut);
}
}
/***** set result *****/
if ((iOuttype == 1) && (in[0]->isDouble() == false))
{
switch (in[0]->getType())
{
case types::InternalType::ScilabBool:
{
types::Bool* pB = new types::Bool(pDblOut->getDims(), pDblOut->getDimsArray());
int* p = pB->get();
double* pd = pDblOut->get();
int size = pB->getSize();
for (int i = 0; i < size; ++i)
{
p[i] = pd[i] != 0 ? 1 : 0;
}
out.push_back(pB);
break;
}
case types::InternalType::ScilabPolynom:
{
out.push_back(pPolyOut);
break;
}
case types::InternalType::ScilabInt8:
{
out.push_back(toInt<types::Int8>(pDblOut));
break;
}
case types::InternalType::ScilabInt16:
{
out.push_back(toInt<types::Int16>(pDblOut));
break;
}
case types::InternalType::ScilabInt32:
{
out.push_back(toInt<types::Int32>(pDblOut));
break;
}
case types::InternalType::ScilabInt64:
{
out.push_back(toInt<types::Int64>(pDblOut));
break;
}
case types::InternalType::ScilabUInt8:
{
out.push_back(toInt<types::UInt8>(pDblOut));
break;
}
case types::InternalType::ScilabUInt16:
{
out.push_back(toInt<types::UInt16>(pDblOut));
break;
}
case types::InternalType::ScilabUInt32:
{
out.push_back(toInt<types::UInt32>(pDblOut));
break;
}
case types::InternalType::ScilabUInt64:
{
out.push_back(toInt<types::UInt64>(pDblOut));
break;
}
default:
return types::Function::Error;
}
if (pDblOut)
{
delete pDblOut;
}
}
else
{
out.push_back(pDblOut);
}
return types::Function::OK;
}
SEXP attribute_hidden do_cum(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP s, t, ans;
R_xlen_t i, n;
checkArity(op, args);
if (DispatchGroup("Math", call, op, args, env, &ans))
return ans;
if (isComplex(CAR(args))) {
t = CAR(args);
n = XLENGTH(t);
PROTECT(s = allocVector(CPLXSXP, n));
setAttrib(s, R_NamesSymbol, getAttrib(t, R_NamesSymbol));
UNPROTECT(1);
if(n == 0) return s;
for (i = 0 ; i < n ; i++) {
COMPLEX(s)[i].r = NA_REAL;
COMPLEX(s)[i].i = NA_REAL;
}
switch (PRIMVAL(op) ) {
case 1: /* cumsum */
return ccumsum(t, s);
break;
case 2: /* cumprod */
return ccumprod(t, s);
break;
case 3: /* cummax */
errorcall(call, _("'cummax' not defined for complex numbers"));
break;
case 4: /* cummin */
errorcall(call, _("'cummin' not defined for complex numbers"));
break;
default:
errorcall(call, "unknown cumxxx function");
}
} else if( ( isInteger(CAR(args)) || isLogical(CAR(args)) ) &&
PRIMVAL(op) != 2) {
PROTECT(t = coerceVector(CAR(args), INTSXP));
n = XLENGTH(t);
PROTECT(s = allocVector(INTSXP, n));
setAttrib(s, R_NamesSymbol, getAttrib(t, R_NamesSymbol));
if(n == 0) {
UNPROTECT(2); /* t, s */
return s;
}
for(i = 0 ; i < n ; i++) INTEGER(s)[i] = NA_INTEGER;
switch (PRIMVAL(op) ) {
case 1: /* cumsum */
ans = icumsum(t,s);
break;
case 3: /* cummax */
ans = icummax(t,s);
break;
case 4: /* cummin */
ans = icummin(t,s);
break;
default:
errorcall(call, _("unknown cumxxx function"));
ans = R_NilValue;
}
UNPROTECT(2); /* t, s */
return ans;
} else {
PROTECT(t = coerceVector(CAR(args), REALSXP));
n = XLENGTH(t);
PROTECT(s = allocVector(REALSXP, n));
setAttrib(s, R_NamesSymbol, getAttrib(t, R_NamesSymbol));
UNPROTECT(2);
if(n == 0) return s;
for(i = 0 ; i < n ; i++) REAL(s)[i] = NA_REAL;
switch (PRIMVAL(op) ) {
case 1: /* cumsum */
return cumsum(t,s);
break;
case 2: /* cumprod */
return cumprod(t,s);
break;
case 3: /* cummax */
return cummax(t,s);
break;
case 4: /* cummin */
return cummin(t,s);
break;
default:
errorcall(call, _("unknown cumxxx function"));
}
}
return R_NilValue; /* for -Wall */
}
types::ndarray<typename types::numpy_type<dtype>::type,N> cumprod(types::ndarray<T,N> const& expr, long axis, dtype d = dtype()) {
if(axis<0 || axis >=long(N))
throw types::ValueError("axis out of bounds");
auto shape = expr.shape;
types::ndarray<typename types::numpy_type<dtype>::type,N> cumprody(shape, __builtin__::None);
if(axis==0) {
std::copy(expr.buffer, expr.buffer + shape[N-1], cumprody.buffer);
std::transform(cumprody.begin(), cumprody.end()-1, expr.begin() + 1, cumprody.begin() + 1, std::multiplies<types::ndarray<T,N-1>>());
}
else {
std::transform(expr.begin(), expr.end(), cumprody.begin(), [=](types::ndarray<T,N-1> const& e) { return cumprod(e, axis-1, d); });
}
return cumprody;
}
types::ndarray<typename types::numpy_type<dtype>::type,1> cumprod(types::ndarray<T,1> const& expr, long axis, dtype d = dtype()) {
if(axis !=0)
throw types::ValueError("axis out of bounds");
return cumprod(expr);
}
