R/eval_log_like_knobj.R

Defines functions eval_log_like_knobj

Documented in eval_log_like_knobj

eval_log_like_knobj <-
function(theta, knobj, fail_incoming = F, fit = F){
  ## Computes posterior value for multiple experiments
  ## knobj should be similar to lists generated by generate_our_knowledge
  ## The fail output allows to track difficulties the solver has
  ## if it send -1 diagnostic, it is likely that we are not in the
  ## correct neighboorhood 
  
    
	## Prior
	res <- log_prior(theta)
	sum_weights <- 1/ length(theta) + sum( sapply(knobj$datas, FUN = function(x){if(!is.null(x$data)){1 / nrow(x$data) / (ncol(x$data) - 1)}else{0}}) )
	
	## Manipulate theta
	names(theta) <- knobj$global_parameters$param_names
	theta <- knobj$transform_params(theta)
	fail <- F
	
	
	## Compute likelihood for all experiments
	temp <- sapply(
		knobj$datas, FUN = function(x){
			if(!is.null(x$data)){
				temp1 <- x$manip(theta, knobj$global_parameters$initial_conditions)
				temp2 <- eval_kn_log_like(theta = temp1$theta,
					initial_conditions = temp1$initial_conditions,
		      data = x$data,
		      knobj = knobj,
		      fail_incoming = T,
		      fit = fit    
        )
        if (fail_incoming){
        	fail = fail | temp2$fail
        }
        ## Weight the log likelihood (experiments with
        ## larger number of points not have larger 
        ## impacts
       	temp2$res / nrow(x$data) / (ncol(x$data) - 1)
				}else{
   		 		0
				}
			}
	)
  
  res <- (res + sum(temp)) / sum_weights
  if(fail_incoming){
		tmp <- res
		res <- c()
		res$res <- tmp
		res$fail <- fail
		res
	}
	else{
		res
	}
	
}

Try the pauwels2014 package in your browser

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

pauwels2014 documentation built on May 1, 2019, 6:29 p.m.