Codebase list r-cran-rspectra / debian/0.16-0-1 src / matops.cpp
debian/0.16-0-1

Tree @debian/0.16-0-1 (Download .tar.gz)

matops.cpp @debian/0.16-0-1 — raw · history · blame 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#include <RcppEigen.h>
#include "matops.h"

MatProd* get_mat_prod_op(SEXP mat, int nrow, int ncol, SEXP extra_arg, int mat_type)
{
    MatProd* op;

    Rcpp::List args(extra_arg);

    switch(mat_type)
    {
    case MATRIX:
        op = new MatProd_matrix(mat, nrow, ncol);
        break;
    case SYM_MATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new MatProd_sym_matrix(mat, nrow, use_lower ? 'L' : 'U');
        }
        break;
    case DGEMATRIX:
        op = new MatProd_dgeMatrix(mat, nrow, ncol);
        break;
    case SYM_DGEMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new MatProd_sym_dgeMatrix(mat, nrow, use_lower ? 'L' : 'U');
        }
        break;
    case DSYMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new MatProd_dsyMatrix(mat, nrow, use_lower ? 'L' : 'U');
        }
        break;
    case DGCMATRIX:
        op = new MatProd_dgCMatrix(mat, nrow, ncol);
        break;
    case SYM_DGCMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new MatProd_sym_dgCMatrix(mat, nrow, use_lower ? 'L' : 'U');
        }
        break;
    case DGRMATRIX:
        op = new MatProd_dgRMatrix(mat, nrow, ncol);
        break;
    case SYM_DGRMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new MatProd_sym_dgRMatrix(mat, nrow, use_lower ? 'L' : 'U');
        }
        break;
    case FUNCTION:
        {
        SEXP trans    = args["Atrans"];
        SEXP fun_args = args["fun_args"];
        op = new MatProd_function(mat, trans, nrow, ncol, fun_args);
        }
        break;
    default:
        Rcpp::stop("unsupported matrix type");
        // Eliminate compiler warning, but should not reach here
        op = new MatProd_matrix(mat, nrow, ncol);
    }

    return op;
}

RealShift* get_real_shift_op_sym(SEXP mat, int n, SEXP extra_arg, int mat_type)
{
    RealShift* op;

    Rcpp::List args(extra_arg);

    switch(mat_type)
    {
    case MATRIX:
        op = new RealShift_matrix(mat, n);
        break;
    case SYM_MATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new RealShift_sym_matrix(mat, n, use_lower ? 'L' : 'U');
        }
        break;
    case DGEMATRIX:
        op = new RealShift_dgeMatrix(mat, n);
        break;
    case SYM_DGEMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new RealShift_sym_dgeMatrix(mat, n, use_lower ? 'L' : 'U');
        }
        break;
    case DSYMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new RealShift_dsyMatrix(mat, n, use_lower ? 'L' : 'U');
        }
        break;
    case DGCMATRIX:
        op = new RealShift_dgCMatrix(mat, n);
        break;
    case SYM_DGCMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new RealShift_sym_dgCMatrix(mat, n, use_lower ? 'L' : 'U');
        }
        break;
    case DGRMATRIX:
        op = new RealShift_dgRMatrix(mat, n);
        break;
    case SYM_DGRMATRIX:
        {
        bool use_lower = Rcpp::as<bool>(args["use_lower"]);
        op = new RealShift_sym_dgRMatrix(mat, n, use_lower ? 'L' : 'U');
        }
        break;
    default:
        Rcpp::stop("unsupported matrix type");
        // Eliminate compiler warning, but should not reach here
        op = new RealShift_matrix(mat, n);
    }

    return op;
}

RealShift* get_real_shift_op_gen(SEXP mat, int n, SEXP extra_arg, int mat_type)
{
    RealShift* op;

    Rcpp::List args(extra_arg);

    switch(mat_type)
    {
    case MATRIX:
        op = new RealShift_matrix(mat, n);
        break;
    case DGEMATRIX:
        op = new RealShift_dgeMatrix(mat, n);
        break;
    case DGCMATRIX:
        op = new RealShift_dgCMatrix(mat, n);
        break;
    case DGRMATRIX:
        op = new RealShift_dgRMatrix(mat, n);
        break;
    default:
        Rcpp::stop("unsupported matrix type");
        // Eliminate compiler warning, but should not reach here
        op = new RealShift_matrix(mat, n);
    }

    return op;
}

ComplexShift* get_complex_shift_op(SEXP mat, int n, SEXP extra_arg, int mat_type)
{
    ComplexShift* op;

    Rcpp::List args(extra_arg);

    switch(mat_type)
    {
    case MATRIX:
        op = new ComplexShift_matrix(mat, n);
        break;
    case DGEMATRIX:
        op = new ComplexShift_dgeMatrix(mat, n);
        break;
    case DGCMATRIX:
        op = new ComplexShift_dgCMatrix(mat, n);
        break;
    case DGRMATRIX:
        op = new ComplexShift_dgRMatrix(mat, n);
        break;
    default:
        Rcpp::stop("unsupported matrix type");
        // Eliminate compiler warning, but should not reach here
        op = new ComplexShift_matrix(mat, n);
    }

    return op;
}