R/fit.param.fij.geom.R

Defines functions .fit.param.fij.geom

.fit.param.fij.geom <- function(counting, i, j, kmax, cens.beg) {
  
  # Estimation of the parameters of the distribution (No censoring case)
  theta0 <- sum(counting$Nijk[i, j, ]) / sum(1:kmax * counting$Nijk[i, j, ])
  
  if (cens.beg) {# Censoring at the beginning
    
    loglik <- function(par) {
      
      mask <- counting$Nijk[i, j, ] != 0
      kmask <- (0:(kmax - 1))[mask]
      fk <- rep.int(x = 0, times = kmax)
      fk[mask] <- dgeom(x = kmask, prob = par, log = TRUE)
      
      mask <- counting$Nbijk[i, j, ] != 0
      kmask <- (0:(kmax - 1))[mask]
      Fk <- rep.int(x = 0, times = kmax)
      Fk[mask] <- pgeom(q = kmask, prob = par, lower.tail = FALSE, log.p = TRUE)
      
      return(-(sum(counting$Nijk[i, j, ] * fk) + sum(counting$Nbijk[i, j, ] * Fk)))
    }
    
    mle <- optim(par = theta0, loglik, method = "Brent", lower = 0, upper = 1)
    theta <- mle$par
    
  } else {# No censoring
    
    theta <- theta0
    
  }
  
  return(c(theta, NA))
  
}

Try the smmR package in your browser

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

smmR documentation built on Aug. 3, 2021, 5:07 p.m.