FM {ZIGP}R Documentation

Fisher Information

Description

'FM' calculates the (Expected) Fisher Information matrix.

Usage

FM(beta, alpha, gamma, X, W, Z, Offset = NULL)

Arguments

beta regression parameters for mean of length p
alpha regression parameters for overdispersion of length r
gamma regression parameters for zero inflation of length q
X design matrix of dim (n x p) for mean modelling.
W design matrix of dim (n x r) for overdispersion modelling.
Z design matrix of dim (n x q) for zero inflation modelling.
Offset exposure for individual observation lengths. Defaults to a vector of 1. The offset MUST NOT be in 'log' scale.

Examples

X <- matrix(c(1:3,4,3,5),3,2)
W <- c(3,-4,-1)
Z <- rep(1,3)
beta  <- c(5,-2)
alpha <- 3.4
gamma <- -10
FM(beta, alpha, gamma, X, W, Z)
#              [,1]          [,2]         [,3]          [,4]
#[1,]  1.469180e+03  2.412237e+03 6.249334e-03 -8.400641e-11
#[2,]  2.412237e+03  3.965799e+03 1.040260e-02 -3.360257e-10
#[3,]  6.249334e-03  1.040260e-02 2.101615e-03  2.520099e-10
#[4,] -8.400641e-11 -3.360257e-10 2.520099e-10  9.079162e-05
     
## The function is currently defined as
function(beta, alpha, gamma, X, W, Z, Offset = NULL)

{


k.beta <- length(beta)

k.alpha <- length(alpha)

k.gamma <- length(gamma)


FM <- array(0,c(k.beta+k.alpha+k.gamma,k.beta+k.alpha+k.gamma))


if(is.matrix(X)){ eta.mu <- X%*%beta }

else{eta.mu <- X*beta}

if(is.matrix(W)){ eta.phi <- W%*%alpha }

else{eta.phi <- W*alpha}

if(is.matrix(Z)){ eta.gamma <- Z%*%gamma }

else{eta.gamma <- Z*gamma}


if (is.null(Offset)) {mu  <- exp(eta.mu)}

else {t.i <<- Offset

     mu  <- t.i*exp(eta.mu)}

b <- exp(eta.phi)

phi <- 1+b

k <- exp(eta.gamma)

P0 <- exp(-1/phi*mu)

# a(i) = E[I{Y(i) = 0}]

a <- (k+P0)/(1+k)


temp <- double(1)


if(k.beta==1){ X <- cbind(X,rep(0,length(X)))  }

if(k.alpha==1){ W <- cbind(W,rep(0,length(W)))  }

if(k.gamma==1){ Z <- cbind(Z,rep(0,length(Z)))  }


# the second derivative w.r.t. "beta"

for (i in 1:k.beta)

{

  for (j in 1:k.beta)

  {

  temp <- sum( X[,i]*X[,j]*mu* ( a*(-1/phi*P0^2+(mu-phi)/(phi^2)*P0*k)/

          ((k+P0)^2) + (b*mu)/(phi^2*(mu-2+2*phi)*(1+k)) - (1-a)/phi ) )

  FM[i,j] <- -temp

  }

  }


# the second derivative w.r.t. "alpha"

for (i in 1:k.alpha)

{

  for (j in 1:k.alpha)

  {

  temp <- sum( W[,i]*W[,j]*b*( a*P0*mu/((k+P0)^2)*(mu*b*k/phi^4+(1/phi^2-2*b/phi^3)*(k+P0))+

          mu^2/(phi^2*(mu-2+2*phi)*(1+k)) + 2*mu/(1+k)*(-1/phi^2+b/phi^3) +

          (1-a)/(phi^3)*(mu*phi-2*mu*b) ) )

  FM[k.beta+i,k.beta+j] <- -temp

  }

  }


# the second derivative w.r.t. "gamma"

for (i in 1:k.gamma)

{

  for (j in 1:k.gamma)

  {

  temp <- sum( Z[,i]*Z[,j]*k* (a*P0/((k+P0)^2)-1/((1+k)^2) ) )

  FM[k.beta+k.alpha+i,k.beta+k.alpha+j] <- -temp

  }

  }


# the mixed derivative w.r.t. "beta" and "alpha"

for (i in 1:k.beta)

{

  for (j in 1:k.alpha)

  {

temp <- sum( X[,i]*W[,j]*mu*b* ( a*(-1/phi^3*P0*mu*k+1/(phi^2)*P0*(k+P0))/((k+P0)^2)-

        mu/(phi^2*(mu-2+2*phi)*(1+k))+(1-a)/(phi^2) ) )

FM[k.beta+j,i] <- -temp

FM[i,k.beta+j] <- -temp

  }

  }


# the mixed derivative w.r.t. "beta" and "gamma"

for (i in 1:k.beta)

{

  for (j in 1:k.gamma)

  {

  temp <- sum( X[,i]*Z[,j]*a*P0*mu*k/(phi*(k+P0)^2) )

  FM[k.beta+k.alpha+j,i] <- -temp

  FM[i,k.beta+k.alpha+j] <- -temp

  }

  }


# the mixed derivative w.r.t. "alpha" and "gamma"

for (i in 1:k.gamma)

{

  for (j in 1:k.alpha)

  {

  temp <- sum( W[,j]*Z[,i]*b*a* (-1/phi^2 * P0 * mu * k)/((k+P0)^2) )

  FM[k.beta+k.alpha+i,k.beta+j] <- -temp

  FM[k.beta+j,k.beta+k.alpha+i] <- -temp

  }

  }


return(FM)

  }

[Package ZIGP version 1.3 Index]