Updated copyright to 2013 for R/ demo/ models/passing and src/ folders, and also...
[openmx:openmx.git] / R / MxFIMLObjective.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 mxFIMLObjective <- function(covariance, means, dimnames = NA, 
17         thresholds = NA, vector = FALSE, threshnames = dimnames) {
18         if (missing(covariance) || typeof(covariance) != "character") {
19                 stop("'covariance' argument is not a string (the name of the expected covariance matrix)")
20         }
21         if (missing(means) || typeof(means) != "character") {
22                 stop("'means' argument is not a string (the name of the expected means vector)")
23         }
24         if (single.na(thresholds)) thresholds <- as.character(NA)
25         if (single.na(dimnames)) dimnames <- as.character(NA)
26         if (single.na(threshnames)) threshnames <- as.character(NA)
27         if (!is.vector(dimnames) || typeof(dimnames) != 'character') {
28                 stop("'dimnames' argument is not a character vector")
29         }
30         if (!is.vector(threshnames) || typeof(threshnames) != 'character') {
31                 stop("'threshnames' argument is not a character vector")
32         }
33         if (length(thresholds) != 1) {
34                 stop("'thresholds' argument must be a single matrix or algebra name")
35         }
36         if (length(dimnames) == 0) {
37                 stop("'dimnames' argument cannot be an empty vector")
38         }
39         if (length(threshnames) == 0) {
40                 stop("'threshnames' argument cannot be an empty vector")
41         }
42         if (length(dimnames) > 1 && any(is.na(dimnames))) {
43                 stop("NA values are not allowed for 'dimnames' vector")
44         }
45         if (length(threshnames) > 1 && any(is.na(threshnames))) {
46                 stop("NA values are not allowed for 'threshnames' vector")
47         }
48         if (length(vector) > 1 || typeof(vector) != "logical") {
49                 stop("'vector' argument is not a logical value")
50         }
51         expectation <- mxExpectationNormal(covariance, means, dimnames, 
52                 thresholds, threshnames)
53         fitfunction <- mxFitFunctionML(vector)
54         msg <- paste("Objective functions have been deprecated.",
55                 "Please use mxExpectationNormal() and mxFitFunctionML() instead.")
56         warning(msg)
57         return(list(expectation, fitfunction))
58 }
59