/
evaluate.fim.R
111 lines (102 loc) · 5.16 KB
/
evaluate.fim.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#' Evaluate the Fisher Information Matrix (FIM)
#'
#' Compute the FIM given the model, parameters, design and methods defined in the
#' PopED database. Some of the arguments coming from the PopED database can be overwritten;
#' by default these arguments are \code{NULL} in the
#' function, if they are supplied then they are used instead of the arguments from the PopED database.
#'
#' @param poped.db A PopED database.
#' @param fim.calc.type The method used for calculating the FIM. Potential values:
#' \itemize{
#' \item 0 = Full FIM. No assumption that fixed and random effects are uncorrelated.
#' \item 1 = Reduced FIM. Assume that there is no correlation in the FIM between the fixed and random effects, and set these elements in
#' the FIM to zero.
#' \item 2 = weighted models (placeholder).
#' \item 3 = Not currently used.
#' \item 4 = Reduced FIM and computing all derivatives with respect to the standard deviation of the residual unexplained variation (sqrt(SIGMA) in NONMEM).
#' This matches what is done in PFIM, and assumes that the standard deviation of the residual unexplained variation is the estimated parameter
#' (NOTE: NONMEM estimates the variance of the residual unexplained variation by default).
#' \item 5 = Full FIM parameterized with A,B,C matrices & derivative of variance.
#' \item 6 = Calculate one model switch at a time, good for large matrices.
#' \item 7 = Reduced FIM parameterized with A,B,C matrices & derivative of variance.
#' }
#' @param approx.method Approximation method for model, 0=FO, 1=FOCE, 2=FOCEI, 3=FOI
#' @param FOCE.num Number individuals in each step of FOCE approximation method
#' @param bpop.val The fixed effects parameter values. Supplied as a vector.
#' @param d_full A between subject variability matrix (OMEGA in NONMEM).
#' @param docc_full A between occasion variability matrix.
#' @param sigma_full A residual unexplained variability matrix (SIGMA in NONMEM).
#' @param model_switch A matrix that is the same size as xt, specifying which model each sample belongs to.
#' @param ni A vector of the number of samples in each group.
#' @param xt A matrix of sample times. Each row is a vector of sample times for a group.
#' @param x A matrix for the discrete design variables. Each row is a group.
#' @param a A matrix of covariates. Each row is a group.
#' @param groupsize A vector of the number of individuals in each group.
#' @param deriv.type A number indicating the type of derivative to use:
#' \itemize{
#' \item 0=Complex difference
#' \item 1=Central difference
#' \item 20=Analytic derivative (placeholder)
#' \item 30=Automatic differentiation (placeholder)
#' }
#' @param ... Other arguments passed to the function.
# @inheritParams Doptim
# @inheritParams create.poped.database
#'
#' @return The FIM.
#'
#' @family FIM
#' @family evaluate_design
#' @family evaluate_FIM
#'
# @example inst/examples_fcn_doc/examples_evaluate.fim.R
#'
#' @example tests/testthat/examples_fcn_doc/examples_evaluate.fim.R
#' @export
evaluate.fim <- function(poped.db,
fim.calc.type=NULL,
approx.method=NULL,
FOCE.num = NULL,
bpop.val=NULL,
d_full=NULL,
docc_full=NULL,
sigma_full=NULL,
model_switch=NULL,
ni=NULL,
xt=NULL,
x=NULL,
a=NULL,
groupsize=NULL,
deriv.type = NULL,
...){
if(is.null(bpop.val)) bpop.val <- poped.db$parameters$param.pt.val$bpop
if(is.null(d_full)) d_full <- poped.db$parameters$param.pt.val$d
if(is.null(docc_full)) docc_full <- poped.db$parameters$param.pt.val$docc
if(is.null(sigma_full)) sigma_full <- poped.db$parameters$param.pt.val$sigma
# if(is.null(model_switch)) model_switch <- poped.db$downsized.design$model_switch
# if(is.null(ni)) ni <- poped.db$downsized.design$ni
# if(is.null(xt)) xt <- poped.db$downsized.design$xt
# if(is.null(x)) x <- poped.db$downsized.design$x
# if(is.null(a)) a <- poped.db$downsized.design$a
# if(is.null(groupsize)) groupsize <- poped.db$downsized.design$groupsize
#
if(is.null(model_switch)) model_switch <- poped.db$design$model_switch
if(is.null(ni)) ni <- poped.db$design$ni
if(is.null(xt)) xt <- poped.db$design$xt
if(is.null(x)) x <- poped.db$design$x
if(is.null(a)) a <- poped.db$design$a
if(is.null(groupsize)) groupsize <- poped.db$design$groupsize
if(!is.null(fim.calc.type)) poped.db$settings$iFIMCalculationType=fim.calc.type
if(!is.null(approx.method)) poped.db$settings$iApproximationMethod=approx.method
if(!is.null(FOCE.num)) poped.db$settings$iFOCENumInd=FOCE.num
if(!is.null(deriv.type)){
poped.db$settings$m1_switch=deriv.type
poped.db$settings$m2_switch=deriv.type
poped.db$settings$hle_switch=deriv.type
poped.db$settings$gradff_switch=deriv.type
poped.db$settings$gradfg_switch=deriv.type
}
output = mftot(model_switch,groupsize,ni,xt,x,a,bpop.val,d_full,sigma_full,docc_full,poped.db,...)
FIM <- output$ret
return(FIM)
}