challenge.rmd

---
title: "Challenge MIMSE 2014"
author: "Adrien Todeschini"
date: ''
output:
  html_document:
    highlight: tango
    theme: spacelab
---
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/font-awesome/4.6.3/css/font-awesome.min.css">

<a href="https://github.com/adrtod/challenge-mimse2014"><img style="position: absolute; top: 0; right: 0; border: 0;" src="https://camo.githubusercontent.com/38ef81f8aca64bb9a64448d0d70f1308ef5341ab/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f6461726b626c75655f3132313632312e706e67" alt="Fork me on GitHub" data-canonical-src="https://s3.amazonaws.com/github/ribbons/forkme_right_darkblue_121621.png"></a>

```{r echo=FALSE, message=FALSE, warning=FALSE}
# Load the rchallenge package
library(rchallenge)

# General settings
data_dir = "data" # directory of the data
submissions_dir = "submissions" # directory of the submissions
hist_dir = "history" # directory where the submissions history is stored
email = "adrien.todeschini@inria.fr" # email adress of the challenge administrator
date_start = "7 oct. 2014" # starting date of the challenge
deadline = as.POSIXct("2015-01-07 23:59:59") # 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 d'[Apprentissage automatique](https://adrtod.github.io/ml2014) du Master 2 [MIMSE](http://www.math.u-bordeaux.fr/DIM/master/mimse/pageweb/pmwiki.php) !

| `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
Le 8 janv. 2015 :
  ~ Le challenge est terminé et voici le [classement][Classement] final. Bravo à tous !
  
Le 4 janv. 2015 :
  ~ Note sur la prise en compte des coûts : [`r icon("fa-download fa-lg")`](note_challenge.pdf)
  
Le 3 nov. 2014 :
  ~ Les scores sont maintenant calculés sur l'ensemble du jeu test et non plus sur un sous ensemble. Le classement et l'[historique][Historique des soumissions] ont été mis à jour en conséquence. La date limite des contributions a été repoussée au `r format(deadline, "%A %d %b %Y")`.
  
Le `r date_start` :
  ~ Le challenge est ouvert !

```{r, echo = FALSE, results='asis'}
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")
```

```{r, echo = FALSE, results='asis'}
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")`](https://www.dropbox.com/)

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

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

# 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")`](data/data_train.rda) |
| 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")`](data/data_test.rda) |

Ces fichiers sont à importer dans R avec :
```{r, eval=FALSE}
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.
```{r}
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`

```{r}
str(data_test)
```

Les statistiques univariées de ces variables peuvent facilement être obtenues :
```{r, eval=FALSE}
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 :
```{r}
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
```{r}
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`.
```{r, echo=FALSE, collapse=TRUE, comment=NA}
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`.
```{r, echo=FALSE, collapse=TRUE, comment=NA}
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.

- Note sur la prise en compte des coûts : [`r icon("fa-download fa-lg")`](note_challenge.pdf)

# Soumissions
Les soumissions se font sous forme de fichier texte portant l'extension `.csv`, que vous pouvez exporter avec la commande suivante :
```{r, eval=FALSE}
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`.
```{r}
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
```{r, echo=FALSE, fig.height=5, fig.width=9}
# 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")
```

```{r, echo=FALSE, fig.height=5, fig.width=9}
par(mar = c(5,4,4,7) + 0.1)
plot_history(history, "cost", test_name=test_or_quiz, baseline=baseline, ylab = "Coût moyen")
```

```{r, echo=FALSE, fig.height=5, fig.width=9}
par(mar = c(5,4,4,7) + 0.1)
plot_activity(history, baseline=baseline, ylab = "Taux de soumissions")
```

# Erreurs de lecture
```{r, echo=FALSE}
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](http://adrtod.github.io/rchallenge/).