Updated copyright to 2013 for R/ demo/ models/passing and src/ folders, and also...
[openmx:openmx.git] / R / IdenMatrix.R
1 #
2 #   Copyright 2007-2013 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 setClass(Class = "IdenMatrix",
18         representation = representation(),
19         contains = "MxMatrix")
20
21 setMethod("imxSquareMatrix", "IdenMatrix",
22         function(.Object) { return(TRUE) }
23 )       
24
25 setMethod("imxCreateMatrix", "IdenMatrix",
26         function(.Object, labels, values, free, lbound, ubound, nrow, ncol, byrow, name, ...) {
27                 if (!single.na(values)) {
28                         warning("Ignoring values matrix for identity matrix construction ",
29                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")), 
30                                 call. = FALSE)
31                 }
32                 if (!single.na(labels)) {
33                         warning("Ignoring labels matrix for identity matrix construction ",
34                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")), 
35                                 call. = FALSE)
36                 }
37                 if (!(length(free) == 1 && free == FALSE)) {
38                         warning("Ignoring free matrix for identity matrix construction ",
39                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")),
40                                  call. = FALSE)
41                 }
42                 if (!single.na(lbound)) {
43                         warning("Ignoring lbound matrix for identity matrix construction ",
44                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")), 
45                                 call. = FALSE)
46                 }
47                 if (!single.na(ubound)) {
48                         warning("Ignoring ubound matrix for identity matrix construction ",
49                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")), 
50                                 call. = FALSE)
51                 }
52                 if (nrow != ncol) {
53                         stop("Non-square matrix attempted for identity matrix constructor ",
54                              deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix")), 
55                              call. = FALSE)
56                 }
57                 labels <- matrix(as.character(NA), nrow, ncol)
58                 values <- matrix(diag(nrow = nrow), nrow, ncol)
59                 free <- matrix(FALSE, nrow, ncol)
60                 lbound <- matrix(as.numeric(NA), nrow, ncol)
61                 ubound <- matrix(as.numeric(NA), nrow, ncol)
62                 return(callNextMethod(.Object, labels, values, free, lbound, ubound, nrow, ncol, byrow, name, ...))
63         }
64 )
65
66 setMethod("imxVerifyMatrix", "IdenMatrix",
67         function(.Object) {
68                 callNextMethod(.Object)
69                 if(!all(.Object@free == FALSE)) {
70                         stop(paste("Free matrix of identity matrix", 
71                                 omxQuotes(.Object@name), "has a free parameter", 
72                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix"))),
73                                 call.=FALSE)
74                 }
75                 if(!suppressWarnings(all(.Object@values == diag(nrow(.Object@values))))) {
76                         stop(paste("Values matrix of identity matrix",
77                                 omxQuotes(.Object@name), "is not the identity matrix", 
78                                 deparse(width.cutoff = 400L, imxLocateFunction("mxMatrix"))),
79                                 call.=FALSE)
80                 }
81         }
82 )