In adrtod/rchallenge: A Simple Data Science Challenge System

# 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)

News

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")

Objectif

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.

Déroulement du challenge

1. Envoyer un email à <r email> contenant les informations suivantes :

   • nom de l'équipe et des participants
   • au moins une adresse email associée à un compte Dropbox r icon("fa-dropbox fa-lg")

2. Vous recevrez une invitation à partager un dossier Dropbox portant le nom de votre équipe.

3. Télécharger les données.

4. Soumettre vos prédictions sur le jeu test sous format csv dans le dossier Dropbox partagé.

5. Note : Le nombre de soumissions n'est pas limité. Cependant le calcul des scores n'est mis à jour que toutes les heures.

6. Date limite des soumissions : r format(deadline, "%A %d %b %Y %H:%M", usetz=TRUE)

Description des données

| 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))

Prédiction

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.

Critères de performance

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.

Taux d'erreur

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.

Coût moyen

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.

Soumissions

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é.

Classement

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.

Historique des soumissions

# 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")

Erreurs de lecture

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.

adrtod/rchallenge documentation built on March 23, 2021, 7:43 a.m.