Added license information to R source files.
[openmx:openmx.git] / R / SymmMatrix.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 setClass(Class = "SymmMatrix",
18         representation = representation(),
19         contains = "MxSymmetricMatrix")
20         
21 setMethod("initialize", "SymmMatrix",
22         function(.Object, name, values, specification, nrow, ncol, byrow, free) {
23                 if (nrow != ncol) {
24                         stop("Non-square matrix attempted for SymmMatrix constructor")
25                 }
26                 if (!single.na(values) && is.vector(values)) {
27                         if (length(values) == (nrow * (nrow + 1) / 2)) {
28                             mvalues <- matrix(0, nrow, ncol)
29                             mvalues[lower.tri(mvalues, diag = TRUE)] <- values
30                             mvalues <- mvalues + t(mvalues) - diag(mvalues) * diag(nrow)
31                             values <- mvalues
32                         } else if (length(values) == (nrow * ncol)) {
33                                 values <- matrix(values, nrow, ncol)
34                         } else {
35                                 stop("Invalid length of values matrix for SymmMatrix constructor")
36                         }
37                 }
38                 if (!single.na(specification) && is.vector(specification)) {
39                         if (length(specification) == (nrow * (nrow + 1) / 2)) {
40                             mspec <- matrix(0, nrow, ncol)
41                             mspec[lower.tri(mspec, diag = TRUE)] <- specification
42                             mspec <- mspec + t(mspec) - diag(mspec) * diag(nrow)
43                             specification <- mspec
44                         } else if (length(specification) == (nrow * ncol)) {
45                                 specification <- matrix(specification, nrow, ncol)
46                         } else {
47                                 stop("Invalid length of specification matrix for SymmMatrix constructor")
48                         }
49                 }
50                 if (is(specification, "MxSymmetricSparse")) {
51                 } else if (single.na(specification) && free) {
52                         specification <- new("MxSymmetricSparse", matrix(NA, nrow, ncol))
53             } else if (single.na(specification)){
54                         specification <- new("MxSymmetricSparse", 0, nrow, ncol)
55                 } else if (is(specification, "Matrix")) {
56                         specification <- new("MxSymmetricSparse", as.matrix(specification))
57             } else {
58                 specification <- new("MxSymmetricSparse", matrix(specification, nrow, ncol))
59             }
60             if (is(values, "MxSymmetricSparse")) {
61             } else if (single.na(values)) {
62                 values <- new("MxSymmetricSparse", matrix(0, nrow, ncol))
63             } else if (is(values, "Matrix")) {
64                         values <- new("MxSymmetricSparse", as.matrix(values))
65                 } else {
66                 values <- new("MxSymmetricSparse", matrix(values, nrow, ncol))
67             }
68                 retval <- callNextMethod(.Object, specification, values, name)
69                 return(retval)
70         }
71 )
72
73 setMethod("omxVerifyMatrix", "SymmMatrix",
74         function(.Object) {
75                 callNextMethod(.Object)
76                 verifySquare(.Object)
77                 values <- as.matrix(.Object@values)
78                 if (!all(values == t(values))) {
79                         stop(paste("Symmetric matrix",omxQuotes(.Object@name),"is not symmetric!"), 
80                                 call.=FALSE)
81                 }
82         }
83 )