subscript.c File Reference

#include "Mdefines.h"
#include "M5.h"
#include "idz.h"

Go to the source code of this file.

Macros
#define	SUB1(c)
#define	iOOB(s, t, mn)
#define	dOOB(s, t, mn)
#define	lCAST(x)
#define	iCAST(x)
#define	dCAST(x)
#define	zCAST(x)
#define	nCAST(x)
#define	SUB1__(d, c)
#define	nCAST(x)
#define	MAP(l)
#define	ADV(d)
#define	SUB1__(d, c)
#define	nCAST(x)
#define	SUB1__(d, c)
#define	SUB1__(d, c)
#define	nCAST(x)
#define	SUB1(c)
#define	nCAST(x)
#define	MAP(l)
#define	ADV
#define	SUB1(c)
#define	nCAST(x)
#define	SUB1(c)
#define	SUB2(c)
#define	SUB2__(c, assign, s, t, __for__, jump0, jump1)
#define	ASSIGN_GE(c, x, y, i, j, m, s, t)
#define	ASSIGN_SY(c, x, y, i, j, m, s, t)
#define	ASSIGN_TR(c, x, y, i, j, m, s, t)
#define	CMP_U(i, j)
#define	CMP_L(i, j)
#define	SUB2(c)
#define	SUB2(c)
#define	TEMPLATE(c)
#define	SUB2(c)
#define	TEMPLATE(c)
#define	SUB2(c)

Functions
static int	anyNA (int *p, int n)
static SEXP	dense_subscript_1ary (SEXP obj, const char *class, SEXP s)
static SEXP	sparse_subscript_1ary (SEXP obj, const char *class, SEXP s, SEXP o)
static SEXP	diagonal_subscript_1ary (SEXP obj, const char *class, SEXP s)
static SEXP	index_subscript_1ary (SEXP obj, const char *class, SEXP s)
SEXP	R_subscript_1ary (SEXP s_obj, SEXP s_s, SEXP s_o)
static SEXP	dense_subscript_1ary_2col (SEXP obj, const char *class, SEXP s)
static SEXP	sparse_subscript_1ary_2col (SEXP obj, const char *class, SEXP s, SEXP o)
static SEXP	diagonal_subscript_1ary_2col (SEXP obj, const char *class, SEXP s)
static SEXP	index_subscript_1ary_2col (SEXP obj, const char *class, SEXP s)
SEXP	R_subscript_1ary_2col (SEXP s_obj, SEXP s_s, SEXP s_o)
static int	stay_sy (int *pi, int ni, int *pj, int nj, int n, char uplo, int checkNA)
static int	stay_tr (int *pi, int ni, int *pj, int nj, int n, char uplo, int checkNA)
static int	stay_di (int *pi, int ni, int *pj, int nj, int n, int checkNA)
static SEXP	dense_subscript_2ary (SEXP obj, const char *class, SEXP si, SEXP sj)
static SEXP	sparse_subscript_2ary (SEXP obj, const char *class, SEXP si, SEXP sj)
static SEXP	diagonal_subscript_2ary (SEXP obj, const char *class, SEXP si, SEXP sj)
static SEXP	index_subscript_2ary (SEXP obj, const char *class, SEXP si, SEXP sj)
SEXP	R_subscript_2ary (SEXP s_obj, SEXP s_si, SEXP s_sj)

Macro Definition Documentation

ADV [1/2]

#define ADV

(

d

)

Value:

    do { \
        if (l >= slen) \
            j = -1; \
        else { \
            l_ = MAP(l); \
            if (d##OOB(ps[l_], k, mn)) \
                j = -1; \
            else { \
                if (byrow) { \
                    i = (int) (k / m); \
                    j = (int) (k % m); \
                } \
                else { \
                    i = (int) (k % m); \
                    j = (int) (k / m); \
                } \
                if (sy && (b = (up) ? j - i : i - j) < 0) \
                    SWAP(i, j, int, ); \
                ++l; \
            } \
        } \
    } while (0)

ADV [2/2]

#define ADV

Value:

    do { \
        if (l >= slen) \
            j = -1; \
        else { \
            l_ = MAP(l); \
            if (ps0[l_] == NA_INTEGER || ps1[l_] == NA_INTEGER) \
                j = -1; \
            else { \
                if (byrow) { \
                    i = ps1[l_] - 1; \
                    j = ps0[l_] - 1; \
                } \
                else { \
                    i = ps0[l_] - 1; \
                    j = ps1[l_] - 1; \
                } \
                if (sy && (b = (up) ? j - i : i - j) < 0) \
                    SWAP(i, j, int, ); \
                ++l; \
            } \
        } \
    } while (0)

ASSIGN_GE

#define ASSIGN_GE	(		c,
			x,
			y,
			i,
			j,
			m,
			s,
			t )

Value:

    do { \
        c##ASSIGN_IDEN(*y, x[DENSE_INDEX_N(i, j, m)]); \
    } while (0)

ASSIGN_SY

#define ASSIGN_SY	(		c,
			x,
			y,
			i,
			j,
			m,
			s,
			t )

Value:

    do { \
        if (he && i == j) \
            c##ASSIGN_PROJ_REAL(*y, x[DENSE_INDEX_##t(i, j, m)]); \
        else if (CMP_##s(i, j)) \
            c##ASSIGN_IDEN     (*y, x[DENSE_INDEX_##t(i, j, m)]); \
        else if (he) \
            c##ASSIGN_CONJ     (*y, x[DENSE_INDEX_##t(j, i, m)]); \
        else \
            c##ASSIGN_IDEN     (*y, x[DENSE_INDEX_##t(j, i, m)]); \
    } while (0)

ASSIGN_TR

#define ASSIGN_TR	(		c,
			x,
			y,
			i,
			j,
			m,
			s,
			t )

Value:

    do { \
        if (un && i == j) \
            c##ASSIGN_IDEN(*y, c##UNIT); \
        else if (CMP_##s(i, j)) \
            c##ASSIGN_IDEN(*y, x[DENSE_INDEX_##t(i, j, m)]); \
        else \
            c##ASSIGN_IDEN(*y, c##ZERO); \
    } while (0)

CMP_L

#define CMP_L	(		i,
			j )

Value:

i >= j

CMP_U

#define CMP_U	(		i,
			j )

Value:

i <= j

dCAST

#define dCAST

(

x

)

Value:

(x)

Definition at line 30 of file subscript.c.

dOOB

#define dOOB	(		s,
			t,
			mn )

Value:

(ISNAN(s) || s >= 0x1.0p+63 || (t = (int_fast64_t) s - 1) >= mn)

Definition at line 26 of file subscript.c.

iCAST

#define iCAST

(

x

)

Value:

(x)

Definition at line 29 of file subscript.c.

iOOB

#define iOOB	(		s,
			t,
			mn )

Value:

(s == NA_INTEGER || (t = s - 1) >= mn)

Definition at line 25 of file subscript.c.

lCAST

#define lCAST

(

x

)

Value:

(x)

Definition at line 28 of file subscript.c.

MAP [1/2]

#define MAP

(

l

)

Value:

    (po_i) ? (R_xlen_t) po_i[l] - 1 : (po_d) ? (R_xlen_t) po_d[l] - 1 : l

MAP [2/2]

#define MAP

(

l

)

Value:

    (po_i) ? (int) po_i[l] - 1 : (po_d) ? (int) po_d[l] - 1 : l

nCAST [1/6]

#define nCAST

(

x

)

Value:

(x != 0)

Definition at line 34 of file subscript.c.

nCAST [2/6]

#define nCAST

(

x

)

Value:

(1)

Definition at line 34 of file subscript.c.

nCAST [3/6]

#define nCAST

(

x

)

Value:

(x != 0)

Definition at line 34 of file subscript.c.

nCAST [4/6]

#define nCAST

(

x

)

Value:

(x != 0)

Definition at line 34 of file subscript.c.

nCAST [5/6]

#define nCAST

(

x

)

Value:

(1)

Definition at line 34 of file subscript.c.

nCAST [6/6]

#define nCAST

(

x

)

Value:

(x != 0)

Definition at line 34 of file subscript.c.

SUB1 [1/4]

#define SUB1

(

c

)

Value:

do { \
    if (TYPEOF(s) == INTSXP) \
        SUB1__(i, c); \
    else \
        SUB1__(d, c); \
} while (0)

Definition at line 17 of file subscript.c.

Referenced by dense_subscript_1ary(), dense_subscript_1ary_2col(), diagonal_subscript_1ary(), diagonal_subscript_1ary_2col(), index_subscript_1ary(), sparse_subscript_1ary(), and sparse_subscript_1ary_2col().

SUB1 [2/4]

#define SUB1

(

c

)

Definition at line 17 of file subscript.c.

SUB1 [3/4]

#define SUB1

(

c

)

Definition at line 17 of file subscript.c.

SUB1 [4/4]

#define SUB1

(

c

)

Value:

    do { \
        c##TYPE *pa = c##PTR(ans); \
        c##TYPE *px = c##PTR(x); \
        for (l = 0; l < slen; ++l) { \
            if (ps0[l] == NA_INTEGER || ps1[l] == NA_INTEGER) \
                pa[l] = c##NA; \
            else if (ps0[l] != ps1[l]) \
                pa[l] = c##ZERO; \
            else if (un) \
                pa[l] = c##UNIT; \
            else \
                pa[l] = c##CAST(px[ps0[l] - 1]); \
        } \
    } while (0)

Definition at line 17 of file subscript.c.

SUB1__ [1/4]

#define SUB1__	(		d,
			c )

SUB1__ [2/4]

#define SUB1__	(		d,
			c )

SUB1__ [3/4]

#define SUB1__	(		d,
			c )

Value:

    do { \
        d##TYPE *ps = d##PTR(s); \
        c##TYPE *pa = c##PTR(ans); \
        c##TYPE *px = c##PTR(x); \
        for (l = 0; l < slen; ++l) { \
            if (d##OOB(ps[l], k, nn)) \
                pa[l] = c##NA; \
            else if (k % n1a) \
                pa[l] = c##ZERO; \
            else if (un) \
                pa[l] = c##UNIT; \
            else \
                pa[l] = c##CAST(px[k / n1a]); \
        } \
    } while (0)

SUB1__ [4/4]

#define SUB1__	(		d,
			c )

Value:

    do { \
        d##TYPE *ps = d##PTR(s); \
        for (l = 0; l < slen; ++l) { \
            if (d##OOB(ps[l], k, mn)) \
                pa[l] = NA_LOGICAL; \
            else if (mg == 0) \
                pa[l] = k / m == pperm[k % m] - 1; \
            else \
                pa[l] = k % m == pperm[k / m] - 1; \
        } \
    } while (0)

SUB2 [1/5]

#define SUB2

(

c

)

Referenced by dense_subscript_2ary(), diagonal_subscript_2ary(), and sparse_subscript_2ary().

SUB2 [2/5]

#define SUB2

(

c

)

Value:

        do { \
            c##IF_NPATTERN( \
            SEXP x0 = PROTECT(GET_SLOT(obj, Matrix_xSym)), \
                x1 = PROTECT(Rf_allocVector(c##TYPESXP, (int) nnz)); \
            c##TYPE *px0 = c##PTR(x0), *px1 = c##PTR(x1); \
            SET_SLOT(ans, Matrix_xSym, x1); \
            UNPROTECT(2); /* x1, x0 */ \
            ); \
            for (kj = 0; kj < nj; ++kj) { \
                j = pj[kj] - 1; \
                k = pp0[j - 1]; \
                kend = pp0[j]; \
                while (k < kend) { \
                    *(pi1++) = pi0[k]; \
                    c##IF_NPATTERN( \
                    *(px1++) = px0[k]; \
                    ); \
                    ++k; \
                } \
            } \
        } while (0)

SUB2 [3/5]

#define SUB2

(

c

)

Value:

        do { \
            c##IF_NPATTERN( \
            SEXP x0 = PROTECT(GET_SLOT(obj, Matrix_xSym)), \
                x1 = PROTECT(Rf_allocVector(c##TYPESXP, (int) nnz)); \
            c##TYPE *px0 = c##PTR(x0), *px1 = c##PTR(x1); \
            SET_SLOT(ans, Matrix_xSym, x1); \
            UNPROTECT(2); /* x1, x0 */ \
            ); \
            for (kj = 0; kj < nj; ++kj) { \
                j = (mj) ? kj : pj[kj] - 1; \
                k = pp0[j - 1]; \
                kend = pp0[j]; \
                while (k < kend) { \
                    i = pi0[k]; \
                    d = iworkA[i]; \
                    ki = iworkB[i]; \
                    while (d--) { \
                        *(pi1++) = ki; \
                        c##IF_NPATTERN( \
                        *(px1++) = px0[k]; \
                        ); \
                        ki = iworkC[ki]; \
                    } \
                    ++k; \
                } \
            } \
        } while (0)

SUB2 [4/5]

#define SUB2

(

c

)

Value:

        do { \
            c##TYPE *px0 = c##PTR(x0) - 1, *px1 = c##PTR(x1); \
            for (ki = 0; ki < ni; ++ki) \
                if (*(pi++) != (j = *(pj++))) \
                    *(px1++) = c##ZERO; \
                else \
                    *(px1++) = (un) ? c##UNIT : px0[j]; \
        } while (0)

SUB2 [5/5]

#define SUB2

(

c

)

SUB2__

#define SUB2__	(		c,
			assign,
			s,
			t,
			__for__,
			jump0,
			jump1 )

Value:

    do { \
        for (kj = 0; kj < nj; ++kj) { \
            if (mj) \
                j = kj; \
            else if (pj[kj] != NA_INTEGER) \
                j = pj[kj] - 1; \
            else { \
                jump0; \
                __for__ { \
                    *(px1++) = c##NA; \
                } \
                jump1; \
                continue; \
            } \
            jump0; \
            __for__ { \
                if (mi) \
                    i = ki; \
                else if (pi[ki] != NA_INTEGER) \
                    i = pi[ki] - 1; \
                else { \
                    *(px1++) = c##NA; \
                    continue; \
                } \
                assign(c, px0, px1, i, j, m, s, t); \
                px1++; \
            } \
            jump1; \
        } \
    } while (0)

TEMPLATE [1/2]

#define TEMPLATE

(

c

)

Value:

            do { \
                c##TYPE *px1 = NULL, *work = NULL; \
                c##IF_NPATTERN( \
                SEXP x1 = PROTECT(GET_SLOT(ans, Matrix_xSym)); \
                px1 = c##PTR(x1); \
                Matrix_Calloc(work, nnz, c##TYPE); \
                ); \
                c##cspsort(INTEGER(p1), INTEGER(i1), px1, ni, nj, iwork, work); \
                c##IF_NPATTERN( \
                Matrix_Free(work, nnz); \
                UNPROTECT(1); /* x1 */ \
                ); \
            } while (0)

Referenced by diagonal_subscript_2ary(), and sparse_subscript_2ary().

TEMPLATE [2/2]

#define TEMPLATE

(

c

)

Value:

        do { \
            c##TYPE *px0 = c##PTR(x0); \
            for (kj = 0; kj < nj; ++kj) { \
                j = (mj) ? kj : pj[kj] - 1; \
                pp1[kj] = 0; \
                if (un || c##NOT_ZERO(px0[j])) { \
                    if (mi) { \
                        for (ki = 0; ki < ni; ++ki) \
                            if (ki == j) \
                                ++pp1[kj]; \
                    } else { \
                        for (ki = 0; ki < ni; ++ki) \
                            if (pi[ki] - 1 == j) \
                                ++pp1[kj]; \
                    } \
                    if (pp1[kj] > INT_MAX - pp1[kj - 1]) \
                        break; \
                } \
                pp1[kj] += pp1[kj - 1]; \
            } \
        } while (0)

zCAST

#define zCAST

(

x

)

Value:

(x)

Definition at line 31 of file subscript.c.

Function Documentation

anyNA()

static int anyNA ( int * p, int n )

static

Definition at line 8 of file subscript.c.

Referenced by diagonal_subscript_2ary(), index_subscript_2ary(), sparse_subscript_2ary(), stay_di(), stay_sy(), and stay_tr().

dense_subscript_1ary()

static SEXP dense_subscript_1ary ( SEXP obj, const char * class, SEXP s )

static

Definition at line 37 of file subscript.c.

References DIAG, DIM, GET_SLOT, kindToType(), Matrix_xSym, SUB1, SWITCH5, TRANS, and UPLO.

Referenced by R_subscript_1ary().

dense_subscript_1ary_2col()

static SEXP dense_subscript_1ary_2col ( SEXP obj, const char * class, SEXP s )

static

Definition at line 377 of file subscript.c.

References DIAG, DIM, GET_SLOT, kindToType(), Matrix_xSym, SUB1, SWITCH5, TRANS, and UPLO.

Referenced by R_subscript_1ary_2col().

dense_subscript_2ary()

static SEXP dense_subscript_2ary ( SEXP obj, const char * class, SEXP si, SEXP sj )

static

Definition at line 817 of file subscript.c.

References _, ABS, cl, DIAG, DIM, GET_SLOT, Matrix_xSym, newObject(), SET_DIAG, SET_DIM, SET_SLOT, SET_TRANS, SET_UPLO, stay_sy(), stay_tr(), SUB2, SWITCH4, TRANS, TYPEOF, and UPLO.

Referenced by R_subscript_2ary().

diagonal_subscript_1ary()

static SEXP diagonal_subscript_1ary ( SEXP obj, const char * class, SEXP s )

static

Definition at line 252 of file subscript.c.

References DIAG, DIM, GET_SLOT, kindToType(), Matrix_xSym, SUB1, and SWITCH5.

Referenced by R_subscript_1ary().

diagonal_subscript_1ary_2col()

static SEXP diagonal_subscript_1ary_2col ( SEXP obj, const char * class, SEXP s )

static

Definition at line 585 of file subscript.c.

References DIAG, GET_SLOT, kindToType(), Matrix_xSym, SUB1, and SWITCH5.

Referenced by R_subscript_1ary_2col().

diagonal_subscript_2ary()

static SEXP diagonal_subscript_2ary ( SEXP obj, const char * class, SEXP si, SEXP sj )

static

Definition at line 1296 of file subscript.c.

References _, anyNA(), cl, DIAG, DIM, GET_SLOT, Matrix_iSym, Matrix_pSym, Matrix_xSym, newObject(), SET_DIAG, SET_DIM, SET_SLOT, stay_di(), SUB2, SWITCH4, TEMPLATE, and TYPEOF.

Referenced by R_subscript_2ary().

index_subscript_1ary()

static SEXP index_subscript_1ary ( SEXP obj, const char * class, SEXP s )

static

Definition at line 296 of file subscript.c.

References DIM, GET_SLOT, MARGIN, Matrix_permSym, and SUB1.

Referenced by R_subscript_1ary().

index_subscript_1ary_2col()

static SEXP index_subscript_1ary_2col ( SEXP obj, const char * class, SEXP s )

static

Definition at line 624 of file subscript.c.

References GET_SLOT, MARGIN, and Matrix_permSym.

Referenced by R_subscript_1ary_2col().

index_subscript_2ary()

static SEXP index_subscript_2ary ( SEXP obj, const char * class, SEXP si, SEXP sj )

static

Definition at line 1443 of file subscript.c.

References _, anyNA(), DIM, GET_SLOT, invertPerm(), isPerm(), MARGIN, Matrix_Calloc, Matrix_Free, Matrix_iSym, Matrix_jSym, Matrix_permSym, Matrix_pSym, newObject(), SET_DIM, SET_MARGIN, SET_SLOT, and SWAP.

Referenced by R_subscript_2ary().

R_subscript_1ary()

SEXP R_subscript_1ary	(	SEXP	s_obj,
		SEXP	s_s,
		SEXP	s_o )

Definition at line 348 of file subscript.c.

References dense_subscript_1ary(), diagonal_subscript_1ary(), index_subscript_1ary(), Matrix_class(), sparse_subscript_1ary(), valid_matrix, and validObject().

R_subscript_1ary_2col()

SEXP R_subscript_1ary_2col	(	SEXP	s_obj,
		SEXP	s_s,
		SEXP	s_o )

Definition at line 664 of file subscript.c.

References dense_subscript_1ary_2col(), diagonal_subscript_1ary_2col(), index_subscript_1ary_2col(), Matrix_class(), sparse_subscript_1ary_2col(), valid_matrix, and validObject().

R_subscript_2ary()

SEXP R_subscript_2ary	(	SEXP	s_obj,
		SEXP	s_si,
		SEXP	s_sj )

Definition at line 1580 of file subscript.c.

References dense_subscript_2ary(), diagonal_subscript_2ary(), index_subscript_2ary(), Matrix_class(), sparse_subscript_2ary(), valid_matrix, and validObject().

sparse_subscript_1ary()

static SEXP sparse_subscript_1ary ( SEXP obj, const char * class, SEXP s, SEXP o )

static

Definition at line 128 of file subscript.c.

References DIAG, DIM, GET_SLOT, kindToType(), Matrix_iSym, Matrix_jSym, Matrix_pSym, sparse_as_Csparse(), SUB1, SWITCH5, TRANS, TYPEOF, and UPLO.

Referenced by R_subscript_1ary().

sparse_subscript_1ary_2col()

static SEXP sparse_subscript_1ary_2col ( SEXP obj, const char * class, SEXP s, SEXP o )

static

Definition at line 465 of file subscript.c.

References DIAG, GET_SLOT, kindToType(), Matrix_iSym, Matrix_jSym, Matrix_pSym, sparse_as_Csparse(), SUB1, SWITCH5, TRANS, TYPEOF, and UPLO.

Referenced by R_subscript_1ary_2col().

sparse_subscript_2ary()

static SEXP sparse_subscript_2ary ( SEXP obj, const char * class, SEXP si, SEXP sj )

static

Definition at line 1037 of file subscript.c.

References _, ABS, anyNA(), cl, DIAG, DIM, GET_SLOT, Matrix_Calloc, Matrix_Free, Matrix_iSym, Matrix_jSym, Matrix_pSym, newObject(), SET_DIAG, SET_DIM, SET_SLOT, SET_TRANS, SET_UPLO, sparse_as_Csparse(), sparse_as_general(), sparse_as_Tsparse(), sparse_force_symmetric(), stay_sy(), stay_tr(), SUB2, SWAP, SWITCH5, TEMPLATE, TRANS, and UPLO.

Referenced by R_subscript_2ary().

stay_di()

static int stay_di ( int * pi, int ni, int * pj, int nj, int n, int checkNA )

static

Definition at line 780 of file subscript.c.

References anyNA(), Matrix_Calloc, and Matrix_Free.

Referenced by diagonal_subscript_2ary().

stay_sy()

static int stay_sy ( int * pi, int ni, int * pj, int nj, int n, char uplo, int checkNA )

static

Definition at line 688 of file subscript.c.

References anyNA().

Referenced by dense_subscript_2ary(), and sparse_subscript_2ary().

stay_tr()

static int stay_tr ( int * pi, int ni, int * pj, int nj, int n, char uplo, int checkNA )

static

Definition at line 717 of file subscript.c.

References anyNA().

Referenced by dense_subscript_2ary(), and sparse_subscript_2ary().