File: dtrMatrix.R

package info (click to toggle)
rmatrix 0.999375-43-1
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 8,068 kB
  • ctags: 2,395
  • sloc: ansic: 37,941; makefile: 216; sh: 128
file content (122 lines) | stat: -rw-r--r-- 4,469 bytes parent folder | download
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
#### Triangular Matrices -- Coercion and Methods


## or rather setIs() {since test can fail }?
## FIXME: get rid of this (coerce to "triangular..") ?!?
setAs("dgeMatrix", "dtrMatrix", function(from) asTri(from, "dtrMatrix"))

setAs("dtrMatrix", "dtpMatrix",
      function(from) .Call(dtrMatrix_as_dtpMatrix, from))

setAs("dtrMatrix", "sparseMatrix", .dense2C)
setAs("dtrMatrix", "CsparseMatrix", .dense2C)


## needed for t() method
setAs("dtrMatrix", "matrix",
      function(from) .Call(dtrMatrix_as_matrix, from, TRUE))

setAs("matrix", "dtrMatrix",
      function(from) as(.Call(dup_mMatrix_as_dgeMatrix, from), "dtrMatrix"))

setAs("Cholesky", "lMatrix",
      function(from) as(as(from, "dtrMatrix"), "lMatrix"))
setAs("BunchKaufman", "lMatrix",
      function(from) as(as(from, "dtrMatrix"), "lMatrix"))


## Group Methods:
## TODO: carefully check for the cases where the result remains triangular
## instead : inherit them from "dgeMatrix" via definition in ./dMatrix.R

## Note: Just *because* we have an explicit  dtr -> dge coercion,
##       show( <ddenseMatrix> ) is not okay, and we need our own:
setMethod("show", "dtrMatrix", function(object) prMatrix(object))

setMethod("determinant", signature(x = "dtrMatrix", logarithm = "missing"),
	  function(x, logarithm, ...) callGeneric(x, TRUE))

setMethod("determinant", signature(x = "dtrMatrix", logarithm = "logical"),
	  function(x, logarithm, ...) mkDet(diag(x), logarithm))

setMethod("diag", signature(x = "dtrMatrix"),
          function(x, nrow, ncol) .Call(dtrMatrix_getDiag, x),
          valueClass = "numeric")

setMethod("norm", signature(x = "dtrMatrix", type = "character"),
	  function(x, type, ...)
	  .Call(dtrMatrix_norm, x, type),
	  valueClass = "numeric")

setMethod("norm", signature(x = "dtrMatrix", type = "missing"),
	  function(x, type, ...)
	  .Call(dtrMatrix_norm, x, "O"),
	  valueClass = "numeric")

setMethod("rcond", signature(x = "dtrMatrix", norm = "character"),
	  function(x, norm, ...)
	  .Call(dtrMatrix_rcond, x, norm),
	  valueClass = "numeric")

setMethod("rcond", signature(x = "dtrMatrix", norm = "missing"),
	  function(x, norm, ...)
	  .Call(dtrMatrix_rcond, x, "O"),
	  valueClass = "numeric")

if(getRversion() < "2.10.0" || R.version$`svn rev` < 49944) {
    ## for now: still carry  'size' and 'LINPACK'
setMethod("chol2inv", signature(x = "dtrMatrix"),
          function (x, size = NCOL(x), LINPACK = FALSE)
      {
          if (!missing(size) || !missing(LINPACK))
              warning("Arguments size and LINPACK are ignored for chol2inv\n\tmethods in the Matrix package")
          if (x@diag != "N") x <- diagU2N(x)
          .Call(dtrMatrix_chol2inv, x)
      })
} else {## chol2inv() has implicit generic in newer versions of R
setMethod("chol2inv", signature(x = "dtrMatrix"),
	  function (x, ...) {
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      if (x@diag != "N") x <- diagU2N(x)
	      .Call(dtrMatrix_chol2inv, x)
	  })
}

setMethod("solve", signature(a = "dtrMatrix", b="missing"),
	  function(a, b, ...) {
	      ## warn, as e.g. CHMfactor have 'system' as third argument
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      .Call(dtrMatrix_solve, a)
	  }, valueClass = "dtrMatrix")

setMethod("solve", signature(a = "dtrMatrix", b="ddenseMatrix"),
	  function(a, b, ...) {
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      .Call(dtrMatrix_matrix_solve, a, b)
	  }, valueClass = "dgeMatrix")

setMethod("solve", signature(a = "dtrMatrix", b="dMatrix"),
	  function(a, b, ...) {
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      .Call(dtrMatrix_matrix_solve, a, as(b,"denseMatrix"))
	  }, valueClass = "dgeMatrix")
setMethod("solve", signature(a = "dtrMatrix", b="Matrix"),
	  function(a, b, ...) {
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      .Call(dtrMatrix_matrix_solve, a, as(as(b, "dMatrix"),
						  "denseMatrix"))
	  }, valueClass = "dgeMatrix")

setMethod("solve", signature(a = "dtrMatrix", b="matrix"),
	  function(a, b, ...) {
	      if(length(list(...)))
		  warning("arguments in", deparse(list(...)), "are disregarded")
	      .Call(dtrMatrix_matrix_solve, a, b)
	  }, valueClass = "dgeMatrix")

setMethod("t", signature(x = "dtrMatrix"), t_trMatrix)