Nothing
#
# Copyright 2007-2021 by the individuals mentioned in the source code history
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
setClass(Class = "MxFitFunctionAlgebra",
representation = representation(
algebra = "MxCharOrNumber",
units = "character",
numObs = "numeric",
numStats = "numeric",
gradient = "MxCharOrNumber",
hessian = "MxCharOrNumber",
verbose = "integer",
strict = "logical"),
contains = "MxBaseFitFunction")
setMethod("initialize", "MxFitFunctionAlgebra",
function(.Object, ...) {
.Object <- callNextMethod()
.Object@algebra <- ..1
.Object@units <- ..2
.Object@numObs <- ..3
.Object@numStats <- ..4
.Object@gradient <- ..5
.Object@hessian <- ..6
.Object@verbose <- ..7
.Object@strict <- ..8
.Object
})
setMethod("genericFitDependencies", signature("MxFitFunctionAlgebra"),
function(.Object, flatModel, dependencies) {
dependencies <- callNextMethod()
for (sl in c('algebra', 'gradient', 'hessian')) {
thing <- slot(.Object, sl)
if (is.na(thing)) next
dependencies <- imxAddDependency(thing, .Object@name, dependencies)
}
return(dependencies)
})
setMethod("genericFitFunConvert", signature("MxFitFunctionAlgebra"),
function(.Object, flatModel, model, labelsData, dependencies) {
.Object <- callNextMethod()
name <- .Object@name
algebra <- .Object@algebra
if (is.na(algebra) && is.na(.Object@gradient) && is.na(.Object@hessian)) {
modelname <- imxReverseIdentifier(model, .Object@name)[[1]]
msg <- paste("The algebra name cannot be NA",
"for the algebra fit function of model", omxQuotes(modelname))
stop(msg, call. = FALSE)
}
modelname <- imxReverseIdentifier(model, .Object@name)[[1]]
expectName <- paste(modelname, "expectation", sep=".")
if (expectName %in% names(flatModel@expectations)) {
expectIndex <- imxLocateIndex(flatModel, expectName, name)
} else {
expectIndex <- as.integer(NA)
}
.Object@expectation <- expectIndex
for (sl in c('algebra', 'gradient', 'hessian')) {
slot(.Object, sl) <- imxLocateIndex(flatModel, slot(.Object, sl), name)
}
return(.Object)
})
setMethod("qualifyNames", signature("MxFitFunctionAlgebra"),
function(.Object, modelname, namespace) {
.Object <- callNextMethod()
for (sl in c('algebra', 'gradient', 'hessian')) {
slot(.Object, sl) <- imxConvertIdentifier(slot(.Object, sl), modelname, namespace)
}
return(.Object)
})
setMethod("genericFitRename", signature("MxFitFunctionAlgebra"),
function(.Object, oldname, newname) {
for (sl in c('algebra', 'gradient', 'hessian')) {
slot(.Object, sl) <- renameReference(slot(.Object, sl), oldname, newname)
}
return(.Object)
})
setMethod("generateReferenceModels", "MxFitFunctionAlgebra",
function(.Object, model, distribution) {
msg <- paste("Don't know how to make", distribution, "distribution",
"reference models for a model with a ",
class(.Object), " fit function.", sep="")
msg <- paste(msg, "\n",
"If you're using this for a mutligroup model, very likely, you can replace your mxFitFunctionAlgebra() call with", "\n",
"mxFitFunctionMultigroup(c('submodelName1', 'submodelName2', ...))", "\n\n",
"See ?mxFitFunctionMultigroup() to learn more.", sep="")
stop(msg)
})
mxFitFunctionAlgebra <- function(algebra, numObs = NA, numStats = NA, ...,
gradient=NA_character_, hessian=NA_character_,
verbose=0L, units="-2lnL", strict=TRUE)
{
prohibitDotdotdot(list(...))
if (is.null(algebra)) {
algebra <- NA_character_
} else if (missing(algebra) || typeof(algebra) != "character") {
stop("Algebra argument is not a string (the name of the algebra)")
}
if (single.na(numObs)) {
numObs <- as.numeric(NA)
}
if (single.na(numStats)) {
numStats <- as.numeric(NA)
}
return(new("MxFitFunctionAlgebra", algebra, units, numObs, numStats, gradient, hessian, verbose, as.logical(strict)))
}
displayMxFitFunctionAlgebra <- function(fitfunction) {
cat("MxFitFunctionAlgebra", omxQuotes(fitfunction@name), '\n')
cat("$algebra: ", omxQuotes(fitfunction@algebra), '\n')
cat("$units: ", omxQuotes(fitfunction@units), '\n')
cat("$numObs: ", fitfunction@numObs, '\n')
cat("$numStats: ", fitfunction@numStats, '\n')
if (length(fitfunction@result) == 0) {
cat("$result: (not yet computed) ")
} else {
cat("$result:\n")
}
print(fitfunction@result)
invisible(fitfunction)
}
setMethod("print", "MxFitFunctionAlgebra", function(x,...) {
displayMxFitFunctionAlgebra(x)
})
setMethod("show", "MxFitFunctionAlgebra", function(object) {
displayMxFitFunctionAlgebra(object)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.