SCM

SCM Repository

[matrix] Annotation of /pkg/R/Matrix.R
ViewVC logotype

Annotation of /pkg/R/Matrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 499 - (view) (download)

1 : bates 10 setMethod("show", signature(object = "Matrix"),
2 :     function(object) print(as(object, "matrix")))
3 :    
4 :     Matrix <-
5 :     function (data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL)
6 :     {
7 :     if (is(data, "Matrix")) return(data)
8 :     if (is.matrix(data)) { val <- data }
9 :     else {
10 :     if (missing(nrow))
11 :     nrow <- ceiling(length(data)/ncol)
12 :     else if (missing(ncol))
13 :     ncol <- ceiling(length(data)/nrow)
14 :     val <- .Internal(matrix(data, nrow, ncol, byrow))
15 :     dimnames(val) <- dimnames
16 :     }
17 : bates 477 as(val, "dgeMatrix")
18 : bates 10 }
19 :    
20 :     Matrix.class <- function(x, tol = 0, symmetry = TRUE, unit.diagonal = TRUE,
21 :     triangularity = c(TRUE, TRUE),
22 : maechler 499 orthogonality = c(TRUE, TRUE),
23 :     normality = c(TRUE, TRUE))
24 : bates 10 {
25 :     val <- "Matrix"
26 :     x <- as.matrix(x)
27 :     if (symmetry) {
28 :     if (is.Hermitian(x, tol)) val <- c("Hermitian", val)
29 :     }
30 :     if (triangularity[1]) {
31 :     if (is.LowerTriangular(x, tol)) {
32 :     val <- c("LowerTriangular", val)
33 :     if (unit.diagonal)
34 :     if (max(Mod(diag(x) - 1)) <= tol)
35 :     val <- c("UnitLowerTriangular", val)
36 :     }
37 :     }
38 :     if (triangularity[2]) {
39 :     if (is.UpperTriangular(x, tol)) {
40 :     val <- c("UpperTriangular", val)
41 :     if (unit.diagonal)
42 :     if (max(Mod(diag(x) - 1)) <= tol)
43 :     val <- c("UnitUpperTriangular", val)
44 :     }
45 :     }
46 :     if (orthogonality[1]) {
47 :     if (is.ColOrthonormal(x, tol)) {
48 :     val <- c("ColOrthoNormal", "ColOrthogonal", val)
49 :     } else {
50 :     if (Orthogonal.test(x, normal = FALSE) <= tol)
51 :     val <- c("ColOrthogonal", val)
52 :     }
53 :     }
54 :     if (orthogonality[2]) {
55 :     if (normality[2] && is.RowOrthonormal(x, tol)) {
56 :     val <- c("RowOrthoNormal", "RowOrthogonal", val)
57 :     } else {
58 :     if (Orthogonal.test(x, byrow = TRUE, normal = FALSE) <= tol)
59 :     val <- c("RowOrthogonal", val)
60 :     }
61 :     }
62 :     val
63 :     }
64 :    
65 :     as.Matrix <- function(x, tol = .Machine$double.eps)
66 :     {
67 : maechler 499 asObject(if (inherits(x, "Matrix")) x else as.matrix(x),
68 :     Matrix.class(x, tol = tol))
69 : bates 10 }

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