File: dtpMatrix.R

package info (click to toggle)
rmatrix 1.3-2-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 7,024 kB
  • sloc: ansic: 42,435; makefile: 330; sh: 180
file content (80 lines) | stat: -rw-r--r-- 2,814 bytes parent folder | download | duplicates (2)
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
#### Triangular Packed Matrices -- Coercion and Methods

setAs("dtpMatrix", "dtrMatrix",
      dtp2dtr <- function(from) .Call(dtpMatrix_as_dtrMatrix, from))

## Is this needed?  already have coercion to "TsparseMatrix" {FIXME}
setAs("dtpMatrix", "dtTMatrix",
      function(from) {
	  x <- as(from, "TsparseMatrix")
          cld <- getClassDef(class(x))
	  if(extends(cld, "dtTMatrix"))
	      x
	  else { ## triangularity lost: should not have happened
	      warning("inefficient coercion (lost triangularity); please report")
	      gT2tT(as(x, "dgTMatrix"), uplo = from@uplo, diag = from@diag,
		    toClass = "dtTMatrix", do.n = FALSE)
	  }
      })

setAs("dtpMatrix", "matrix",
      function(from) as(dtp2dtr(from), "matrix"))
setAs("matrix", "dtpMatrix",
      function(from) as(as(from, "dtrMatrix"), "dtpMatrix"))

setAs("pCholesky", "lMatrix",
      function(from) as(as(from, "dtpMatrix"), "lMatrix"))
setAs("pBunchKaufman", "lMatrix",
      function(from) as(as(from, "dtpMatrix"), "lMatrix"))


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

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

setMethod("diag", signature(x = "dtpMatrix"),
	  function(x, nrow, ncol) .Call(dtpMatrix_getDiag, x),
	  valueClass = "numeric")
setMethod("diag<-", signature(x = "dtpMatrix"),
	  function(x, value) {
	      .Call(dtpMatrix_setDiag,
		    if(x@diag == "U") .dense.diagU2N(x, "d", isPacked=TRUE) else x,
		    value)
	  })

setMethod("norm", signature(x = "dtpMatrix", type = "character"),
	  function(x, type, ...)
	      if(identical("2", type)) norm2(x) else .Call(dtpMatrix_norm, x, type),
	  valueClass = "numeric")

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

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

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

setMethod("solve", signature(a = "dtpMatrix", b="missing"),
	  function(a, b, ...) .Call(dtpMatrix_solve, a),
	  valueClass = "dtpMatrix")

setMethod("solve", signature(a = "dtpMatrix", b="ddenseMatrix"),
	  function(a, b, ...) .Call(dtpMatrix_matrix_solve, a, b),
	  valueClass = "dgeMatrix")

setMethod("solve", signature(a = "dtpMatrix", b="matrix"),
	  function(a, b, ...) .Call(dtpMatrix_matrix_solve, a, b),
	  valueClass = "dgeMatrix")

## FIXME: speed up
setMethod("t", "dtpMatrix",
	  function(x) dtr2dtp(t(dtp2dtr(x))), valueClass = "dtpMatrix")