set to 0, negative values do not make sense
set to 0, negative values do not make sense

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 = tmp_data$transition_dates
  out = do.call(tmp_model,list(data = tmp_data,
                           par = par[1:(length(par)-1)]))

  if (any(is.na(out))) {
    return(0)
  } 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) {

  # inset validity checks
  val = tmp_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))
  }
}
