Added license information to R source files.
[openmx:openmx.git] / R / DiagMatrix.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 setClass(Class = "DiagMatrix",
17         representation = representation(),
18         contains = "MxNonSymmetricMatrix")
19
20 setMethod("initialize", "DiagMatrix",
21         function(.Object, name, values, specification, nrow, ncol, byrow, free) {
22                 if (nrow != ncol) {
23                         stop("Non-square matrix attempted for DiagMatrix constructor")
24                 }
25             if (single.na(specification) && free) {
26                 specification <- diag(nrow)
27                 specification[specification == 1] <- NA
28                         specification <- new("MxSparseMatrix", specification)
29                 } else if (single.na(specification)) {
30                         specification <- new("MxSparseMatrix", 0, nrow, ncol)
31                 } else if (is(specification, "Matrix")) {
32                         specification <- new("MxSparseMatrix", as.matrix(specification))
33                 } else if (is.matrix(specification)) {
34                         specification <- new("MxSparseMatrix", specification)
35                 } else if (is.vector(specification)) {
36                         specification <- new("MxSparseMatrix", specification*diag(nrow))
37                 } else {
38                         specification <- new("MxSparseMatrix", specification)
39                 }
40                 if (single.na(values)) {
41                         values <- Matrix(0, nrow, ncol)
42                 } else if (is.matrix(values)) { 
43                         values <- Matrix(values)
44                 } else if (is.vector(values)) {
45                         values <- Matrix(values * diag(nrow))
46                 } else {
47                         values <- Matrix(values)
48                 }
49                 retval <- callNextMethod(.Object, specification, values, name) 
50                 return(retval)
51         }
52 )
53
54 setMethod("omxVerifyMatrix", "DiagMatrix",
55         function(.Object) {
56                 callNextMethod(.Object)
57                 verifySquare(.Object)
58                 values <- .Object@values
59                 if(suppressWarnings(nnzero(values - diag(diag(values,
60                         nrow = nrow(values), ncol = ncol(values))))) > 0)
61                         { stop(paste("Values matrix of", .Object@name, "is not a diagonal matrix")) }
62         }
63 )