C++ BigMatrix::separated_columns方法代码示例

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 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 CIPTMatrix(SEXP inAddr)
  {
    BigMatrix *pInMat = reinterpret_cast<BigMatrix*>(
      R_ExternalPtrAddr(inAddr));
    
    // Not sure if there is a better way to do these function calls
    if (pInMat->separated_columns()) {
      // Need method for separated_columns
      //CALL_IPT_2(SepMatrixAccessor)
    }
    else
    {
      CALL_IPT_2(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 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 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;
}