SEXP read_partial_bignifti_data(SEXP nim_addr, SEXP big_addr, \
SEXP rowIndices, SEXP colIndices, \
SEXP totalVoxs) {
// Get nifti object pointer
nifti_image *pnim = (nifti_image *)R_ExternalPtrAddr(nim_addr);
// Get nifti data
if (nifti_image_load(pnim) < 0) {
nifti_image_free(pnim);
error("Could not load nifti data");
}
// Save data to big matrix object
BigMatrix *pMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(big_addr));
if (pMat->separated_columns()) {
switch (pMat->matrix_type()) {
case 1:
return Read_Partial_Nifti_To_BigMatrix_Step2<char>(pnim, SepMatrixAccessor<char>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 2:
return Read_Partial_Nifti_To_BigMatrix_Step2<short>(pnim, SepMatrixAccessor<short>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 4:
return Read_Partial_Nifti_To_BigMatrix_Step2<int>(pnim, SepMatrixAccessor<int>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 8:
return Read_Partial_Nifti_To_BigMatrix_Step2<double>(pnim, SepMatrixAccessor<double>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
}
}
else {
switch (pMat->matrix_type()) {
case 1:
return Read_Partial_Nifti_To_BigMatrix_Step2<char>(pnim, MatrixAccessor<char>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 2:
return Read_Partial_Nifti_To_BigMatrix_Step2<short>(pnim, MatrixAccessor<short>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 4:
return Read_Partial_Nifti_To_BigMatrix_Step2<int>(pnim, MatrixAccessor<int>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
case 8:
return Read_Partial_Nifti_To_BigMatrix_Step2<double>(pnim, MatrixAccessor<double>(*pMat), \
rowIndices, colIndices, totalVoxs);
break;
}
}
error("failed to identify big matrix type");
}
SEXP BigSumMain(SEXP addr, SEXP cols, SEXP rows) {
SEXP ret = R_NilValue;
ret = PROTECT(NEW_NUMERIC(1));
double *pRet = NUMERIC_DATA(ret);
BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(addr);
if (pMat->separated_columns()) {
switch (pMat->matrix_type()) {
case 1:
BigSum<char, SepMatrixAccessor<char> >(
pMat, cols, rows, pRet);
break;
case 2:
BigSum<short, SepMatrixAccessor<short> >(
pMat, cols, rows, pRet);
break;
case 4:
BigSum<int, SepMatrixAccessor<int> >(
pMat, cols, rows, pRet);
break;
case 8:
BigSum<double, SepMatrixAccessor<double> >(
pMat, cols, rows, pRet);
break;
}
}
else {
switch (pMat->matrix_type()) {
case 1:
BigSum<char, MatrixAccessor<char> >(
pMat, cols, rows, pRet);
break;
case 2:
BigSum<short, MatrixAccessor<short> >(
pMat, cols, rows, pRet);
break;
case 4:
BigSum<int, MatrixAccessor<int> >(
pMat, cols, rows, pRet);
break;
case 8:
BigSum<double, MatrixAccessor<double> >(
pMat, cols, rows, pRet);
break;
}
}
UNPROTECT(1);
return(ret);
}
SEXP ComputePvalsMain(SEXP Rinmat, SEXP Routmat, SEXP Routcol) {
BigMatrix *inMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(Rinmat));
BigMatrix *outMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(Routmat));
double outCol = NUMERIC_DATA(Routcol)[0];
if (inMat->separated_columns() != outMat->separated_columns())
Rf_error("all big matrices are not the same column separated type");
if (inMat->matrix_type() != outMat->matrix_type())
Rf_error("all big matrices are not the same matrix type");
if (inMat->ncol() != outMat->nrow())
Rf_error("inMat # of cols must be the same as outMat # of rows");
CALL_BIGFUNCTION_ARGS_THREE(ComputePvals, inMat, outMat, outCol)
return(ret);
}
SEXP CtransposeMatrix(SEXP inAddr, SEXP outAddr, SEXP rowInds, SEXP colInds,
SEXP typecast_warning)
{
BigMatrix *pInMat = reinterpret_cast<BigMatrix*>(
R_ExternalPtrAddr(inAddr));
BigMatrix *pOutMat = reinterpret_cast<BigMatrix*>(
R_ExternalPtrAddr(outAddr));
if ((pOutMat->matrix_type() < pInMat->matrix_type()) &
(Rcpp::as<bool>(typecast_warning) == (Rboolean)TRUE))
{
string type_names[9] = {
"", "char", "short", "", "integer", "", "", "", "double"};
std::string warnMsg = string("Assignment will down cast from ") +
type_names[pInMat->matrix_type()] + string(" to ") +
type_names[pOutMat->matrix_type()] + string("\n") +
string("Hint: To remove this warning type: ") +
string("options(bigmemory.typecast.warning=FALSE)");
Rf_warning(warnMsg.c_str());
}
// Not sure if there is a better way to do these function calls
if (pInMat->separated_columns() && pOutMat->separated_columns()) {
CALL_transpose_1(SepMatrixAccessor, SepMatrixAccessor)
}
else if(pInMat->separated_columns() && !(pOutMat->separated_columns()))
{
CALL_transpose_1(SepMatrixAccessor, MatrixAccessor)
}
else if(!(pInMat->separated_columns()) && pOutMat->separated_columns())
{
CALL_transpose_1(MatrixAccessor, SepMatrixAccessor)
}
else
{
CALL_transpose_1(MatrixAccessor, MatrixAccessor)
}
return R_NilValue;
}
SEXP binit1BigMatrix(SEXP x, SEXP col, SEXP breaks)
{
BigMatrix *pMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(x));
if (pMat->separated_columns())
{
switch (pMat->matrix_type())
{
case 1:
return CBinIt1<char>(SepMatrixAccessor<char>(*pMat),
pMat->nrow(), col, breaks);
case 2:
return CBinIt1<short>(SepMatrixAccessor<short>(*pMat),
pMat->nrow(), col, breaks);
case 4:
return CBinIt1<int>(SepMatrixAccessor<int>(*pMat),
pMat->nrow(), col, breaks);
case 8:
return CBinIt1<double>(SepMatrixAccessor<double>(*pMat),
pMat->nrow(), col, breaks);
}
}
else
{
switch (pMat->matrix_type())
{
case 1:
return CBinIt1<char>(MatrixAccessor<char>(*pMat),
pMat->nrow(), col, breaks);
case 2:
return CBinIt1<short>(MatrixAccessor<short>(*pMat),
pMat->nrow(), col, breaks);
case 4:
return CBinIt1<int>(MatrixAccessor<int>(*pMat),
pMat->nrow(), col, breaks);
case 8:
return CBinIt1<double>(MatrixAccessor<double>(*pMat),
pMat->nrow(), col, breaks);
}
}
return R_NilValue;
}
SEXP write_bignifti(SEXP header, SEXP big_addr, SEXP indices, SEXP outfile) {
SEXP Rdim, Rdatatype;
// Load big matrix
BigMatrix *pMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(big_addr));
// Get dim
PROTECT(Rdim = GET_LIST_ELEMENT(header, "dim"));
if (Rdim == R_NilValue)
error("header must have a proper dim (dimension) attribute");
if (GET_LENGTH(Rdim) != 4)
error("header must have a 4D dim (dimension) attribute");
// Get datatype
PROTECT(Rdatatype = GET_LIST_ELEMENT(header, "datatype"));
if (Rdatatype == R_NilValue) {
int datatype;
switch(pMat->matrix_type()) {
case 1: // char
datatype = DT_INT8;
break;
case 2: // short
datatype = DT_INT16;
break;
case 4: // int
datatype = DT_INT32;
break;
case 8: // double
datatype = DT_FLOAT64;
break;
default:
error("unrecognized big matrix data type");
break;
}
Rdatatype = int_to_SEXP(datatype);
}
UNPROTECT(1);
// Load nifti object
nifti_image *pnim = create_nifti_image(header, Rdim, Rdatatype, outfile);
if (pMat->separated_columns()) {
switch (pMat->matrix_type()) {
case 1:
Write_BigMatrix_To_Nifti_Step2<char, SepMatrixAccessor<char> >(pnim, pMat, indices);
break;
case 2:
Write_BigMatrix_To_Nifti_Step2<short, SepMatrixAccessor<short> >(pnim, pMat, indices);
break;
case 4:
Write_BigMatrix_To_Nifti_Step2<int, SepMatrixAccessor<int> >(pnim, pMat, indices);
break;
case 8:
Write_BigMatrix_To_Nifti_Step2<double, SepMatrixAccessor<double> >(pnim, pMat, indices);
break;
}
}
else {
switch (pMat->matrix_type()) {
case 1:
Write_BigMatrix_To_Nifti_Step2<char, MatrixAccessor<char> >(pnim, pMat, indices);
break;
case 2:
Write_BigMatrix_To_Nifti_Step2<short, MatrixAccessor<short> >(pnim, pMat, indices);
break;
case 4:
Write_BigMatrix_To_Nifti_Step2<int, MatrixAccessor<int> >(pnim, pMat, indices);
break;
case 8:
Write_BigMatrix_To_Nifti_Step2<double, MatrixAccessor<double> >(pnim, pMat, indices);
break;
}
}
if (!nifti_nim_is_valid(pnim, 1))
error("data seems invalid");
if (pnim!=NULL)
nifti_image_write(pnim);
else
error("pnim was NULL");
nifti_image_free(pnim);
return R_NilValue;
}
SEXP kmeansBigMatrix(SEXP x, SEXP cen, SEXP clust, SEXP clustsizes,
SEXP wss, SEXP itermax, SEXP dist)
{
BigMatrix *pMat = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(x));
int dist_calc = INTEGER(dist)[0];
if (dist_calc == 0)
{
if (pMat->separated_columns())
{
switch (pMat->matrix_type())
{
case 1:
return kmeansMatrixEuclid<char>(SepMatrixAccessor<char>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 2:
return kmeansMatrixEuclid<short>(SepMatrixAccessor<short>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 4:
return kmeansMatrixEuclid<int>(SepMatrixAccessor<int>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 8:
return kmeansMatrixEuclid<double>(SepMatrixAccessor<double>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
}
}
else
{
switch (pMat->matrix_type())
{
case 1:
return kmeansMatrixEuclid<char>(MatrixAccessor<char>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 2:
return kmeansMatrixEuclid<short>(MatrixAccessor<short>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 4:
return kmeansMatrixEuclid<int>(MatrixAccessor<int>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 8:
return kmeansMatrixEuclid<double>(MatrixAccessor<double>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
}
}
}
else
{
if (pMat->separated_columns())
{
switch (pMat->matrix_type())
{
case 1:
return kmeansMatrixCosine<char>(SepMatrixAccessor<char>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 2:
return kmeansMatrixCosine<short>(SepMatrixAccessor<short>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 4:
return kmeansMatrixCosine<int>(SepMatrixAccessor<int>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 8:
return kmeansMatrixCosine<double>(SepMatrixAccessor<double>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
}
}
else
{
switch (pMat->matrix_type())
{
case 1:
return kmeansMatrixCosine<char>(MatrixAccessor<char>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 2:
return kmeansMatrixCosine<short>(MatrixAccessor<short>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 4:
return kmeansMatrixCosine<int>(MatrixAccessor<int>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
case 8:
return kmeansMatrixCosine<double>(MatrixAccessor<double>(*pMat),
pMat->nrow(), pMat->ncol(), cen, clust, clustsizes, wss, itermax);
}
}
}
return R_NilValue;
}
// [[Rcpp::export]]
SEXP CDeepCopy(SEXP inAddr, SEXP outAddr, SEXP rowInds, SEXP colInds,
SEXP typecast_warning)
{
#define CALL_DEEP_COPY_2(IN_CTYPE, IN_ACCESSOR, OUT_ACCESSOR) \
switch(pOutMat->matrix_type()) \
{ \
case 1: \
DeepCopy<IN_CTYPE, IN_ACCESSOR<IN_CTYPE>, char, OUT_ACCESSOR<char> >( \
pInMat, pOutMat, rowInds, colInds); \
break; \
case 2: \
DeepCopy<IN_CTYPE, IN_ACCESSOR<IN_CTYPE>, short, OUT_ACCESSOR<short> >( \
pInMat, pOutMat, rowInds, colInds); \
break; \
case 4: \
DeepCopy<IN_CTYPE, IN_ACCESSOR<IN_CTYPE>, int, OUT_ACCESSOR<int> >( \
pInMat, pOutMat, rowInds, colInds); \
break; \
case 8: \
DeepCopy<IN_CTYPE, IN_ACCESSOR<IN_CTYPE>, double, OUT_ACCESSOR<double> >( \
pInMat, pOutMat, rowInds, colInds); \
break; \
}
#define CALL_DEEP_COPY_1(IN_ACCESSOR, OUT_ACCESSOR) \
switch(pInMat->matrix_type()) \
{ \
case 1: \
CALL_DEEP_COPY_2(char, IN_ACCESSOR, OUT_ACCESSOR) \
break; \
case 2: \
CALL_DEEP_COPY_2(short, IN_ACCESSOR, OUT_ACCESSOR) \
break; \
case 4: \
CALL_DEEP_COPY_2(int, IN_ACCESSOR, OUT_ACCESSOR) \
break; \
case 8: \
CALL_DEEP_COPY_2(double, IN_ACCESSOR, OUT_ACCESSOR) \
break; \
}
BigMatrix *pInMat = reinterpret_cast<BigMatrix*>(
R_ExternalPtrAddr(inAddr));
BigMatrix *pOutMat = reinterpret_cast<BigMatrix*>(
R_ExternalPtrAddr(outAddr));
if ((pOutMat->matrix_type() < pInMat->matrix_type()) &
(LOGICAL_VALUE(typecast_warning) == (Rboolean)TRUE))
{
string type_names[9] = {
"", "char", "short", "", "integer", "", "", "", "double"
};
std::string warnMsg = string("Assignment will down cast from ") +
type_names[pInMat->matrix_type()] + string(" to ") +
type_names[pOutMat->matrix_type()] + string("\n") +
string("Hint: To remove this warning type: ") +
string("options(bigmemory.typecast.warning=FALSE)");
Rf_warning(warnMsg.c_str());
}
// Not sure if there is a better way to do these function calls
if (pInMat->separated_columns() && pOutMat->separated_columns()) {
CALL_DEEP_COPY_1(SepMatrixAccessor, SepMatrixAccessor)
}
else if(pInMat->separated_columns() && !(pOutMat->separated_columns()))
{
CALL_DEEP_COPY_1(SepMatrixAccessor, MatrixAccessor)
}
else if(!(pInMat->separated_columns()) && pOutMat->separated_columns())
{
CALL_DEEP_COPY_1(MatrixAccessor, SepMatrixAccessor)
}
else
{
CALL_DEEP_COPY_1(MatrixAccessor, MatrixAccessor)
}
return R_NilValue;
}