Added more tests to AlgebraCompute.R, and now some algebra
[openmx:openmx.git] / R / MxUnitTesting.R
1 #
2 #   Copyright 2007-2009 The OpenMx Project
3 #
4 #   Licensed under the Apache License, Version 2.0 (the "License");
5 #   you may not use this file except in compliance with the License.
6 #   You may obtain a copy of the License at
7
8 #        http://www.apache.org/licenses/LICENSE-2.0
9
10 #   Unless required by applicable law or agreed to in writing, software
11 #   distributed under the License is distributed on an "AS IS" BASIS,
12 #   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 #   See the License for the specific language governing permissions and
14 #   limitations under the License.
15
16
17 checkEqualDimensions <- function(a, b) {
18         if(length(a) == 0 && length(b) == 0) {
19                 
20         } else if (!(length(a) > 0 && length(b) > 0)) {
21                 stop(paste("One of these is a 0x0 matrix:",
22                         omxQuotes(paste(a, collapse = ' ')), 
23                         "and", omxQuotes(paste(b, collapse = ' '))))    
24         }
25         if((is.vector(a) && length(a) > 1 && !is.vector(b)) || 
26                 (is.vector(b) && length(b) > 1 && !is.vector(a))) {
27                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
28                         "and", omxQuotes(paste(b, collapse = ' ')), 
29                         "are not both vectors"))        
30         }
31         if((is.matrix(a) && (nrow(a) > 1 || ncol(a) > 1) && !is.matrix(b)) || 
32                 (is.matrix(b) && (nrow(b) > 1 || ncol(b) > 1) && !is.matrix(a))) {
33                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
34                         "and", omxQuotes(paste(b, collapse = ' ')), 
35                         "are not both matrices"))       
36         }       
37         if (is.vector(a) && (length(a) != length(b))) {
38                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
39                         "and", omxQuotes(paste(b, collapse = ' ')), 
40                         "do not have equal length :",
41                         length(a), 'and', length(b)))
42         }
43         if (is.matrix(a) && (nrow(a) > 1 || ncol(a) > 1) && any(dim(a) != dim(b))) {
44                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
45                         "and", omxQuotes(paste(b, collapse = ' ')), 
46                         "are not of equal dimension :", 
47                         paste(dim(a), collapse = ' x '), 'and', 
48                         paste(dim(b), collapse = ' x ')))
49         }
50 }
51
52 omxCheckEquals <- function(a, b) {
53         checkEqualDimensions(a, b)      
54         if (any(a != b)) {
55                 stop(paste(a, "and", b, "are not equal"))
56         }       
57 }
58
59 omxCheckSetEquals <- function(a, b) {
60         checkEqualDimensions(a, b)      
61         if (!setequal(a, b)) {
62                 stop(paste(a, "and", b, "do not contain the same elements"))
63         }       
64 }
65
66 omxCheckTrue <- function(a) {   
67         if (any(!a)) {
68                 stop(paste(match.call()$a, "is not true"))
69         }
70 }
71
72
73 omxCheckCloseEnough <- function(a, b, epsilon=10^(-15)) {
74         checkEqualDimensions(a, b)
75         check <- any(mapply(function(x,y) {
76                         abs(x - y) > epsilon }, 
77                         as.vector(a), as.vector(b)))
78         if (check) {
79                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
80                         "and", omxQuotes(paste(b, collapse = ' ')), 
81                         "are not equal to within", epsilon))
82         }
83 }
84
85 omxCheckWithinPercentError <- function(a, b, epsilon=10^(-15)) {
86         checkEqualDimensions(a, b)      
87         check <- any(mapply(function(x,y) {
88                         (abs(x - y)/x * 100) > epsilon }, 
89                         as.vector(a), as.vector(b)))    
90         if (check) {
91                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
92                         "does not estimate", 
93                         omxQuotes(paste(b, collapse = ' ')), 
94                         "within", epsilon, "percent"))
95         }
96 }