From 736fc449d3cf1b6f3b4ef0b9a15edfc603625f14 Mon Sep 17 00:00:00 2001
From: aduvermy <arnaud.duvermy@ens-lyon.fr>
Date: Wed, 13 Mar 2024 13:52:28 +0100
Subject: [PATCH] ability to calculate performance_ratio
---
R/precision_recall.R | 8 +++-----
R/rocr_functions.R | 8 +++-----
R/simulation_report.R | 3 ++-
dev/flat_full.Rmd | 11 +++++------
4 files changed, 13 insertions(+), 17 deletions(-)
diff --git a/R/precision_recall.R b/R/precision_recall.R
index b61bccd..920b403 100644
--- a/R/precision_recall.R
+++ b/R/precision_recall.R
@@ -71,17 +71,15 @@ get_pr_object <- function(evaldata_params, col_param = "description", col_truth
pr_auc_params <- join_dtf(pr_auc_params, random_classifier_auc_params ,
k1 = col_param, k2 = col_param)
names(pr_auc_params)[ names(pr_auc_params) == "random_classifier_auc_params" ] <- "pr_randm_AUC"
-
-
-
+ pr_auc_params$pr_performance_ratio <- pr_auc_params$pr_AUC/pr_auc_params$pr_randm_AUC
## -- aggregate
pr_curve_agg <- dt_evaldata_params[, compute_pr_curve(.SD), by = "from", .SDcols=c(col_truth, col_score)]
pr_auc_agg <- pr_curve_agg[, compute_pr_auc(.SD), by = "from", .SDcols=c("recall", "precision")]
names(pr_auc_agg)[ names(pr_auc_agg) == "V1" ] <- "pr_AUC"
pr_auc_agg$pr_randm_AUC <- random_classifier_auc_agg
-
-
+ pr_auc_agg$pr_performance_ratio <- pr_auc_agg$pr_AUC/pr_auc_agg$pr_randm_AUC
+
return(list(byparams = list(pr_curve = as.data.frame(pr_curve_params),
pr_auc = as.data.frame(pr_auc_params)),
aggregate = list(pr_curve = as.data.frame(pr_curve_agg),
diff --git a/R/rocr_functions.R b/R/rocr_functions.R
index b61bccd..920b403 100644
--- a/R/rocr_functions.R
+++ b/R/rocr_functions.R
@@ -71,17 +71,15 @@ get_pr_object <- function(evaldata_params, col_param = "description", col_truth
pr_auc_params <- join_dtf(pr_auc_params, random_classifier_auc_params ,
k1 = col_param, k2 = col_param)
names(pr_auc_params)[ names(pr_auc_params) == "random_classifier_auc_params" ] <- "pr_randm_AUC"
-
-
-
+ pr_auc_params$pr_performance_ratio <- pr_auc_params$pr_AUC/pr_auc_params$pr_randm_AUC
## -- aggregate
pr_curve_agg <- dt_evaldata_params[, compute_pr_curve(.SD), by = "from", .SDcols=c(col_truth, col_score)]
pr_auc_agg <- pr_curve_agg[, compute_pr_auc(.SD), by = "from", .SDcols=c("recall", "precision")]
names(pr_auc_agg)[ names(pr_auc_agg) == "V1" ] <- "pr_AUC"
pr_auc_agg$pr_randm_AUC <- random_classifier_auc_agg
-
-
+ pr_auc_agg$pr_performance_ratio <- pr_auc_agg$pr_AUC/pr_auc_agg$pr_randm_AUC
+
return(list(byparams = list(pr_curve = as.data.frame(pr_curve_params),
pr_auc = as.data.frame(pr_auc_params)),
aggregate = list(pr_curve = as.data.frame(pr_curve_agg),
diff --git a/R/simulation_report.R b/R/simulation_report.R
index 6955f61..6717854 100644
--- a/R/simulation_report.R
+++ b/R/simulation_report.R
@@ -142,7 +142,8 @@ evaluation_report <- function(list_tmb, dds, mock_obj, coeff_threshold, alt_hypo
## -- acc, recall, sensib, speci, ...
metrics_obj <- get_ml_metrics_obj(eval_data2metrics, alpha_risk )
## -- merge all metrics in one obj
- model_perf_obj <- get_performances_metrics_obj( r2_params = params_identity_eval$R2, dispersion_identity_eval$R2,
+ model_perf_obj <- get_performances_metrics_obj( r2_params = params_identity_eval$R2,
+ dispersion_identity_eval$R2,
pr_curve_obj,
roc_curve_obj,
metrics_obj )
diff --git a/dev/flat_full.Rmd b/dev/flat_full.Rmd
index 1a95b4d..32fbba8 100644
--- a/dev/flat_full.Rmd
+++ b/dev/flat_full.Rmd
@@ -6833,17 +6833,15 @@ get_pr_object <- function(evaldata_params, col_param = "description", col_truth
pr_auc_params <- join_dtf(pr_auc_params, random_classifier_auc_params ,
k1 = col_param, k2 = col_param)
names(pr_auc_params)[ names(pr_auc_params) == "random_classifier_auc_params" ] <- "pr_randm_AUC"
-
-
-
+ pr_auc_params$pr_performance_ratio <- pr_auc_params$pr_AUC/pr_auc_params$pr_randm_AUC
## -- aggregate
pr_curve_agg <- dt_evaldata_params[, compute_pr_curve(.SD), by = "from", .SDcols=c(col_truth, col_score)]
pr_auc_agg <- pr_curve_agg[, compute_pr_auc(.SD), by = "from", .SDcols=c("recall", "precision")]
names(pr_auc_agg)[ names(pr_auc_agg) == "V1" ] <- "pr_AUC"
pr_auc_agg$pr_randm_AUC <- random_classifier_auc_agg
-
-
+ pr_auc_agg$pr_performance_ratio <- pr_auc_agg$pr_AUC/pr_auc_agg$pr_randm_AUC
+
return(list(byparams = list(pr_curve = as.data.frame(pr_curve_params),
pr_auc = as.data.frame(pr_auc_params)),
aggregate = list(pr_curve = as.data.frame(pr_curve_agg),
@@ -8125,7 +8123,8 @@ evaluation_report <- function(list_tmb, dds, mock_obj, coeff_threshold, alt_hypo
## -- acc, recall, sensib, speci, ...
metrics_obj <- get_ml_metrics_obj(eval_data2metrics, alpha_risk )
## -- merge all metrics in one obj
- model_perf_obj <- get_performances_metrics_obj( r2_params = params_identity_eval$R2, dispersion_identity_eval$R2,
+ model_perf_obj <- get_performances_metrics_obj( r2_params = params_identity_eval$R2,
+ dispersion_identity_eval$R2,
pr_curve_obj,
roc_curve_obj,
metrics_obj )
--
GitLab