Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 146 lines (114 sloc) 3.172 kb
55950257 » ripley
2001-06-06 add tests for na handling
1 ## tests of R functions based on the lapack module
2
44898a61 » ripley
2007-04-26 more useful test output
3 options(digits=4)
4
5 ## ------- examples from ?svd ---------
55950257 » ripley
2001-06-06 add tests for na handling
6
7 hilbert <- function(n) { i <- 1:n; 1 / outer(i - 1, i, "+") }
8 Eps <- 100 * .Machine$double.eps
9
10 X <- hilbert(9)[,1:6]
44898a61 » ripley
2007-04-26 more useful test output
11 (s <- svd(X)); D <- diag(s$d)
12 stopifnot(abs(X - s$u %*% D %*% t(s$v)) < Eps)# X = U D V'
13 stopifnot(abs(D - t(s$u) %*% X %*% s$v) < Eps)# D = U' X V
55950257 » ripley
2001-06-06 add tests for na handling
14
d81c11ac » ripley
2012-04-08 avoid differences on i386 Lion
15 # The signs of the vectors are not determined here.
55950257 » ripley
2001-06-06 add tests for na handling
16 X <- cbind(1, 1:7)
d81c11ac » ripley
2012-04-08 avoid differences on i386 Lion
17 s <- svd(X); D <- diag(s$d)
44898a61 » ripley
2007-04-26 more useful test output
18 stopifnot(abs(X - s$u %*% D %*% t(s$v)) < Eps)# X = U D V'
19 stopifnot(abs(D - t(s$u) %*% X %*% s$v) < Eps)# D = U' X V
55950257 » ripley
2001-06-06 add tests for na handling
20
b3dd199f » ripley
2001-12-03 more tests, more docs
21 # test nu and nv
d81c11ac » ripley
2012-04-08 avoid differences on i386 Lion
22 s <- svd(X, nu = 0)
23 s <- svd(X, nu = 7) # the last 5 columns are not determined here
b3dd199f » ripley
2001-12-03 more tests, more docs
24 stopifnot(dim(s$u) == c(7,7))
d81c11ac » ripley
2012-04-08 avoid differences on i386 Lion
25 s <- svd(X, nv = 0)
b3dd199f » ripley
2001-12-03 more tests, more docs
26
55950257 » ripley
2001-06-06 add tests for na handling
27 # test of complex case
28
29 X <- cbind(1, 1:7+(-3:3)*1i)
c4dcd5dd » ripley
2007-05-04 more diffable output
30 s <- svd(X); D <- diag(s$d)
55950257 » ripley
2001-06-06 add tests for na handling
31 stopifnot(abs(X - s$u %*% D %*% Conj(t(s$v))) < Eps)
32 stopifnot(abs(D - Conj(t(s$u)) %*% X %*% s$v) < Eps)
33
34
35
36 ## ------- tests of random real and complex matrices ------
c4dcd5dd » ripley
2007-05-04 more diffable output
37 fixsign <- function(A) {
38 A[] <- apply(A, 2, function(x) x*sign(Re(x[1])))
39 A
40 }
7bef6c82 » maechler
2004-07-28 add the 3x3 test that failed on my AMD 64bit arch
41 ## 100 may cause failures here.
55950257 » ripley
2001-06-06 add tests for na handling
42 eigenok <- function(A, E, Eps=1000*.Machine$double.eps)
43 {
c4dcd5dd » ripley
2007-05-04 more diffable output
44 print(fixsign(E$vectors))
45 print(zapsmall(E$values))
1de4e06a » ripley
2007-05-18 removes some partial matches on $
46 V <- E$vectors; lam <- E$values
55950257 » ripley
2001-06-06 add tests for na handling
47 stopifnot(abs(A %*% V - V %*% diag(lam)) < Eps,
7bef6c82 » maechler
2004-07-28 add the 3x3 test that failed on my AMD 64bit arch
48 abs(lam[length(lam)]/lam[1]) < Eps || # this one not for singular A :
55950257 » ripley
2001-06-06 add tests for na handling
49 abs(A - V %*% diag(lam) %*% t(V)) < Eps)
50 }
51
52 Ceigenok <- function(A, E, Eps=1000*.Machine$double.eps)
53 {
c4dcd5dd » ripley
2007-05-04 more diffable output
54 print(fixsign(E$vectors))
e57e3f7f » ripley
2007-07-24 avoid some system-specfic signs
55 print(signif(E$values, 5))
1de4e06a » ripley
2007-05-18 removes some partial matches on $
56 V <- E$vectors; lam <- E$values
55950257 » ripley
2001-06-06 add tests for na handling
57 stopifnot(Mod(A %*% V - V %*% diag(lam)) < Eps,
58 Mod(A - V %*% diag(lam) %*% Conj(t(V))) < Eps)
59 }
60
7bef6c82 » maechler
2004-07-28 add the 3x3 test that failed on my AMD 64bit arch
61 ## failed for some 64bit-Lapack-gcc combinations:
62 sm <- cbind(1, 3:1, 1:3)
63 eigenok(sm, eigen(sm))
64 eigenok(sm, eigen(sm, sym=FALSE))
65
55950257 » ripley
2001-06-06 add tests for na handling
66 set.seed(123)
67 sm <- matrix(rnorm(25), 5, 5)
68 sm <- 0.5 * (sm + t(sm))
69 eigenok(sm, eigen(sm))
de414487 » ripley
2004-04-16 Deprecated -> Defunct
70 eigenok(sm, eigen(sm, sym=FALSE))
55950257 » ripley
2001-06-06 add tests for na handling
71
72 sm[] <- as.complex(sm)
73 Ceigenok(sm, eigen(sm))
de414487 » ripley
2004-04-16 Deprecated -> Defunct
74 Ceigenok(sm, eigen(sm, sym=FALSE))
55950257 » ripley
2001-06-06 add tests for na handling
75
76 sm[] <- sm + rnorm(25) * 1i
77 sm <- 0.5 * (sm + Conj(t(sm)))
78 Ceigenok(sm, eigen(sm))
de414487 » ripley
2004-04-16 Deprecated -> Defunct
79 Ceigenok(sm, eigen(sm, sym=FALSE))
32451e57 » ripley
2012-08-28 more support for logical matrices
80
81
82 ## ------- tests of integer matrices -----------------
83
84 set.seed(123)
85 A <- matrix(rpois(25, 5), 5, 5)
86
87 A %*% A
88 crossprod(A)
89 tcrossprod(A)
90
91 solve(A)
92 qr(A)
93 determinant(A, log = FALSE)
94
95 rcond(A)
96 rcond(A, "I")
97 rcond(A, "1")
98
99 eigen(A)
100 svd(A)
101 La.svd(A)
102
103 As <- crossprod(A)
5a07e664 » ripley
2012-08-30 more diff-able output
104 E <- eigen(As)
105 E$values
106 abs(E$vectors) # signs vary
32451e57 » ripley
2012-08-28 more support for logical matrices
107 chol(As)
108 backsolve(As, 1:5)
109
110 ## ------- tests of logical matrices -----------------
111
112 set.seed(123)
113 A <- matrix(runif(25) > 0.5, 5, 5)
114
115 A %*% A
116 crossprod(A)
117 tcrossprod(A)
118
5a07e664 » ripley
2012-08-30 more diff-able output
119 Q <- qr(A)
120 zapsmall(Q$qr)
121 zapsmall(Q$qraux)
32451e57 » ripley
2012-08-28 more support for logical matrices
122 determinant(A, log = FALSE) # 0
123
124 rcond(A)
125 rcond(A, "I")
126 rcond(A, "1")
127
5a07e664 » ripley
2012-08-30 more diff-able output
128 E <- eigen(A)
129 zapsmall(E$values)
130 zapsmall(Mod(E$vectors))
131 S <- svd(A)
132 zapsmall(S$d)
133 S <- La.svd(A)
134 zapsmall(S$d)
32451e57 » ripley
2012-08-28 more support for logical matrices
135
136 As <- A
137 As[upper.tri(A)] <- t(A)[upper.tri(A)]
138 det(As)
5a07e664 » ripley
2012-08-30 more diff-able output
139 E <- eigen(As)
140 E$values
141 zapsmall(E$vectors)
32451e57 » ripley
2012-08-28 more support for logical matrices
142 solve(As)
143
144 ## quite hard to come up with an example where this might make sense.
145 Ac <- A; Ac[] <- as.logical(diag(5))
146 chol(Ac)
147
148
Something went wrong with that request. Please try again.