Realized Net Benefit

This is a small example of Realized Net Benefit.

I’ve added 0.001 to the original numbers from the article because {rtichoke} calculates performance metrics for \(Risk\leq{P_t}\) and not \(Risk<{P_t}\)

library(plotly)
library(dplyr)
library(rtichoke)

probs = 0.001 + c(0.8, 0.7, 0.6, 0.5, 0.3, 0.2, 0.1, 0.1, 0.05, 0.01)
reals = c(1, 1, 0, 1, 1, 0, 0, 0, 1, 0)

### rtichoke

N <- 10
resource_constraint <- 3

hover_text <- paste(
  "Realized Net Benefit: %{y:.3f}",
  "<br>",
  "Probability Threshold: %{x:.2f}",
  "<extra></extra>"
)

prepare_performance_data(
  probs = list(probs[1:resource_constraint]),
  reals = list(reals[1:resource_constraint]),
) %>% 
  select(probability_threshold, TP, FP, TN, FN) %>% 
  mutate(RNB = (TP - FP *probability_threshold / 
                  (1 - probability_threshold)) / N ) %>% 
  plot_ly(
    x =~ probability_threshold,
    y =~ RNB,
    height = 500,
    width = 500
  ) %>% 
  add_trace(type = "scatter",
            mode = "markers+lines",
            color = I("black"),
            hovertemplate = hover_text) %>%
  add_markers(
    frame = ~probability_threshold,
    marker = list(
      size = 12,
      line = list(
        width = 3,
        color = I("black")
      ),
      color = "#f6e3be"
    ),
    hovertemplate = hover_text) %>%
layout(
    xaxis = list(
      title = "Probability Threshold",
      showgrid = FALSE
    ),
    yaxis = list(
      title = "Realized Net Benefit",
      showgrid = FALSE
    ),
    showlegend = FALSE
  ) %>% 
  config(displayModeBar = FALSE) %>% 
  animation_slider(
          currentvalue = list(prefix = "Prob. Threshold: ",
          font = list(color="black"),
          xanchor = "left"),
          pad = list(t = 50)
        )