R/methods.for.restrictions.R

#### Restrictions #####

if(!isGeneric("restrictions")){
	if (is.function("restrictions"))
		fun <- restrictions
	else fun <- function(object) standardGeneric("restrictions")
	setGeneric("restrictions", fun)
}
setMethod("restrictions", "mpt.model", function(object) object@restrictions)
setGeneric("restrictions<-", function(x, value) standardGeneric("restrictions<-"))
setReplaceMethod("restrictions", "mpt.model", function(x, value) {
	if (class(value) != "restrictions" | is.null(value)) stop("the model restrictions must be of class restrictions or MULL")
	x@restrictions <- value
	x
})

if(!isGeneric("fixed.restrictions")){
	if (is.function("fixed.restrictions"))
		fun <- fixed.restrictions
	else fun <- function(object) standardGeneric("fixed.restrictions")
	setGeneric("fixed.restrictions", fun)
}
setMethod("fixed.restrictions", "mpt.model", function(object) object@restrictions@fixed)


if(!isGeneric("equality.restrictions")){
	if (is.function("equality.restrictions"))
		fun <- equality.restrictions
	else fun <- function(object) standardGeneric("equality.restrictions")
	setGeneric("equality.restrictions", fun)
}
setMethod("equality.restrictions", "mpt.model", function(object) object@restrictions@equality)


if(!isGeneric("inequality.restrictions")){
	if (is.function("inequality.restrictions"))
		fun <- inequality.restrictions
	else fun <- function(object) standardGeneric("inequality.restrictions")
	setGeneric("inequality.restrictions", fun)
}
setMethod("inequality.restrictions", "mpt.model", function(object) object@restrictions@inequality)


if(!isGeneric("raw.restrictions")){
	if (is.function("raw.restrictions"))
		fun <- raw.restrictions
	else fun <- function(object) standardGeneric("raw.restrictions")
	setGeneric("raw.restrictions", fun)
}
setMethod("raw.restrictions", "mpt.model", function(object) object@restrictions@raw)


if(!isGeneric("parameter")){
	if (is.function("parameter"))
		fun <- parameter
	else fun <- function(object) standardGeneric("parameter")
	setGeneric("parameter", fun)
}
setMethod("parameter", "restriction", function(object) object@parameter)


if(!isGeneric("value")){
	if (is.function("value"))
		fun <- value
	else fun <- function(object) standardGeneric("value")
	setGeneric("value", fun)
}
setMethod("value", "fixed.restriction", function(object) object@value)
setMethod("value", "equality.restriction", function(object) object@value)


if(!isGeneric("exchange.inverse")){
	if (is.function("exchange.inverse"))
		fun <- exchange.inverse
	else fun <- function(object) standardGeneric("exchange.inverse")
	setGeneric("exchange.inverse", fun)
}
setMethod("exchange.inverse", "inequality.restriction", function(object) object@exchange.inverse)


if(!isGeneric("exchange.parameter")){
	if (is.function("exchange.parameter"))
		fun <- exchange.parameter
	else fun <- function(object) standardGeneric("exchange.parameter")
	setGeneric("exchange.parameter", fun)
}
setMethod("exchange.parameter", "inequality.restriction", function(object) object@exchange.parameter)


if(!isGeneric("compute.as")){
	if (is.function("compute.as"))
		fun <- compute.as
	else fun <- function(object) standardGeneric("compute.as")
	setGeneric("compute.as", fun)
}
setMethod("compute.as", "inequality.restriction", function(object) object@compute.as)

Try the MPTinR2 package in your browser

Any scripts or data that you put into this service are public.

MPTinR2 documentation built on May 2, 2019, 4:44 p.m.