Likelihood calculation using a multinomial logistic regression

multinom_lik

multinom_loglik <- function(props, size.melt, cov){
  ##
  ## multinomial logistic regression likelihood
  ## over ALL groups in one batch 
  ##
  ## props: array of covariate by group probabilities
  ## size.melt: e.g. agesize.melt
  ## cov: covariate name (string) e.g. "age"
  
  ncol.size.melt <- ncol(size.melt)
  
  ## age by groups of counts for log(proportions)
  ## add 16 yrs to match age array
  props_lik <- cbind(as.numeric(rownames(props)), props)
  colnames(props_lik)[1] <- cov
  
  ## problem when proportion for a given age =0 (e.g. for empirical values)
  ## optionally can replace -Inf (ie 0 probability) with NA so that the total likelihood is not -Inf
  ## or a `sufficiently' small value
  #propBy1yr_lik[propBy1yr_lik=="-Inf"] <- -100   #NA
  props_lik <- merge(size.melt, props_lik, by=cov)#, all.x=FALSE, all.y=TRUE)
  
  ## identify group (counts) columns only
  ## by missing-out size.melt cols
  cols <- (ncol.size.melt+1):ncol(props_lik)
  
  ## log(p^n) for all group, age and LA
  n_logp <- sweep(props_lik[, cols], MARGIN=1, props_lik$popn, `*`)
  
  ## initialise array
  ll <- aggregate(x=n_logp[,1], by=list(props_lik$Name), FUN=sum, na.rm=TRUE)
  
  for (i in names(n_logp)[-1]){
    ll <- cbind(ll, aggregate(x=n_logp[,i], by=list(props_lik$Name), FUN=sum, na.rm=TRUE)[,2])
  }
  colnames(ll) <- c("LA", colnames(props_lik)[cols])
  
  return(ll)
}
## END FUNCTION ##