Initial check-in of automated testing framework.
[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((is.vector(a) && !is.vector(b)) || 
19                 (is.vector(b) && !is.vector(a))) {
20                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
21                         "and", omxQuotes(paste(b, collapse = ' ')), 
22                         "are not both vectors"))        
23         }
24         if((is.matrix(a) && !is.matrix(b)) || 
25                 (is.matrix(b) && !is.matrix(a))) {
26                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
27                         "and", omxQuotes(paste(b, collapse = ' ')), 
28                         "are not both matrices"))       
29         }       
30         if (is.vector(a) && (length(a) != length(b))) {
31                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
32                         "and", omxQuotes(paste(b, collapse = ' ')), 
33                         "do not have equal length :",
34                         length(a), 'and', length(b)))
35         }
36         if (is.matrix(a) && any(dim(a) != dim(b))) {
37                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
38                         "and", omxQuotes(paste(b, collapse = ' ')), 
39                         "are not of equal dimension :", 
40                         paste(dim(a), collapse = ' x '), 'and', 
41                         paste(dim(b), collapse = ' x ')))
42         }
43 }
44
45 omxCheckEquals <- function(a, b) {
46         checkEqualDimensions(a, b)      
47         if (any(a != b)) {
48                 stop(paste(a, "and", b, "are not equal"))
49         }       
50 }
51
52 omxCheckSetEquals <- function(a, b) {
53         checkEqualDimensions(a, b)      
54         if (!setequal(a, b)) {
55                 stop(paste(a, "and", b, "do not contain the same elements"))
56         }       
57 }
58
59 omxCheckTrue <- function(a) {   
60         if (any(!a)) {
61                 stop(paste(match.call()$a, "is not true"))
62         }
63 }
64
65
66 omxCheckCloseEnough <- function(a, b, epsilon=10^(-15)) {
67         checkEqualDimensions(a, b)
68         check <- any(mapply(function(x,y) {
69                         abs(x - y) > epsilon }, 
70                         as.vector(a), as.vector(b)))
71         if (check) {
72                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
73                         "and", omxQuotes(paste(b, collapse = ' ')), 
74                         "are not equal to within", epsilon))
75         }
76 }
77
78 omxCheckWithinPercentError <- function(a, b, epsilon=10^(-15)) {
79         checkEqualDimensions(a, b)      
80         check <- any(mapply(function(x,y) {
81                         (abs(x - y)/x * 100) > epsilon }, 
82                         as.vector(a), as.vector(b)))    
83         if (check) {
84                 stop(paste(omxQuotes(paste(a, collapse = ' ')), 
85                         "does not estimate", 
86                         omxQuotes(paste(b, collapse = ' ')), 
87                         "within", epsilon, "percent"))
88         }
89 }