likelihood cost function, calling global variable (not ideal but seemingly the only way in BayesianTools)
likelihood cost function, calling global variable (not ideal but seemingly the only way in BayesianTools)

khufkens/phenor
#' A Root Mean Squared Error cost function for model optimization.
#'
#' @param par a vector of parameter values, this is functions specific
#' @param data nested data structure with validation data as returned
#' by format_phenocam() or format_pep725(), or your own dataset adhering
#' to the same data structure.
#' @param model the model name to be used in optimizing the model
#' Most models are listed in Melaas et al. 2013, additional ones
#' will be added over time, preliminary list:
#' 1. SEQ1.3
#' @param ... extra arguments to pass to the function
#' @return the RMSE comparing observed and estimated values
#' @keywords phenology, model, optimization, cost function
#' @export
#' @examples
#'
#' # The cost function returns the rmse between the
#' # true values and those generated by the model given a
#' # parameterset par.
#' \dontrun{
#' cost_value = rmse(par, data, model="TTs")
#' }

rmse = function(par,
                data,
                model, ...) {

  # inset validity checks
  val = data$transition_dates
  out = do.call(model,list(data = data, par = par, ...))

  if (any(is.na(out))) {
    return(9999)
  } else {
    # return the RMSE between the validation data and
    # the output of the model
    return(sqrt(mean((val - out) ^ 2, na.rm = T)))
  }
}

#' A likelihood cost function for model optimization.
#'
#' @param par a vector of parameter values, this is functions specific
#' @param data nested data structure with validation data as returned
#' by format_phenocam() or format_pep725(), or your own dataset adhering
#' to the same data structure.
#' @param model the model name to be used in optimizing the model
#' Most models are listed in Melaas et al. 2013, additional ones
#' will be added over time, preliminary list:
#' 1. SEQ1.3
#' @param ... extra arguments to pass to the function
#' @return the RMSE comparing observed and estimated values
#' @keywords phenology, model, optimization, cost function
#' @export
#' @examples
#'
#' # The cost function returns the rmse between the
#' # true values and those generated by the model given a
#' # parameterset par.
#' \dontrun{
#' cost_value = likelihood(par, data, model="TTs")
#' }
#'
likelihood = function(par) {

  # inset validity checks
  val = data$transition_dates
  out = do.call(tmp_model,list(data = tmp_data,
                           par = par[1:(length(par)-1)]))

  if (any(is.na(out))) {
    return(9999)
  } else {
    # return the RMSE between the validation data and
    # the output of the model
    singlelikelihoods = dnorm(val,
                              mean = out,
                              sd = 1/(par[length(par)]^2),
                              log = T)
    return(sum(singlelikelihoods))
  }
}

#' A Root Mean Squared Error cost function for model optimization.
#'
#' @param par a vector of parameter values, this is functions specific
#' @param data nested data structure with validation data as returned
#' by format_phenocam() or format_pep725(), or your own dataset adhering
#' to the same data structure.
#' @param model the model name to be used in optimizing the model
#' Most models are listed in Melaas et al. 2013, additional ones
#' will be added over time, preliminary list:
#' 1. SEQ1.3
#' @param ... extra arguments to pass to the function
#' @return the RMSE comparing observed and estimated values
#' @keywords phenology, model, optimization, cost function
#' @export
#' @examples
#'
#' # The cost function returns the rmse between the
#' # true values and those generated by the model given a
#' # parameterset par.
#' \dontrun{
#' cost_value = rmse(par, data, model="TTs")
#' }

rmse = function(par, data, model, ...) {

  # inset validity checks
  val = data$transition_dates
  out = do.call(model,list(data = data, par = par, ...))

  if (any(is.na(out))) {
    return(9999)
  } else {
    # return the RMSE between the validation data and
    # the output of the model
    return(sqrt(mean((val - out) ^ 2, na.rm = T)))
  }
}

#' A likelihood cost function for model optimization.
#'
#' @param par a vector of parameter values, this is functions specific
#' @param data nested data structure with validation data as returned
#' by format_phenocam() or format_pep725(), or your own dataset adhering
#' to the same data structure.
#' @param model the model name to be used in optimizing the model
#' Most models are listed in Melaas et al. 2013, additional ones
#' will be added over time, preliminary list:
#' 1. SEQ1.3
#' @param ... extra arguments to pass to the function
#' @return the RMSE comparing observed and estimated values
#' @keywords phenology, model, optimization, cost function
#' @export
#' @examples
#'
#' # The cost function returns the rmse between the
#' # true values and those generated by the model given a
#' # parameterset par.
#' \dontrun{
#' cost_value = likelihood(par, data, model="TTs")
#' }
#'
likelihood = function(par, data, model, ...) {

  # inset validity checks
  val = data$transition_dates
  out = do.call(model,list(data = data, par = par, ...))

  if (any(is.na(out))) {
    return(9999)
  } else {
    # return the RMSE between the validation data and
    # the output of the model
    BayesianTools::singlelikelihoods = dnorm(val,
                                             mean = out,
                                             sd = 1/(par[length(par)]^2),
                                             log = T)
    return(sum(singlelikelihoods))
  }
}
