# SCM Repository

[matrix] Annotation of /pkg/R/dtpMatrix.R
 [matrix] / pkg / R / dtpMatrix.R

# Annotation of /pkg/R/dtpMatrix.R

 1 : bates 597 #### Triangular Packed Matrices -- Coercion and Methods 2 : 3 : setAs("dtpMatrix", "dtrMatrix", 4 : function(from) .Call("dtpMatrix_as_dtrMatrix", from) ) 5 : 6 : setAs("dtpMatrix", "dgeMatrix", 7 : function(from) as(as(from, "dtrMatrix"), "dgeMatrix")) 8 : 9 : setAs("dtpMatrix", "matrix", 10 : function(from) as(as(from, "dtrMatrix"), "matrix")) 11 : maechler 657 setAs("matrix", "dtpMatrix", 12 : function(from) as(as(from, "dtrMatrix"), "dtpMatrix")) 13 : bates 597 14 : maechler 609 15 : bates 597 setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"), 16 : function(x, y) .Call("dtpMatrix_dgeMatrix_mm", x, y)) 17 : maechler 609 setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"), 18 : maechler 628 function(x, y) .Call("dgeMatrix_dtpMatrix_mm", x, y)) 19 : maechler 657 ## %*% should always work for %*% 20 : setMethod("%*%", signature(x = "dtpMatrix", y = "dtpMatrix"), 21 : function(x, y) 22 : ## FIXME: this is cheap; could we optimize chosing the better of 23 : ## callGeneric(x, as(y, "dgeMatrix")) and 24 : ## callGeneric(as(x "dgeMatrix"), y)) depending on their 'uplo' ? 25 : callGeneric(x, as(y, "dgeMatrix"))) 26 : 27 : ## dtpMatrix <-> matrix : will be used by the "numeric" one 28 : bates 603 setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"), 29 : maechler 657 function(x, y) callGeneric(x, as(y, "dgeMatrix"))) 30 : maechler 628 setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"), 31 : maechler 657 function(x, y) callGeneric(as(x, "dgeMatrix"), y)) 32 : bates 603 33 : maechler 657 ## dtpMatrix <-> numeric : the auxiliary functions are R version specific! 34 : bates 683 ##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v) 35 : ##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M) 36 : maechler 628 37 : maechler 657 38 : bates 597 setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"), 39 : function(x, logarithm, ...) determinant(x, TRUE)) 40 : 41 : setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"), 42 : function(x, logarithm, ...) { 43 : dg <- diag(x) 44 : if (logarithm) { 45 : modulus <- sum(log(abs(dg))) 46 : sgn <- prod(sign(dg)) 47 : } else { 48 : modulus <- prod(dg) 49 : sgn <- sign(modulus) 50 : modulus <- abs(modulus) 51 : } 52 : attr(modulus, "logarithm") <- logarithm 53 : val <- list(modulus = modulus, sign = sgn) 54 : class(val) <- "det" 55 : val 56 : }) 57 : 58 : maechler 657 setMethod("diag", signature(x = "dtpMatrix"), 59 : function(x = 1, nrow, ncol = n) .Call("dtpMatrix_getDiag", x), 60 : valueClass = "numeric") 61 : 62 : bates 597 setMethod("norm", signature(x = "dtpMatrix", type = "character"), 63 : function(x, type, ...) 64 : .Call("dtpMatrix_norm", x, type), 65 : valueClass = "numeric") 66 : 67 : setMethod("norm", signature(x = "dtpMatrix", type = "missing"), 68 : function(x, type, ...) 69 : .Call("dtpMatrix_norm", x, "O"), 70 : valueClass = "numeric") 71 : 72 : setMethod("rcond", signature(x = "dtpMatrix", type = "character"), 73 : function(x, type, ...) 74 : .Call("dtpMatrix_rcond", x, type), 75 : valueClass = "numeric") 76 : 77 : setMethod("rcond", signature(x = "dtpMatrix", type = "missing"), 78 : function(x, type, ...) 79 : .Call("dtpMatrix_rcond", x, "O"), 80 : valueClass = "numeric") 81 : 82 : setMethod("solve", signature(a = "dtpMatrix", b="missing"), 83 : function(a, b, ...) 84 : .Call("dtpMatrix_solve", a), 85 : valueClass = "dtpMatrix") 86 : 87 : setMethod("solve", signature(a = "dtpMatrix", b="matrix"), 88 : function(a, b, ...) 89 : .Call("dtpMatrix_matrix_solve", a, b), 90 : valueClass = "matrix") 91 : 92 : setMethod("t", signature(x = "dtpMatrix"), 93 : function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"), 94 : valueClass = "dtpMatrix") 95 : bates 642 96 : setMethod("unpack", signature(x = "dtpMatrix"), 97 : function(x, ...) as(x, "dtrMatrix"), 98 : valueClass = "dtrMatrix") 99 : bates 597 ###