R/plot_succescurve.R

In MelodyPremaillon/valwoe: Statistical validation of susceptibility maps builted with woe method

#' @title Plot success curve
#' @author Melody Premaillon
#'
#' @description Plot success curve on validation data
#'
#' @param df_postprobfreq data frame of postprob frequancy (from build_df_postprobfreq function)
#'
#' @return a ggplot object
#' @import ggplot2
#' @export



plot_succescurve <- function(df_postprobfreq){

  #AUC
  aucs <- calcAUC(df_postprobfreq)

  #Probabilities
  table_postprobvalue <- data.frame(seuil = c(25, 50, 75, 90, 95),
                                    prob_value_train = c(recup_proba(25, df_postprobfreq),recup_proba(50, df_postprobfreq),
                                                         recup_proba(75, df_postprobfreq),recup_proba(90, df_postprobfreq),
                                                         recup_proba(95, df_postprobfreq))) #récupération des probabilitées de glissement pour des pourcentages donnés

  #Plot
  traingg <- ggplot(df_postprobfreq, aes(count_cum_prct, trng_cum_prct, label=POST_PROB)) +
    geom_line(color="red", size=1) +
    geom_hline(yintercept = c(25, 50, 75, 90, 95), color ="grey20") +
    geom_area(aes(count_cum_prct, trng_cum_prct), fill="red", alpha=.1) +
    geom_text(data = table_postprobvalue, aes(x=100, y=seuil,
                                              label=format(prob_value_train, scientific = T , digit=3 )),
              vjust=0, hjust= 1) +
    geom_text(label= paste("AUC :", aucs$training),
              x=100, y = 10, hjust = 1, color = "red") +
    theme_light() +
    theme(
      plot.title.position = "plot",
      plot.title = element_text(color="black"),
    )  +
    labs(title = "Courbe de succes sur set d'entrainement") +
    scale_x_continuous(name = "Surface de la carte \n(en % cumules)",
                       breaks = seq(0,100, by=25),
                       labels = seq(0,100, by=25)) +
    scale_y_continuous(name = "Nombre de mouvements de terrain \n(en % cumules)", limits=c(0,100)) +
    coord_fixed(ratio =1)

  return(traingg)
}