R 代码，用于根据特定似然度进行最大似然估计 function

Question

I have been trying to generate R code for maximum likelihood estimation from a log likelihood function in a paper (equation 9 in page 609). Authors in the paper estimated it using MATLAB, which I am not familiar with. So I tried to generate codes in R.

Here is the snapshot of the log likelihood function in the paper:

, where

r : Binary decision (0 or 1) indicating infested plant(s) detection (1) or not (0).

e : Inspection efficiency. This is known.

n : Sample size

The overall objective is to estimate plant infestation rate (gamma: γ) and epsilon ( e ) based on binary decision of presence and absence of infested plants instead of using infested plant(s) detected. So, the function has only binary information ( r ) of infested plant detection and sample size. Since epsilon ( e ) is known or fixed, the actual goal is to estimate gamma (γ) in a population.

Another objective is to compare estimated infestation rates from above with ones in hypergeometric sampling formula in another paper (in page 6). The formula is:

This formula generates required sample size to detect infested plants with selected probability (eg, 95) given an infested rate. For example:

# Sample size calculation function
fosgate.sample1 <- function(box, p, ci){ # Note: box represent total plant number
  ninf <- p*box
  sample.size <- round(((1-(1-ci)^(1/ninf))*(box-(ninf-1)/2)))
  #sample.size <- ceiling(((1-(1-ci)^(1/ninf))*(box-(ninf-1)/2)))
  sample.size
}

fosgate.sample1(box=100, p = .05, ci = .95) # where box: population or total plants, p: infestation rate, and ci: probability of detection
## 44

The idea is if sample size (eg, 44) and binary decision data are provided the log-likelihood function can be used to estimate infestation rate and the rate may be close to anticipated rate (eg, .05). Ultimately, I would like to compare plant infestation rates (gamma: γ) estimated from the log likelihood function above and D/N in the sample size calculation formula (second) or p in the sample size code below.

I generated R code for the log-likelihood described above.

### MLE with stat4
library(stats4)
# Log-likelihood function
plant.inf.lik <- function(inf.rate){
logl <- suppressWarnings(
        sum((1-insp.result)*n*log(1-inf.rate) + 
            insp.result*log(1-(1-inf.rate)^n))
        )
return(-logl)
}

Using the sample size function (ie, fosgate.sample1) I generated sample sizes for various cases of total plant (or box) and anticipated detection rate (p) in the function. Since I am also interested in error/confidence ranges of estimated plant infestation rates, I used bootstrapping to calculate range of estimates (I am not sure if this is appropriate/acceptable). Here is the final code I generated:

### MLE and CI with bootstrapping with multiple scenarios
plant <- c(100, 500, 1000, 5000, 10000, 100000) # Total plant number
ir <- seq(.01, .2, by = .01) # Plant infestation rate
df.result <- data.frame(expand.grid(plant=plant, inf.rate = ir))
df.result$sample.size <- fosgate.sample1(box=df.result$plant, p=df.result$inf.rate, ci=.95) # Sample size
df.result$insp.result <- 1000 # Shipment number (can be replaced with random integers)
df.result <- df.result[order(df.result$plant, df.result$inf.rate, df.result$sample.size), ]
rownames(df.result) <- 1:nrow(df.result)
df.result$est.mean <- 0
#df.result$est.median <- 0
df.result$est.lower.ci <- 0
df.result$est.upper.ci <- 0
df.result$nsim <- 0
str(df.result)
head(df.result)

# Looping
    est <- rep(NA, 1000)
for(j in 1:nrow(df.result)){
    for(i in 1:1000){
        insp.result <- sample(c(rep(1, df.result$insp.result[j]-df.result$insp.result[j]*df.result$inf.rate[j]), 
                    rep(0, df.result$insp.result[j]*df.result$inf.rate[j])))
        ir <- df.result$inf.rate[j]
        n <- df.result$sample.size[j]
        insp.result <- sample(insp.result, replace = TRUE)
        est[i] <- mle(plant.inf.lik, start = list(inf.rate = ir*.9), method = "BFGS", nobs = length(insp.result))@coef
    df.result$est.mean[j] <- mean(est, na.rm = TRUE)
#   df.result$est.median[j] <- median(est, na.rm = TRUE)
    df.result$est.lower.ci[j] <- quantile(est, prob = .025, na.rm = TRUE)
    df.result$est.upper.ci[j] <- quantile(est, prob = .975, na.rm = TRUE)
    df.result$nsim[j] <- length(est)
    }
}

# Significance test result
sig <- ifelse(df.result$inf.rate >= df.result$est.lower.ci & df.result$inf.rate <= df.result$est.upper.ci, "no sig", "sig")
table(sig)

# Plot
library(ggplot2)
library(reshape2)
df.result$num <- ave(df.result$inf.rate, df.result$plant, FUN=seq_along)
df.result.m <- melt(df.result, id.vars=c("plant", "sample.size", "insp.result", "est.lower.ci", "est.upper.ci", "nsim", "num"))
df.result.m$est.lower.ci <- ifelse(df.result.m$variable == "inf.rate", NA, df.result.m$est.lower.ci)
df.result.m$est.upper.ci <- ifelse(df.result.m$variable == "inf.rate", NA, df.result.m$est.upper.ci)
str(df.result.m)

ggplot(data = df.result.m, aes(x = num, y = value, group=variable, color=variable, shape=variable))+
    geom_point()+
    geom_errorbar(aes(ymin = est.lower.ci, ymax = est.upper.ci), width=.5)+
    scale_y_continuous(breaks = seq(0, .2, .02))+
    xlab("Index")+
    ylab("Plant infestation rate")+
    facet_wrap(~plant, ncol = 3)

When I ran the code, I was able to obtain results and to compare estimated (est.mean) and anticipated (inf.rate) infestation rates as shown in the plot below.

If results are correct, plot indicates that estimation looks fine but off for greater infestation rates.

Also, I always got warning messages without "suppressWarnings" function and occasionally error messages below. I have no clue how to fix them.

## Warning messages
## 29: In log(1 - (1 - inf.rate)^n) : NaNs produced
## 30: In log(1 - inf.rate) : NaNs produced

## Error message (occasionally)
## Error in solve.default(oout$hessian) : 
## Lapack routine dgesv: system is exactly singular: U[1,1] = 0

My questions are:

• Is R function (plant.inf.lik) for maximum likelihood estimation of the log-likelihood function appropriate?
• Should I take care of warning and error messages? If yes, how? Again, I have no clue how to fix...
• Is bootstrapping (resampling?) method appropriate to estimate CI ranges and/or standard error?

I found this link useful for alternative approach. Although I am still working both approaches together, results seem different (maybe following question).

Any suggestion would be greatly appreciated.

Answer 1

Concerning your last question about estimating CI ranges, there are three common methods for ML estimators:

1. Variance estimation from the inverted Hessian matrix.
2. Jackknife estimator for the variance (simpler and more stable, if the Hessian is estimated numerically, but computationally more expensive)
3. Bootstrap CIs (the computatianally most expensive approach).

For bootstrap CIs, you do not need to implement them yourself (bias correction, eg can be tricky), but can rely on the R library boot .

Incidentally, I have written a summary with R code for all three approaches two years ago: Construction of Confidence Intervals (see section 5). For the method utilizing the Hessian Matrix, eg, the outline is as follows:

lnL <- function(theta1, theta2, ...) {
  # definition of the negative (!)
  # log-likelihood function...
}

# starting values for the optimization
theta0 <- c(start1, start2, ...)

# optimization
p <- optim(theta0, lnL, hessian=TRUE)
if (p$convergence == 0) {
  theta <- p$par
  covmat <- solve(p$hessian)
  sigma <- sqrt(diag(covmat))
}

The function mle from stats4 already wraps the covrainace matrix estimation and retruns it in vcov . In the practical use cases in which I have tried this (paired comparison models), though, this estimation was rather unstable, and I have resorted to the jackknife method instead.