# Load the rchallenge package library(rchallenge) # General settings data_dir = "@DATA_DIR@" # directory of the data submissions_dir = "@SUBMISSIONS_DIR@" # directory of the submissions hist_dir = "@HIST_DIR@" # directory where the submissions history is stored email = "@EMAIL@" # email address of the challenge administrator date_start = "@DATE_START@" # starting date of the challenge deadline = as.POSIXct("@DEADLINE@") # deadline of the challenge baseline = "@BASELINE@" # name of the team considered as the baseline # Load the data load(file.path(data_dir, "data_train.rda")) load(file.path(data_dir, "data_test.rda")) load(file.path(data_dir, "y_test.rda")) load(file.path(data_dir, "ind_quiz.rda")) # Toggle test or quiz dataset for performance evaluation test_or_quiz <- ifelse(Sys.time()<deadline, "quiz", "test") # comment to disable quiz # test_or_quiz <- "test" # uncomment to disable quiz # Define custom functions that compute performance criterions error_rate <- function(y_pred, y_test) { FP = (y_pred == "Good") & (y_test == "Bad") FN = (y_pred == "Bad") & (y_test == "Good") return(sum(FP+FN)/length(y_test)) } average_cost <- function(y_pred, y_test) { FP = (y_pred == "Good") & (y_test == "Bad") FN = (y_pred == "Bad") & (y_test == "Good") return(sum(5*FP+FN)/length(y_test)) } metrics = list(error = error_rate, cost = average_cost) # Define custom function that reads a submission file and throws errors or # warnings if it is not valid. read_pred <- function(file, n = length(y_test)) { y_pred <- scan(file, what = "character") y_pred <- factor(y_pred, levels = c("Bad", "Good")) if (length(y_pred) != n) stop("incorrect number of predictions") if (any(is.na(y_pred))) stop("predictions contain missing values (NA)") return(y_pred) } # Store new submission files. read_err = store_new_submissions(submissions_dir, hist_dir, deadline = deadline, valid_fun = read_pred) # Compute metrics of the submissions in the history. history = compute_metrics(hist_dir, metrics, y_test, ind_quiz, read_fun = read_pred) # Load the current best submissions results if (file.exists(file.path(hist_dir, "best.rda"))) { load(file.path(hist_dir, "best.rda")) } else best = list() n_team = 0 n_submissions = 0 # Update the current best submissions results if (length(history)>0) { # compute one leaderboard per metric # in both cases, the other metric is used to break ties best_error = get_best(history, metrics=c("error", "cost"), test_name=test_or_quiz) best_cost = get_best(history, metrics=c("cost", "error"), test_name=test_or_quiz) if ("error" %in% names(best)) best_error = update_rank_diff(best_error, best$error) if ("cost" %in% names(best)) best_cost = update_rank_diff(best_cost, best$cost) best$error = best_error best$cost = best_cost # save best save(best, file = file.path(hist_dir, "best.rda")) # get stats n_team = sum(best[[1]]$team != baseline) n_submissions = sum(best[[1]]$n_submissions[best[[1]]$team != baseline]) }
Bienvenue sur la page du challenge !
| r icon("fa-cloud-upload fa-2x")
\ r n_submissions
| r icon("fa-users fa-2x")
\ r n_team
| r icon("fa-calendar fa-2x")
\ r countdown(deadline)
|
|:-------------:|:-------------:|:-------------:|
| soumissions | équipes | r ifelse(Sys.time()<deadline, "en cours", "terminé")
|
Dernière mise à jour : r last_update(deadline)
r date_start
:
~ Le challenge est ouvert !
colnames = c(paste(icon(c("fa-trophy", "fa-users", "fa-cloud-upload", "fa-calendar", "fa-bullseye", "fa-bullseye")), c("Classement", "Equipe", "Soumissions", "Date", "Taux d\'erreur", "Coût moyen"))) if ("error" %in% names(best)) print_leaderboard(best[["error"]], c("error", "cost"), test_name=test_or_quiz, col.names=colnames, caption="Meilleur taux d'erreur")
colnames[5:6] = colnames[6:5] if ("cost" %in% names(best)) print_leaderboard(best[["cost"]], c("cost", "error"), test_name=test_or_quiz, col.names=colnames, caption="Meilleur coût moyen")
Classification binaire : prédire la solvabilité ou le risque de non-remboursement d'un ensemble de clients dans le but de l'octroi de crédit bancaire.
On dispose pour cela d'un jeu de données d'apprentissage supervisé : ensemble de clients dont la réponse est connue. Le but est d'obtenir le meilleur score de prédiction sur un jeu de données test dont la réponse est cachée.
Envoyer un email à <r email
> contenant les informations suivantes :
r icon("fa-dropbox fa-lg")
Vous recevrez une invitation à partager un dossier Dropbox portant le nom de votre équipe.
Télécharger les données.
Soumettre vos prédictions sur le jeu test sous format csv dans le dossier Dropbox partagé.
Note : Le nombre de soumissions n'est pas limité. Cependant le calcul des scores n'est mis à jour que toutes les heures.
Date limite des soumissions : r format(deadline, "%A %d %b %Y %H:%M", usetz=TRUE)
| Nom | Fichier | Description | Liens |
| ---- | ---- | ----------- | ----- |
| Apprentissage | data_train.rda
| data.frame
avec r nrow(data_train)
lignes/clients et r ncol(data_train)
colonnes/variables | r icon("fa-download fa-lg")
|
| Test | data_test.rda
| data.frame
avec r nrow(data_test)
lignes/clients et r ncol(data_test)
colonnes/variables | r icon("fa-download fa-lg")
|
Ces fichiers sont à importer dans R avec :
load("data_train.rda") load("data_test.rda")
La variable à prédire est la variable Class
dont la valeur est Bad
ou Good
. Les valeurs d'apprentissage de cette variable sont fournies dans la dernière colonne de data_train
. data_test
ne contient pas cette colonne puisqu'elle doit être prédite.
Le jeu de données complet contient 30% de Bad
et 70% de Good
. Ces proportions sont respectées à la fois dans le jeu d'apprentissage et le jeu test.
table(data_train$Class)/nrow(data_train)
Pour la prédiction, on dispose de r ncol(data_test)
variables explicatives dont :
r sum(sapply(data_test[1,], is.numeric))
variables quantitatives de classe numeric
r sum(sapply(data_test[1,], is.factor))
variables qualitatives de classe factor
str(data_test)
Les statistiques univariées de ces variables peuvent facilement être obtenues :
summary(rbind(data_train[,-ncol(data_train)], data_test))
Un classifieur est une fonction qui affecte une classe Bad
ou Good
à l'ensemble des données test. Un telle fonction peut être :
predict_all_good <- function(data_test, ...) { y_pred = rep("Good", nrow(data_test)) return(y_pred) }
qui affecte Good
à toutes les individus. Un tel classifieur n'utilise pas les données d'apprentissage. Il correspond à accepter toutes les demandes de crédit.
On obtient le résultat suivant
y_pred = predict_all_good(data_test)
Vous devez programmer un ou plusieurs classifieurs qui utilisent les données d'apprentissage pour améliorer les performances d'une telle décision.
Les performances de votre prédiction sont calculées en fonction des vraies réponses de l'ensemble test. On utilisera deux critères différents.
Le taux d'erreur mesure le taux de mauvaise classification de vos prédictions soit le nombre de faux positifs FP
plus le nombre de faux négatifs FN
divisé par le nombre total. Il est mesuré par la fonction average_error
.
dump("error_rate", "")
Cette métrique de performance correspond au côut 0-1 moyenné sur l'ensemble des prédictions. Le but est de minimiser le taux d'erreur. Puisque 70% des individus sont Good
, le taux d'erreur associé au prédicteur predict_all_good
est de 0.3, tandis que son homologue predict_all_bad
fournit 0.7. predict_all_good
est ici préférable.
On considère cependant qu'il est 5 fois plus risqué/coûteux d'accorder un crédit à une personne non solvable (faux positif) que de ne pas accorder de crédit à une personne solvable (faux négatif). Le coût moyen est mesuré par la fonction average_cost
.
dump("average_cost", "")
Le but étant de minimiser le coût moyen, predict_all_bad
est ici préférable avec 0.7 à predict_all_good
avec 1.5. Du point de vue du coût moyen, il est donc moins risqué de n'accorder aucun crédit.
Les soumissions se font sous forme de fichier texte portant l'extension .csv
, que vous pouvez exporter avec la commande suivante :
write(y_pred, file = "my_pred.csv")
Le fichier doit contenir r nrow(data_test)
lignes contenant uniquement le mot Bad
ou Good
.
Tous les fichiers .csv
placés dans votre répertoire Dropbox partagé seront automatiquement importés grâce à la fonction read_pred
.
read_pred <- function(file, n = nrow(data_test)) { y_pred <- scan(file, what = "character") y_pred <- factor(y_pred, levels = c("Bad", "Good")) if (length(y_pred) != n) stop("incorrect number of predictions") if (any(is.na(y_pred))) stop("predictions contain missing values (NA)") return(y_pred) }
Utilisez cette fonction pour vérifier que votre fichier sera correctement importé.
Les erreurs de lecture lors de l'import sont affichées à la section [Erreurs de lecture].
Une fois un fichier importé, son score est calculé et stocké. Vous pouvez effacer ou remplacer des soumissions, l'historique est conservé.
Le classement ainsi que les scores affichés sont calculés sur seulement la moitié des données test. Le score final calculé sur toutes les données test sera révélé à la fin du challenge.
Seul le meilleur score par équipe parmi toutes les soumissions est retenu.
L'équipe r baseline
correspond au score du meilleur classifieur parmi predict_all_bad
ou predict_all_good
qui tient lieu de référence à améliorer.
# color palette# color palette Dark2 <- colorRampPalette(c("#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E", "#E6AB02", "#A6761D", "#666666")) palette(Dark2(max(length(history)-1, 3))) par(mar = c(5,4,4,7) + 0.1) plot_history(history, "error", test_name=test_or_quiz, baseline=baseline, ylab = "Taux d'erreur")
par(mar = c(5,4,4,7) + 0.1) plot_history(history, "cost", test_name=test_or_quiz, baseline=baseline, ylab = "Coût moyen")
par(mar = c(5,4,4,7) + 0.1) plot_activity(history, baseline=baseline, ylab = "Taux de soumissions")
colnames = c(paste(icon(c("fa-users", "fa-file", "fa-comment")), c("Equipe", "Fichier", "Message"))) print_readerr(read_err, col.names = colnames)
Développé avec rchallenge.
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.