# R/Fim.R In PFIM: Population Fisher Information Matrix

##################################################################################
##' Class "Fim" representing the Fisher information matrix,
##' a parent class used by three classes PopulationFim, IndividualFim and BayesianFim.
##'
##' @description
##' A class storing information regarding the Fisher computation matrix.
##' Type of the Fisher information: population ("PopulationFIM"), individual ("IndividualFIM") or Bayesian ("BayesianFIM").
##' The computation method for population and Bayesian matrix is first order linearisation (FO).
##'
##' @name Fim-class
##' @aliases Fim
##' @docType class
##' @exportClass Fim
##'
#' @section Objects from the class:
#' Objects form the class \code{Fim} can be created by calls of the form \code{Fim(...)} where
#' (...) are the parameters for the \code{Fim} objects.
#'
#'@section Slots for \code{Fim} objects:
##' \describe{
##' \item{\code{isOptimizationResult}:}{A Boolean giving TRUE for an optimization result and FALSE an evaluation result.}
##' \item{\code{mfisher}:}{A matrix of numeric giving the Fisher information.}
##' \item{\code{omega}:}{A matrix of numeric giving the variances.}
##' \item{\code{mu}:}{A matrix of numeric giving the means.}
##' \item{\code{fim_comput_method}:}{Name of the method used to approximate the population matrix : character strings, 'FO' }
##' }

Fim<-setClass(
Class="Fim",
representation=representation(
isOptimizationResult = "logical",
mfisher="matrix", # the Fisher information matrix
omega="matrix",
mu="vector",
parametersIndicesMuFIM ="vector",
parametersIndicesOmegaFIM ="vector"
),
prototype=prototype(
isOptimizationResult = FALSE
)
,
validity=function(object)
{
return(TRUE)
}
)

# Initialize method
setMethod(
f="initialize",
signature="Fim",
definition= function (.Object, mfisher, omega, mu, parametersIndicesMuFIM, parametersIndicesOmegaFIM)
{
if(!missing(mfisher))
.Object@mfisher<-mfisher

if(!missing(omega))
.Object@omega<-omega

if(!missing(mu))
.Object@mu<-mu

if(!missing(parametersIndicesMuFIM))
.Object@parametersIndicesMuFIM<-parametersIndicesMuFIM

if(!missing(parametersIndicesOmegaFIM))
.Object@parametersIndicesOmegaFIM<-parametersIndicesOmegaFIM

validObject(.Object)
return (.Object )
}
)

##########################################################################################################

#' Get the Fisher Information Matrix.
#' @name getMfisher
#' @param object A \code{Fim} object.
#' @return A matrix of numeric \code{mfisher} giving the Fisher Information Matrix.
#'
setGeneric("getMfisher",
function(object)
{
standardGeneric("getMfisher")
}
)
setMethod("getMfisher",
"Fim",
function(object)
{
return(object@mfisher)
}
)

############################################################################################

#' FinalizeFIMForOneElementaryDesign
#'
#' @param object A \code{Fim} object.
#' @param arm A \code{Arm} object.
#' @return A matrix of numeric \code{mfisher} giving the Fisher Information Matrix.
#'
#' @rdname FinalizeFIMForOneElementaryDesign
#'
#' @docType methods

setGeneric("FinalizeFIMForOneElementaryDesign",
function(object, arm)
{
standardGeneric("FinalizeFIMForOneElementaryDesign")
}
)

setMethod(
f ="FinalizeFIMForOneElementaryDesign",
signature = "Fim",
definition = function(object, arm)
{
return(object)
}
)

##########################################################################################################

#' Set a matrix value for the Fisher Information Matrix.
#' @name setMfisher<-
#' @param object A \code{Fim} object.
#' @param value A matrix of numerical values.
#' @return The \code{Fim} object with the Fisher Information Matrix with the new values.

setGeneric("setMfisher<-",
function(object, value)
{
standardGeneric("setMfisher<-")
}
)
setReplaceMethod( f="setMfisher",
signature="Fim",
definition = function(object, value)
{
object@mfisher <- as(value,"matrix")
return(object)
}
)

##########################################################################################################

#' Set the Omega matrix.
#' @name setOmega
#' @param object A \code{Fim} object.
#' @param omega A matrix omega giving the new values of the variances.
#' @return The \code{Fim} object with the Omega matrix with the new values.

setGeneric( "setOmega",
function( object, omega )
{
standardGeneric("setOmega")
}
)

setMethod(
f ="setOmega",
signature = "Fim",
definition = function ( object, omega )
{
object@omega = omega
return( object )
}
)

##########################################################################################################

#' Set the mu vector.
#' @name setMu
#' @param object A \code{Fim} object.
#' @param mu A vector mu of the new values of mu.
#' @return The \code{Fim} object with the mu vector with the new values.

setGeneric( "setMu",
function( object, mu )
{
standardGeneric("setMu")
}
)

setMethod(
f ="setMu",
signature = "Fim",
definition = function ( object, mu )
{
object@mu = mu
return( object )
}
)

##########################################################################################################

#' Get the description of FIM.
#'
#' @param object A \code{Fim} object.
#'
#' @return A character string that tells you that is a Fisher information matrix.
#'
#' @rdname getDescription
#'
#' @docType methods

setGeneric("getDescription",
function( object )
{
standardGeneric("getDescription")
}
)

##########################################################################################################

#' Get the Determinant of a Fisher Information Matrix.
#' @name getDeterminant
#' @param object \code{Fim} object.
#' @return A numeric \code{Det} giving the determinant of a Fisher Information Matrix.

setGeneric("getDeterminant",
function(object)
{
standardGeneric("getDeterminant")
}
)

setMethod(
f ="getDeterminant",
signature = "Fim",
definition = function (object)
{
Det<-det(object@mfisher)
return(Det)
}
)

##########################################################################################################

#' Get the D-criterion for a \code{Fim} object.
#' @name getDcriterion
#' @param object A \code{Fim} object.
#' @return A numeric \code{Dcriterion} giving the D-criterion of a Fisher Information Matrix.

setGeneric("getDcriterion",
function(object)
{
standardGeneric("getDcriterion")
}
)

setMethod(
f = "getDcriterion",
signature = "Fim",
definition = function(object)
{
Dcriterion <- det(object@mfisher)^ (1/dim(object@mfisher)[1])
return(Dcriterion)
}
)

##########################################################################################################

#' Get the Standard Errors for a \code{Fim} object..
#' @name getSE
#' @param object A \code{Fim} object.
#' @return A vector of numerical values giving the Standard Errors from the Fisher Information Matrix.

setGeneric("getSE",
function(object)
{
standardGeneric("getSE")
}
)

setMethod(
f ="getSE",
signature = "Fim",
definition = function (object)
{
SE<-sqrt(diag(solve(object@mfisher)))
return(SE)
}
)

##########################################################################################################

#' Get the correlation matrix of the Fisher Information Matrix for a \code{Fim} object.
#' @name getCorr
#' @param object A \code{Fim} object.
#' @return A matrix of numerical values \code{corr_mat} giving the correlation matrix from the Fisher Information Matrix.

setGeneric("getCorr",
function(object)
{
standardGeneric("getCorr")
}
)

setMethod(
f ="getCorr",
signature = "Fim",
definition = function (object)
{
corr_mat<-cov2cor(solve(object@mfisher))
return(corr_mat)
}
)

##########################################################################################################

#' Get the eigen values of the Fisher Information Matrix for a \code{Fim} object.
#' @name getEigenValue
#' @param object A \code{Fim} object.
#' @return A vector of numerical values \code{EV} giving the eigen values of the \code{Fim} object.

setGeneric("getEigenValue",
function(object)
{
standardGeneric("getEigenValue")
}
)

setMethod(
f ="getEigenValue",
signature = "Fim",
definition = function (object)
{
EV<-eigen(object@mfisher)$values return(EV) } ) ########################################################################################################## #' Get the Condition Number Matrix of the Fisher Information Matrix for a \code{Fim} object.. #' @name getConditionNumberMatrix #' @param object A \code{Fim} object. #' @param FixedEffectParameterNumber A numerical giving the number of Fixed Effect Parameters. #' @return A matrix \code{conditionNumbers} of numerical values giving the Condition Number Matrix the min, max and min/max for the FixedEffects and VarianceComponents. setGeneric("getConditionNumberMatrix", function(object, FixedEffectParameterNumber) { standardGeneric("getConditionNumberMatrix") } ) setMethod( f ="getConditionNumberMatrix", signature = "Fim", definition = function (object, FixedEffectParameterNumber) { EV<-eigen(object@mfisher)$values

minFixedEffect <- min(EV[1:FixedEffectParameterNumber])
maxFixedEffect <- max(EV[1:FixedEffectParameterNumber])

minRandomEffect <- min(EV[(FixedEffectParameterNumber+1):length(EV)])
maxRandomEffect <- max(EV[(FixedEffectParameterNumber+1):length(EV)])

conditionNumbers <- matrix(c(minFixedEffect, maxFixedEffect,maxFixedEffect/minFixedEffect, minRandomEffect, maxRandomEffect, maxRandomEffect/minRandomEffect ), ncol =2)
colnames(conditionNumbers) <- c("FixedEffects ", "VarianceComponents")
rownames(conditionNumbers) <- c("min", "max", "max/min")
return(conditionNumbers)
}
)

##########################################################################################################

#' Show the Fisher Information Matrix for a \code{Fim} object and its information: Determinant, D-criterion, SE, Eigenvalues, Correlation.
#'
#' @rdname show
#' @param object A \code{Fim} object.
#' @return Print the Fisher Information Matrix and its informations: Determinant, D-criterion, SE, Eigenvalues, Correlation.

setMethod(f = "show",
signature = "Fim",
definition = function(object)
{
cat("Fisher matrix\n")
return()
#print( object@mfisher )
# MF <- object@mfisher
#
# if( any( is.na( MF[1][1] ) ) )
#   cat(" This design have not be evaluated.\n\n")
# else
# {
#   if(object@isOptimizationResult)
#     cat(" This is an optimization result.\n")
#   else
#     cat(" This is an evaluation result.\n")
#
#   cat( "\n ", getDescription( object ), "\n" )
#
#   print( getMfisher(object) )
#
#   tryCatch({
#     cat("\n Determinant\n")
#     cat( getDeterminant(object),"\n" )
#   },error=function(e){
#     cat("Determinant cannot be calculated.\n")
#   })
#
#   tryCatch({
#     cat("\n D-criterion\n")
#     cat( getDcriterion(object),"\n" )
#   },error=function(e){
#     cat("D-criterion cannot be calculated.\n" )
#   })
#
#   cat("\n SE\n")
#   print( getSE(object) )
#
#   tryCatch({
#     cat("\n EigenValue \n")
#     eigens <- getEigenValue(object)
#     names(eigens) <- names(getSE(object))
#     print( eigens )
#   },error=function(e){
#     cat("EigenValues cannot be calculated.\n" )
#   })
#
#   tryCatch({
#     cat("\n Correlation\n")
#     print( getCorr(object) )
#   },error=function(e){
#     cat("Correlations cannot be calculated.\n" )
#   })
#
#   return(getSE(object))
# }
}
)

##########################################################################################################

# Compute expected standard error data frame
#' @name getStatisticalModelStandardErrors
#' @rdname getStatisticalModelStandardErrors
#' @aliases getStatisticalModelStandardErrors
#' @param object A \code{Fim} object.
#' @param modelParameters A character string giving the model parameters.
#' @return A data frame giving the expected standard error.

setGeneric("getStatisticalModelStandardErrors",
function(object, modelParameters)
{
standardGeneric("getStatisticalModelStandardErrors")
}
)

##########################################################################################################

#' Show expected standard error data frame.
#'
#' @name showStatisticalModelStandardErrors
#' @rdname showStatisticalModelStandardErrors
#' @aliases showStatisticalModelStandardErrors
#' @param object A \code{Fim} object.
#' @param modelParameters A character string giving the model parameters.
#' @return A data frame giving the standard error.

setGeneric("showStatisticalModelStandardErrors",
function(object, modelParameters)
{
standardGeneric("showStatisticalModelStandardErrors")
}
)

##########################################################################################################
# END Class "Fim"
##########################################################################################################


## Try the PFIM package in your browser

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

PFIM documentation built on June 24, 2022, 9:06 a.m.