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