SCM

SCM Repository

[matrix] Annotation of /pkg/src/taucs_utils.c
ViewVC logotype

Annotation of /pkg/src/taucs_utils.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (view) (download) (as text)

1 : bates 10 #include "taucs_utils.h"
2 :    
3 :     /**
4 :     * Create a pointer to a taucs_ccs_matrix from an R object that
5 :     * inherits from class cscMatrix according to the flags.
6 :     *
7 :     * @param A Pointer to an object that inherits from cscMatrix
8 :     * @param flags taucs flags describing the matrix
9 :     *
10 :     * @return A taucs_ccs_matrix pointer to the existing storage (no copying).
11 :     */
12 :     taucs_ccs_matrix* csc_taucs_ptr(SEXP A, int flags)
13 :     {
14 :     taucs_ccs_matrix *ans =
15 :     (taucs_ccs_matrix *) R_alloc(1, sizeof(taucs_ccs_matrix));
16 :     int *dims = INTEGER(GET_SLOT(A, Matrix_DimSym));
17 :    
18 :     ans->flags = flags;
19 :     ans->m = dims[0];
20 :     ans->n = dims[1];
21 :     ans->colptr = INTEGER(GET_SLOT(A, Matrix_pSym));
22 :     ans->rowind = INTEGER(GET_SLOT(A, Matrix_iSym));
23 :     if (flags & TAUCS_DOUBLE)
24 :     ans->values.d = REAL(GET_SLOT(A, Matrix_xSym));
25 :     if (flags & TAUCS_DCOMPLEX)
26 :     ans->values.z =
27 :     (taucs_dcomplex *) COMPLEX(GET_SLOT(A, Matrix_zSym));
28 :     return ans;
29 :     }
30 :    
31 :     /**
32 :     * Copy a taucs_ccs_matrix to an R object of the appropriate class and
33 :     * free the storage used by the taucs_ccs_matrix.
34 :     *
35 :     * @param tm A pointer to a taucs_ccs_matrix
36 :     *
37 :     * @return An R object of class "cscMatrix" or "sscMatrix" or "tscMatrix"
38 :     */
39 :    
40 :     SEXP mat_from_taucs(taucs_ccs_matrix *tm)
41 :     {
42 :     SEXP ans;
43 :     char *cls;
44 :     int nnz = tm->colptr[tm->n];
45 :    
46 :     cls = "cscMatrix";
47 :     if (tm->flags & TAUCS_SYMMETRIC) cls = "sscMatrix";
48 :     if (tm->flags & TAUCS_TRIANGULAR) cls = "tscMatrix";
49 :     ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cls)));
50 :     SET_SLOT(ans, Matrix_pSym, allocVector(INTSXP, tm->n + 1));
51 :     Memcpy(INTEGER(GET_SLOT(ans, Matrix_pSym)), tm->colptr, tm->n + 1);
52 :     SET_SLOT(ans, Matrix_iSym, allocVector(INTSXP, nnz));
53 :     Memcpy(INTEGER(GET_SLOT(ans, Matrix_iSym)), tm->rowind, nnz);
54 :     SET_SLOT(ans, Matrix_xSym, allocVector(REALSXP, nnz));
55 :     Memcpy(REAL(GET_SLOT(ans, Matrix_xSym)), tm->values.d, nnz);
56 :     cscMatrix_set_Dim(ans, tm->m);
57 :     taucs_dccs_free(tm);
58 :     UNPROTECT(1);
59 :     return ans;
60 :     }
61 :    
62 :     taucs_ccs_matrix* copy_csc_to_taucs(SEXP A, int typ)
63 :     {
64 :     SEXP pslot = GET_SLOT(A, Matrix_pSym),
65 :     islot = GET_SLOT(A, Matrix_iSym);
66 :     int *dims = INTEGER(GET_SLOT(A, Matrix_DimSym));
67 :     taucs_ccs_matrix *ans =
68 :     taucs_ccs_create(dims[0], dims[1], length(islot), typ);
69 :    
70 :     Memcpy(ans->colptr, INTEGER(pslot), length(pslot));
71 :     Memcpy(ans->rowind, INTEGER(islot), length(islot));
72 :     if (typ & TAUCS_DOUBLE)
73 :     Memcpy(ans->values.d, REAL(GET_SLOT(A, Matrix_xSym)),
74 :     length(islot));
75 :     if (typ & TAUCS_DCOMPLEX)
76 :     Memcpy(ans->values.d,
77 :     (taucs_dcomplex *) COMPLEX(GET_SLOT(A, Matrix_zSym)),
78 :     length(islot));
79 :     return ans;
80 :     }
81 :    
82 :    
83 :    
84 :     /* Utilities for the TAUCS library */
85 :     /* timers */
86 :     double taucs_wtime() { return 0.0; }
87 :     double taucs_ctime() { return 0.0; }
88 :     /* memory allocation */
89 :     #undef malloc
90 :     #undef calloc
91 :     #undef realloc
92 :     #undef free
93 :    
94 :     void* taucs_malloc_stub (size_t size) { return malloc(size); }
95 :     void* taucs_calloc_stub (size_t nmemb, size_t size) { return calloc(nmemb,size); }
96 :     void* taucs_realloc_stub(void* ptr, size_t size) { return realloc(ptr,size); }
97 :     void taucs_free_stub (void* ptr) { free(ptr); }
98 :    
99 :     double taucs_allocation_amount() { return 0.0; }
100 :     int taucs_allocation_count() { return 0; }
101 :     int taucs_allocation_attempts() { return 0; }
102 :     void taucs_allocation_assert_clean() {}
103 :     void taucs_allocation_mark_clean() {}
104 :     void taucs_allocation_induce_failure(int i) {}
105 :     /* logging */
106 :     int
107 :     taucs_printf(char *fmt, ...)
108 :     {
109 :     return 0;
110 :     }
111 :     /* arithmetic constants */
112 :     double taucs_get_nan() { return R_NaN; }
113 :     double taucs_dzero_const = 0.0;
114 :     double taucs_done_const = 1.0;
115 :     double taucs_dminusone_const = -1.0;

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge