File: sparse.R

package info (click to toggle)
rsymphony 0.1-33-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 120 kB
  • sloc: cpp: 47; sh: 44; ansic: 21; makefile: 2
file content (89 lines) | stat: -rw-r--r-- 2,319 bytes parent folder | download | duplicates (3)
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
## Simple functions for converting "matrix" type objects into the
## sparse "column major order" (CSC, modulo offsets) format used by
## SYMPHONY.

## matind: vector of the row indices corresponding to each entry of
##   value 
## values: vector of the values of nonzero entries of the constraint
##   matrix in column order.

make_csc_matrix <-
function(x)
    UseMethod("make_csc_matrix")

make_csc_matrix.matrix <-
function(x)
{
    if(!is.matrix(x))
        stop("Argument 'x' must be a matrix.")
   
    ind <- which(x != 0, arr.ind = TRUE, useNames = FALSE)
    if(!length(ind)) {
        ## As of 2016-08-29, the above gives integer(0) instead of a
        ## matrix in case x has zero rows or cols, because x != 0 drops
        ## dimensions ...
        ind <- matrix(ind, 0L, 2L)
    }
    
    list(matbeg = c(0L, cumsum(tabulate(ind[, 2L], ncol(x)))),
         matind = ind[, 1] - 1L,
         values = x[ind])
}

make_csc_matrix.simple_triplet_matrix <-
function(x)
{
    if(!inherits(x, "simple_triplet_matrix"))
        stop("Argument 'x' must be of class 'simple_triplet_matrix'.")

    ## The matrix method assumes that indices for non-zero entries are
    ## in row-major order, but the simple_triplet_matrix() constructor
    ## currently does not canonicalize accordingly ...
    ind <- order(x$j, x$i)
    list(matbeg = c(0L, cumsum(tabulate(x$j[ind], x$ncol))),
         matind = x$i[ind] - 1L,
         values = x$v[ind])
}

make_csc_matrix.dgCMatrix <- 
function(x) 
{
    list(matbeg = x@p, matind = x@i, values = x@x)
}

make_csc_matrix.matrix.csc <- 
function(x) 
{
    list(matbeg = x@ia - 1L, matind = x@ja - 1L, values = x@ra)
}

make_csc_matrix.dgTMatrix <-
function(x)
{
    ind <- order(x@j, x@i)
    list(matbeg = c(0L, cumsum(tabulate(x@j[ind] + 1L, x@Dim[2L]))),
         matind = x@i[ind],
         values = x@x[ind])
}

make_csc_matrix.matrix.coo <-
function(x)
{
    ind <- order(x@ja, x@ia)
    list(matbeg = c(0L, cumsum(tabulate(x@ja[ind], x@dimension[2L]))),
         matind = x@ia[ind] - 1L,
         values = x@ra[ind])
}

make_csc_matrix.dgRMatrix <-
function(x) {
    x <- Matrix::t(x)
    list(matbeg = x@p, matind = x@j, values = x@x)
}

make_csc_matrix.matrix.csr <-
function(x)
{
    x <- SparseM::t(x)
    list(matbeg = x@ia - 1L, matind = x@ja - 1L, values = x@ra)
}