require(R6)
#' factor_estimate_poisson_mode
#'
#' A risk model factor estimate.
#' Based on a Poisson distribution, ideal for event frequency modelling.
#' The estimation is based on the distribution mode.
#'
#' @docType class
#' @keywords data
#' @return Object of \code{\link{R6Class}} with properties and methods for simple integration in a risk model.
#' @format \code{\link{R6Class}} object.
#' @examples
#' factor_estimate_poisson_mode$new(estimated_mode_value = 100)
#' @field dist_mode The mode of the fitted distribution.
#' @section Methods:
#' \describe{
#' \item{\code{new(estimated_mode_value,time_interval_friendly_name)}}{This method is used to create a new object of this class with \code{estimated_mode_value} as the estimated mode.}
#' \item{\code{plot_density()}}{Plot the PDF.}
#' }
#'
#' @export
factor_estimate_poisson_mode <- R6Class(
"factor_estimate_poisson_mode",
inherit = factor_estimate_poisson,
public = list(
initialize = function(
estimated_mode_value = NULL,
time_interval_friendly_name = NULL,
limit_min_value = NULL,
limit_min_behavior = NULL,
limit_max_value = NULL,
limit_max_behavior = NULL,
verbosity = NULL,
fit_distribution = NULL, # Triggers distribution fitting immediately.
simulate = NULL, # Triggers simulation immediately.
...) {
# Parameters validation
if (is_void(estimated_mode_value)) { estimated_mode_value <- NA }
if (is_void(fit_distribution)) { fit_distribution <- TRUE }
if (is_void(simulate)) { simulate <- TRUE }
verbosity <- vp(verbosity, 1, "numeric", 1)
super$initialize(
estimation_method_name = "Mode estimate",
limit_min_value = limit_min_value,
limit_min_behavior = limit_min_behavior,
limit_max_value = limit_max_value,
limit_max_behavior = limit_max_behavior,
verbosity = verbosity - 1,
...)
# Initialize lambda parameters
# to avoid the presence of NULLs.
self$lambda <- NA
self$estimated_mode_value <- estimated_mode_value
if (fit_distribution) { self$fit_distribution(...) }
if (simulate) { self$simulate(...) }
},
fit_distribution = function(...) {
self$lambda <- fit_poisson_mode(
estimated_mode_value = self$estimated_mode_value, ...)
},
get_print_lines = function(...) {
return(
c(super$get_print_lines(),
"Estimation parameters:",
paste0(
" mode = ", fn(self$estimated_mode_value,2)),
"Fitted quantiles:",
paste0(
" mode = ", fn(self$dist_mode, 2)),
"Fitted probabilities:",
paste0(
" ,mode = ", fn(self$dist_mode, 2))
))
},
check_state_consistency = function(output_format = NULL, ...) {
# Informs us if the current parameters are consistent / logical.
# This makes it possible to prevent useless calls to expensive functions
# that may output multitude of warnings and errors when we know
# from the beginning that this parameterization is doomed to failure.
# Returns TRUE if parameters are consistent.
# Returns a descriptive
if (is_void(output_format)) { output_format = "boolean" }
consistency_error_count <- super$check_state_consistency(output_format = "int")
consistency_report <- super$check_state_consistency(output_format = "report")
# Check if all mandatory parameters have been defined.
if (is_void(self$estimated_mode_value)) {
consistency_error_count <- consistency_error_count + 1
consistency_report <- paste0(c(consistency_report, "estimated mode value is missing."), sep = "\n")
}
if (consistency_error_count == 0)
{
# If all parameters are present,
# we can check consistency between parameters.
# N/A
}
# And eventually output the conclusion in the desired format.
if ( output_format == "boolean")
{
return(consistency_error_count == 0)
}
else if ( output_format == "int")
{
return(consistency_error_count)
}
else if ( output_format == "report")
{
return(consistency_report)
}
else
{
stop("Sorry, this output format is not supported.")
}
},
overplot_quantile_vertical_lines = function(
verbosity = NULL,
...) {
# Overplot enrichment for quantile dimension
# Default values
if (is_void(verbosity)) { verbosity <- 0 }
# Prepare a vector with the estimation parameters
estimates <- c(self$estimated_mode_value)
# Enrich the graph with the estimates represented as vertical lines
overplot_01 <- overplot_vertical_lines(
x_values = estimates,
color = "blue",
alpha = .2,
plot_addition = NULL,
verbosity = verbosity - 1,
...)
limits_values <- c()
if (!is_void(self$limit_min_value))
{
limits_values <- c(limits_values, self$limit_min_value)
}
if (!is_void(self$limit_max_value))
{
limits_values <- c(limits_values, self$limit_max_value)
}
# Enrich the graph with the estimates represented as vertical lines
if (!is_void(self$limit_min_value) | !is_void(self$limit_max_value))
{
overplot_01 <- overplot_vertical_lines(
x_values = limits_values,
x_labels = NULL,
color = "red",
alpha = .2,
plot_addition = overplot_01,
verbosity = verbosity - 1,
...)
}
return(overplot_01)
},
plot_density = function(x_start = NULL, x_end = NULL, ...) {
# Override the super-class method to append the limits and point estimates.
if (is_void(x_start) | is_void(x_end))
{
x_start <- min(self$estimated_range_min_value, self$limit_min_value)
x_end <- max(self$estimated_range_max_value, self$limit_max_value)
margin <- (x_end - x_start) * .1 # Add a visual 10% margin
x_start <- x_start - margin
x_end <- x_end + margin
}
# Get overplot enrichments for the applicable dimensions
overplot_01 <- self$overplot_quantile_vertical_lines(...)
# Sum together plot additions
plot_addition <- overplot_01
# Get the plot from superclass, passing it plot additions
plot_01 <- super$plot_density(
x_start = x_start,
x_end = x_end,
plot_addition = plot_addition,
verbosity = verbosity - 1,
...)
return(plot_01)
},
plot_probability = function(x_start = NULL, x_end = NULL, ...) {
# Override the super-class method to append the limits and point estimates.
if (is_void(x_start) | is_void(x_end))
{
x_start <- min(self$estimated_range_min_value, self$limit_min_value)
x_end <- max(self$estimated_range_max_value, self$limit_max_value)
margin <- (x_end - x_start) * .1 # Add a visual 10% margin
x_start <- x_start - margin
x_end <- x_end + margin
}
# Get the original CPF plot
plot_01 <- super$plot_probability(x_start = x_start, x_end = x_end)
# Prepare a vector with the 3 points estimates
x_estimates <- c(self$estimated_range_min_value,
self$estimated_range_max_value)
# Enrich the graph with the estimates represented as vertical lines
plot_01 <- overplot_vertical_lines(plot_01, x_values = x_estimates, color = "blue", alpha = .2, ...)
x_limits_values <- c()
if (!is_void(self$limit_min_value))
{
x_limits_values <- c(x_limits_values, self$limit_min_value)
}
if (!is_void(self$limit_max_value))
{
x_limits_values <- c(x_limits_values, self$limit_max_value)
}
# Enrich the graph with the estimates represented as vertical lines
if (!is_void(self$limit_min_value) | !is_void(self$limit_max_value))
{
plot_01 <- overplot_vertical_lines(plot_01, x_values = x_limits_values, x_labels = NULL, color = "red", alpha = .2, ...)
}
# Prepare a vector with the 3 points estimates
y_estimates <- c(self$estimated_range_min_proba,
self$estimated_range_max_proba)
# Enrich the graph with the estimates represented as vertical lines
plot_01 <- overplot_horizontal_lines(plot_01, y_values = y_estimates, color = "blue", alpha = .2, ...)
return(plot_01)
}
),
active = list(
dist_mode = function(value,...) {
if (missing(value))
{
# Estimated mode = lambda = fitted distribution mode
# So this function is ridiculously trivial
return(self$estimated_mode_value)
}
else {stop("This is a read-only attribute")}},
estimated_mode_value = function(value,...) {
if (missing(value)) {
if (is_void(private$private_estimated_mode_value)) {
# If the attribute does not exist, initialize it with NA to prevent errors accessing it.
private$private_estimated_mode_value <- NA }
return(private$private_estimated_mode_value)
}
else {
# We only do something if something changes... This is important for Shiny apps, etc. to avoid recomputing everything when recomputing is not required
if (is_void(self$estimated_mode_value) | value != self$estimated_mode_value)
{
private$private_estimated_mode_value <- value
if (self$check_state_consistency()) { self$fit_distribution() }
}
}
}
),
private = list(
private_estimated_mode_value = NA
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.