We need the following packages.

library(tidyverse)
library(plotROC)
library(pROC)
library(shiny)
library(caret)
library(class)
library(KernSmooth)  #package for locpoly

Exercise 1 (classification rules and misclassification error estimation)

We consider the following data set

n <- 1000
seuil <- 0.25
set.seed(1234)
X1 <- runif(n)
set.seed(5678)
X2 <- runif(n)
set.seed(9012)
R1 <- X1<=0.25
R2 <- (X1>0.25 & X2>=0.75)
R3 <- (X1>0.25 & X2<0.75)
Y <- rep(0,n)
Y[R1] <- rbinom(sum(R1),1,0.25)
Y[R2] <- rbinom(sum(R2),1,0.25)
Y[R3] <- rbinom(sum(R3),1,0.75)
my_data <- data.frame(X1,X2,Y)
my_data$Y <- as.factor(my_data$Y)

The problem is to explain \(Y\) by \(X_1\) and \(X_2\).

  1. What is the distribution of \(X\)? Same question for \(Y|X=x\) with \(x\in[0,1]^2\).

  2. Calculate the Bayes rule and the Bayes error.

  3. Draw the scatterplot \(X_2\times X_1\) and color the points according to the label \(Y\).

  4. We consider 3 classification rules: \[g_1(x)=1_{x_1>x_2}(x),\quad g_2(x)=1_{x_2<0.5}(x),\quad g_3(x)=1_{x_1>0.25}(x).\] Calculate \(g_\ell(X_i)\) for each observation in my_data (you can use as.numeric). Put all predictions in the same dataframe.

  5. Estimate error probabilities \(P(g_j(X)\neq Y)\) for each classification rule \(g_j\).

  6. We consider the one-nearest neigbor rule defined by \[\widehat g_1(x)=\left\{ \begin{array}{ll} 1 & \text{if }Y(x)=1 \\ 0 & \text{otherwise,} \end{array}\right.\]

where \(Y(x)\) stands for the label of the nearest neighbor of \(x\) among \(\{X_1,\dots,X_n\}\). Split the data into

  • a train dataset of size 750
  • a test dataset of size 250.
  1. Estimate the error probability of the 1-nearest neigbor rule \(\widehat g_1\). You can use the knn function from the class package.

Exercise 2 (ROC curves)

We consider three scores \(S_1,S_2\) and \(S_3\) for 100 individuals. We have also at hand the labels of each individuals in the vector \(Y\). Score and labels are in the following data frame:

set.seed(1234)
S1 <- runif(100)
S2 <- runif(100)
S3 <- S1
S3[sample(100,25)] <- runif(25)
Y <- rep(0,n)
Y[S1>0.5] <- 1
df <- data.frame(S1,S2,S3,Y=as.factor(Y))
  1. Represent score values with a different color for each group.

  2. Draw the roc curve of \(S_1\) with the roc function of the pROC package.

  3. Add roc curves of \(S_2\) and \(S_3\).

  4. Calculate AUC of the three scores.

  5. Draw the three roc curves with the geom_roc function of the plotROC package (use gather to simplify the code).

  6. Compute AUC of the 3 scores with summarize verb.

Exercise 3 (ROC curve for logistic model)

We consider the same dataset as in exercise 1. The goal is to compute the ROC curve for two logistic models.

  1. We first consider the logistic model \[\log\frac{p(x)}{1-p(x)}=\beta_0+\beta_1x_1+\beta_2x_2,\] where \(p(x)=P(Y=1|X=x)\). We learn this model on the training set with
logit1 <- glm(Y~.,data=train,family=binomial)

We consider the score function \(S_1(x)=\beta_0+\beta_1x_1+\beta_2x_2\). Compute the score of each indivuals in the test dataset (use predict).

  1. We consider a second logistic model \[\log\frac{p(x)}{1-p(x)}=\beta_0+\beta_1x_1+\beta_2x_2+\beta_3x_1^2+\beta_4x_2^2\] with score function \(S_2(x)=\beta_0+\beta_1x_1+\beta_2x_2+\beta_3x_1^2+\beta_4x_2^2\). Fit this logistic model on the train dataset and compute the score for individuals in the test dataset.

  2. Build a 3 column data frame which contains values of the two scores and observed labels for individuals in the test dataset.

  3. Draw roc curves and compute AUC of the two scores.

Exercise 4 (kernel regression estimate)

We consider the model

\[Y_i=\sin(X_i)+\varepsilon_i,\quad i=1,\dots,n\] where \(X_i\sim\mathcal U_{[-2\pi,2\pi]}\) and \(\varepsilon_i\sim\mathcal N(0,0.2^4)\)

  1. Generate \(n=500\) observations \((X_1,Y_1),\dots,(X_n,Y_n)\) according to the model above.

  2. Represent on a graph both the sample and the sine function.

  3. Fit a kernel estimate on a train dataset of size 300 with bandwidth \(h=0.5\) (use locpoly function from KernSmooth package). Add the kernel estimate on the previous graphe.

  4. Add the kernel estimates with bandwidths \(h_2=3\) and \(h_3=0.01\) (always fitted on the train sample).

  5. Use the test sample to estimate the mean square error of the three kernel estimates. You can use the ksmooth function.

Exercise 5 (ERM with caret)

We again consider the dataset of exercise 1.

dim(my_data)
set.seed(123)
perm <- sample(nrow(my_data))
train <- my_data %>% slice(perm[1:750])
test <- my_data %>% slice(perm[751:1000])

dim(train)
dim(test)

The goal is to find the best integer \(k\) for the \(k\)-nearest neighbor rule.

  1. Fit the 3 nearest-neighbor rule \(\widehat g_3\) on the train sample and estimate its error probability \[L(\widehat g_3)=\mathbf P(\widehat g_3(X)\neq Y)\] by validation hold hout (with the test sample). Use knn function from class package.

  2. Estimate the error probability for each value of \(k\) in \(\{1,\dots,450\}\). You can use a loop for:

  3. Represent the error on a graph: \(k\) on the \(x\)-axis, estimated error on the \(y\)-axis.

  4. Run the shiny web application in the file overfitting_app.R. Explain the results.

  5. We propose to use caret package to select the best \(k\). We can look at http://topepo.github.io/caret/index.html for a presentation of the package. Explain outputs of the commands:

#ctrl1 <- trainControl(method="LGOCV",number=1,index=list(1:1500))
ctrl1 <- trainControl(method="LGOCV",number=1)
grid.k <- data.frame(k=seq(1,100,by=1))
sel.k <- train(Y~.,data=my_data,method="knn",trControl=ctrl1,tuneGrid=grid.k)
sel.k
plot(sel.k)
  1. Do the same with 500 observations in the train dataset and 500 observations in the test dataset.

  2. Select \(k\) by 10 folds cross-validation.

Remark: We can use the doMC package to parallelize cross-validation:

library(doMC)
detectCores()
ctrl5 <- trainControl(method="cv",number=50)
registerDoMC(cores = 1)
system.time(sel5.k <- train(Y~.,data=my_data,method="knn",trControl=ctrl5,tuneGrid=grid.k))

registerDoMC(cores = 5)
system.time(sel5.k <- train(Y~.,data=my_data,method="knn",trControl=ctrl5,tuneGrid=grid.k))
  1. Explain outputs of these commands.
data1 <- my_data
names(data1)[3] <- c("Class")
levels(data1$Class) <- c("G0","G1")
ctrl11 <- trainControl(method="LGOCV",number=1,index=list(1:750),classProbs=TRUE,summary=twoClassSummary,p=0.66)
aa <- train(Class~.,data=data1,method="knn",trControl=ctrl11,metric="ROC",tuneGrid=grid.k)
aa
getTrainPerf(aa)

We consider AUC instead of the error probability (change of criterion).

LS0tCnRpdGxlOiAiSW50cm9kdWN0aW9uIHRvIE1hY2hpbmUgTGVhcm5pbmcgLSBFeGVyY2lzZXMsIFBhcnQgMSBhbmQgMiIKb3V0cHV0OgogIGh0bWxfbm90ZWJvb2s6CiAgICBjc3M6IH4vRHJvcGJveC9GSUNISUVSU19TVFlMRS9zdHlsZXMuY3NzCiAgICB0b2M6IHllcwogICAgdG9jX2Zsb2F0OiB5ZXMKIyAgICBydW50aW1lOiBzaGlueQogIGh0bWxfZG9jdW1lbnQ6CiAgICBjc3M6IH4vRHJvcGJveC9GSUNISUVSU19TVFlMRS9zdHlsZXMuY3NzCiAgICBkZl9wcmludDogcGFnZWQKICAgIHRvYzogeWVzCi0tLQoKXG5ld2NvbW1hbmR7XHByb2J9e1xtYXRoYmYgUH0KXG5ld2NvbW1hbmR7XGluZH17XG1hdGhiZiAxfQoKV2UgbmVlZCB0aGUgZm9sbG93aW5nIHBhY2thZ2VzLgoKYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkocGxvdFJPQykKbGlicmFyeShwUk9DKQpsaWJyYXJ5KHNoaW55KQpsaWJyYXJ5KGNhcmV0KQpsaWJyYXJ5KGNsYXNzKQpsaWJyYXJ5KEtlcm5TbW9vdGgpICAjcGFja2FnZSBmb3IgbG9jcG9seQpgYGAKCgoKIyMgRXhlcmNpc2UgMSAoY2xhc3NpZmljYXRpb24gcnVsZXMgYW5kIG1pc2NsYXNzaWZpY2F0aW9uIGVycm9yIGVzdGltYXRpb24pCgpXZSBjb25zaWRlciB0aGUgZm9sbG93aW5nIGRhdGEgc2V0CgpgYGB7cn0KbiA8LSAxMDAwCnNldWlsIDwtIDAuMjUKc2V0LnNlZWQoMTIzNCkKWDEgPC0gcnVuaWYobikKc2V0LnNlZWQoNTY3OCkKWDIgPC0gcnVuaWYobikKc2V0LnNlZWQoOTAxMikKUjEgPC0gWDE8PTAuMjUKUjIgPC0gKFgxPjAuMjUgJiBYMj49MC43NSkKUjMgPC0gKFgxPjAuMjUgJiBYMjwwLjc1KQpZIDwtIHJlcCgwLG4pCllbUjFdIDwtIHJiaW5vbShzdW0oUjEpLDEsMC4yNSkKWVtSMl0gPC0gcmJpbm9tKHN1bShSMiksMSwwLjI1KQpZW1IzXSA8LSByYmlub20oc3VtKFIzKSwxLDAuNzUpCm15X2RhdGEgPC0gZGF0YS5mcmFtZShYMSxYMixZKQpteV9kYXRhJFkgPC0gYXMuZmFjdG9yKG15X2RhdGEkWSkKYGBgCgoKVGhlIHByb2JsZW0gaXMgdG8gZXhwbGFpbiAkWSQgYnkgJFhfMSQgYW5kICRYXzIkLiAKCjEuIFdoYXQgaXMgdGhlIGRpc3RyaWJ1dGlvbiBvZiAkWCQ/IFNhbWUgcXVlc3Rpb24gZm9yICRZfFg9eCQgd2l0aCAkeFxpblswLDFdXjIkLgoKCjIuIENhbGN1bGF0ZSB0aGUgQmF5ZXMgcnVsZSBhbmQgdGhlIEJheWVzIGVycm9yLgoKCjMuIERyYXcgdGhlIHNjYXR0ZXJwbG90ICRYXzJcdGltZXMgWF8xJCBhbmQgY29sb3IgdGhlIHBvaW50cyBhY2NvcmRpbmcgdG8gdGhlIGxhYmVsICRZJC4KCgo0LiBXZSBjb25zaWRlciAzIGNsYXNzaWZpY2F0aW9uIHJ1bGVzOgokJGdfMSh4KT0xX3t4XzE+eF8yfSh4KSxccXVhZCBnXzIoeCk9MV97eF8yPDAuNX0oeCksXHF1YWQgZ18zKHgpPTFfe3hfMT4wLjI1fSh4KS4kJApDYWxjdWxhdGUgJGdfXGVsbChYX2kpJCBmb3IgZWFjaCBvYnNlcnZhdGlvbiBpbiAqKm15X2RhdGEqKiAoeW91IGNhbiB1c2UgKiphcy5udW1lcmljKiopLiBQdXQgYWxsIHByZWRpY3Rpb25zIGluIHRoZSBzYW1lICoqZGF0YWZyYW1lKiouCgoKNS4gRXN0aW1hdGUgZXJyb3IgcHJvYmFiaWxpdGllcyAkUChnX2ooWClcbmVxIFkpJCBmb3IgZWFjaCBjbGFzc2lmaWNhdGlvbiBydWxlICRnX2okLgoKCjYuIFdlIGNvbnNpZGVyIHRoZSBvbmUtbmVhcmVzdCBuZWlnYm9yIHJ1bGUgZGVmaW5lZCBieQokJFx3aWRlaGF0IGdfMSh4KT1cbGVmdFx7ClxiZWdpbnthcnJheX17bGx9CjEgJiBcdGV4dHtpZiB9WSh4KT0xIFxcCjAgJiBcdGV4dHtvdGhlcndpc2UsfQpcZW5ke2FycmF5fVxyaWdodC4kJAoKd2hlcmUgJFkoeCkkIHN0YW5kcyBmb3IgdGhlIGxhYmVsIG9mIHRoZSBuZWFyZXN0IG5laWdoYm9yIG9mICR4JCBhbW9uZyAkXHtYXzEsXGRvdHMsWF9uXH0kLiBTcGxpdCB0aGUgZGF0YSBpbnRvCgoqIGEgdHJhaW4gZGF0YXNldCBvZiBzaXplIDc1MAoqIGEgdGVzdCBkYXRhc2V0IG9mIHNpemUgMjUwLgoKCjcuIEVzdGltYXRlIHRoZSBlcnJvciBwcm9iYWJpbGl0eSBvZiB0aGUgMS1uZWFyZXN0IG5laWdib3IgcnVsZSAkXHdpZGVoYXQgZ18xJC4gWW91IGNhbiB1c2UgdGhlICoqa25uKiogZnVuY3Rpb24gZnJvbSB0aGUgKipjbGFzcyoqIHBhY2thZ2UuCgoKCiMjIEV4ZXJjaXNlIDIgKFJPQyBjdXJ2ZXMpCgpXZSBjb25zaWRlciB0aHJlZSBzY29yZXMgJFNfMSxTXzIkIGFuZCAkU18zJCBmb3IgMTAwIGluZGl2aWR1YWxzLiBXZSBoYXZlIGFsc28gYXQgaGFuZCB0aGUgbGFiZWxzIG9mIGVhY2ggaW5kaXZpZHVhbHMgaW4gdGhlIHZlY3RvciAkWSQuIFNjb3JlIGFuZCBsYWJlbHMgYXJlIGluIHRoZSBmb2xsb3dpbmcgZGF0YSBmcmFtZToKCmBgYHtyfQpzZXQuc2VlZCgxMjM0KQpTMSA8LSBydW5pZigxMDApClMyIDwtIHJ1bmlmKDEwMCkKUzMgPC0gUzEKUzNbc2FtcGxlKDEwMCwyNSldIDwtIHJ1bmlmKDI1KQpZIDwtIHJlcCgwLG4pCllbUzE+MC41XSA8LSAxCmRmIDwtIGRhdGEuZnJhbWUoUzEsUzIsUzMsWT1hcy5mYWN0b3IoWSkpCmBgYAoKMS4gUmVwcmVzZW50IHNjb3JlIHZhbHVlcyB3aXRoIGEgZGlmZmVyZW50IGNvbG9yIGZvciBlYWNoIGdyb3VwLgoKMi4gRHJhdyB0aGUgcm9jIGN1cnZlIG9mICRTXzEkIHdpdGggdGhlICoqcm9jKiogZnVuY3Rpb24gb2YgdGhlICoqcFJPQyoqIHBhY2thZ2UuCgozLiBBZGQgcm9jIGN1cnZlcyBvZiAkU18yJCBhbmQgJFNfMyQuCgo0LiBDYWxjdWxhdGUgQVVDIG9mIHRoZSB0aHJlZSBzY29yZXMuCgo1LiBEcmF3IHRoZSB0aHJlZSByb2MgY3VydmVzIHdpdGggdGhlICoqZ2VvbV9yb2MqKiBmdW5jdGlvbiBvZiB0aGUgKipwbG90Uk9DKiogcGFja2FnZSAodXNlICoqZ2F0aGVyKiogdG8gc2ltcGxpZnkgdGhlIGNvZGUpLgoKNi4gQ29tcHV0ZSBBVUMgb2YgdGhlIDMgc2NvcmVzIHdpdGggKipzdW1tYXJpemUqKiB2ZXJiLgoKCgojIyBFeGVyY2lzZSAzIChST0MgY3VydmUgZm9yIGxvZ2lzdGljIG1vZGVsKQoKV2UgY29uc2lkZXIgdGhlIHNhbWUgZGF0YXNldCBhcyBpbiBleGVyY2lzZSAxLiBUaGUgZ29hbCBpcyB0byBjb21wdXRlIHRoZSBST0MgY3VydmUgZm9yIHR3byBsb2dpc3RpYyBtb2RlbHMuCgoxLiBXZSBmaXJzdCBjb25zaWRlciB0aGUgbG9naXN0aWMgbW9kZWwKJCRcbG9nXGZyYWN7cCh4KX17MS1wKHgpfT1cYmV0YV8wK1xiZXRhXzF4XzErXGJldGFfMnhfMiwkJAp3aGVyZSAkcCh4KT1QKFk9MXxYPXgpJC4gV2UgbGVhcm4gdGhpcyBtb2RlbCBvbiB0aGUgKip0cmFpbmluZyoqIHNldCB3aXRoCgpgYGB7cn0KbG9naXQxIDwtIGdsbShZfi4sZGF0YT10cmFpbixmYW1pbHk9Ymlub21pYWwpCmBgYAoKV2UgY29uc2lkZXIgdGhlIHNjb3JlIGZ1bmN0aW9uICRTXzEoeCk9XGJldGFfMCtcYmV0YV8xeF8xK1xiZXRhXzJ4XzIkLiBDb21wdXRlIHRoZSBzY29yZSBvZiBlYWNoIGluZGl2dWFscyBpbiB0aGUgdGVzdCBkYXRhc2V0ICh1c2UgKipwcmVkaWN0KiopLgoKCjIuIFdlIGNvbnNpZGVyIGEgc2Vjb25kIGxvZ2lzdGljIG1vZGVsIAokJFxsb2dcZnJhY3twKHgpfXsxLXAoeCl9PVxiZXRhXzArXGJldGFfMXhfMStcYmV0YV8yeF8yK1xiZXRhXzN4XzFeMitcYmV0YV80eF8yXjIkJAp3aXRoIHNjb3JlIGZ1bmN0aW9uICRTXzIoeCk9XGJldGFfMCtcYmV0YV8xeF8xK1xiZXRhXzJ4XzIrXGJldGFfM3hfMV4yK1xiZXRhXzR4XzJeMiQuCkZpdCB0aGlzIGxvZ2lzdGljIG1vZGVsIG9uIHRoZSB0cmFpbiBkYXRhc2V0IGFuZCBjb21wdXRlIHRoZSBzY29yZSBmb3IgaW5kaXZpZHVhbHMgaW4gdGhlIHRlc3QgZGF0YXNldC4KCgozLiBCdWlsZCBhIDMgY29sdW1uIGRhdGEgZnJhbWUgd2hpY2ggY29udGFpbnMgdmFsdWVzIG9mIHRoZSB0d28gc2NvcmVzIGFuZCBvYnNlcnZlZCBsYWJlbHMgZm9yIGluZGl2aWR1YWxzIGluIHRoZSB0ZXN0IGRhdGFzZXQuCgo0LiBEcmF3IHJvYyBjdXJ2ZXMgYW5kIGNvbXB1dGUgQVVDIG9mIHRoZSB0d28gc2NvcmVzLgoKIyMgRXhlcmNpc2UgNCAoa2VybmVsIHJlZ3Jlc3Npb24gZXN0aW1hdGUpCgpXZSBjb25zaWRlciB0aGUgbW9kZWwKCiQkWV9pPVxzaW4oWF9pKStcdmFyZXBzaWxvbl9pLFxxdWFkIGk9MSxcZG90cyxuJCQKd2hlcmUgJFhfaVxzaW1cbWF0aGNhbCBVX3tbLTJccGksMlxwaV19JCBhbmQgJFx2YXJlcHNpbG9uX2lcc2ltXG1hdGhjYWwgTigwLDAuMl40KSQKCgoxLiBHZW5lcmF0ZSAkbj01MDAkIG9ic2VydmF0aW9ucyAkKFhfMSxZXzEpLFxkb3RzLChYX24sWV9uKSQgYWNjb3JkaW5nIHRvIHRoZSBtb2RlbCBhYm92ZS4KCjIuIFJlcHJlc2VudCBvbiBhIGdyYXBoIGJvdGggdGhlIHNhbXBsZSBhbmQgdGhlIHNpbmUgZnVuY3Rpb24uCgozLiBGaXQgYSBrZXJuZWwgZXN0aW1hdGUgb24gYSB0cmFpbiBkYXRhc2V0IG9mIHNpemUgMzAwIHdpdGggYmFuZHdpZHRoICRoPTAuNSQgKHVzZSAqKmxvY3BvbHkqKiBmdW5jdGlvbiBmcm9tICoqS2VyblNtb290aCoqIHBhY2thZ2UpLiBBZGQgdGhlIGtlcm5lbCBlc3RpbWF0ZSBvbiB0aGUgcHJldmlvdXMgZ3JhcGhlLgoKNC4gQWRkIHRoZSBrZXJuZWwgZXN0aW1hdGVzIHdpdGggYmFuZHdpZHRocyAkaF8yPTMkIGFuZCAkaF8zPTAuMDEkIChhbHdheXMgZml0dGVkIG9uIHRoZSB0cmFpbiBzYW1wbGUpLgoKNS4gVXNlIHRoZSB0ZXN0IHNhbXBsZSB0byBlc3RpbWF0ZSB0aGUgbWVhbiBzcXVhcmUgZXJyb3Igb2YgdGhlIHRocmVlIGtlcm5lbCBlc3RpbWF0ZXMuIFlvdSBjYW4gdXNlIHRoZSAqKmtzbW9vdGgqKiBmdW5jdGlvbi4KCiMjIEV4ZXJjaXNlIDUgKEVSTSB3aXRoIGNhcmV0KQoKCldlIGFnYWluIGNvbnNpZGVyIHRoZSBkYXRhc2V0IG9mIGV4ZXJjaXNlIDEuCmBgYHtyfQpkaW0obXlfZGF0YSkKc2V0LnNlZWQoMTIzKQpwZXJtIDwtIHNhbXBsZShucm93KG15X2RhdGEpKQp0cmFpbiA8LSBteV9kYXRhICU+JSBzbGljZShwZXJtWzE6NzUwXSkKdGVzdCA8LSBteV9kYXRhICU+JSBzbGljZShwZXJtWzc1MToxMDAwXSkKCmRpbSh0cmFpbikKZGltKHRlc3QpCmBgYApUaGUgZ29hbCBpcyB0byBmaW5kIHRoZSBiZXN0IGludGVnZXIgJGskIGZvciB0aGUgJGskLW5lYXJlc3QgbmVpZ2hib3IgcnVsZS4KCjEuIEZpdCB0aGUgMyBuZWFyZXN0LW5laWdoYm9yIHJ1bGUgJFx3aWRlaGF0IGdfMyQgb24gdGhlIHRyYWluIHNhbXBsZSBhbmQgZXN0aW1hdGUgaXRzIGVycm9yIHByb2JhYmlsaXR5IAokJEwoXHdpZGVoYXQgZ18zKT1ccHJvYihcd2lkZWhhdCBnXzMoWClcbmVxIFkpJCQKYnkgdmFsaWRhdGlvbiBob2xkIGhvdXQgKHdpdGggdGhlIHRlc3Qgc2FtcGxlKS4gVXNlICoqa25uKiogZnVuY3Rpb24gZnJvbSAqKmNsYXNzKiogcGFja2FnZS4KCjIuIEVzdGltYXRlIHRoZSBlcnJvciBwcm9iYWJpbGl0eSBmb3IgZWFjaCB2YWx1ZSBvZiAkayQgaW4gJFx7MSxcZG90cyw0NTBcfSQuIFlvdSBjYW4gdXNlIGEgbG9vcCAqKmZvcioqOgoKMy4gUmVwcmVzZW50IHRoZSBlcnJvciBvbiBhIGdyYXBoOiAkayQgb24gdGhlICR4JC1heGlzLCBlc3RpbWF0ZWQgZXJyb3Igb24gdGhlICR5JC1heGlzLgoKNC4gUnVuIHRoZSBzaGlueSB3ZWIgYXBwbGljYXRpb24gaW4gdGhlIGZpbGUgKipvdmVyZml0dGluZ19hcHAuUioqLiBFeHBsYWluIHRoZSByZXN1bHRzLgoKNS4gV2UgcHJvcG9zZSB0byB1c2UgKipjYXJldCoqIHBhY2thZ2UgdG8gc2VsZWN0IHRoZSBiZXN0ICRrJC4gV2UgY2FuIGxvb2sgYXQgIDxodHRwOi8vdG9wZXBvLmdpdGh1Yi5pby9jYXJldC9pbmRleC5odG1sPiBmb3IgYSBwcmVzZW50YXRpb24gb2YgdGhlIHBhY2thZ2UuIEV4cGxhaW4gb3V0cHV0cyBvZiB0aGUgY29tbWFuZHM6CgoKYGBge3J9CiNjdHJsMSA8LSB0cmFpbkNvbnRyb2wobWV0aG9kPSJMR09DViIsbnVtYmVyPTEsaW5kZXg9bGlzdCgxOjE1MDApKQpjdHJsMSA8LSB0cmFpbkNvbnRyb2wobWV0aG9kPSJMR09DViIsbnVtYmVyPTEpCmdyaWQuayA8LSBkYXRhLmZyYW1lKGs9c2VxKDEsMTAwLGJ5PTEpKQpzZWwuayA8LSB0cmFpbihZfi4sZGF0YT1teV9kYXRhLG1ldGhvZD0ia25uIix0ckNvbnRyb2w9Y3RybDEsdHVuZUdyaWQ9Z3JpZC5rKQpzZWwuawpwbG90KHNlbC5rKQpgYGAKCjYuIERvIHRoZSBzYW1lIHdpdGggNTAwIG9ic2VydmF0aW9ucyBpbiB0aGUgdHJhaW4gZGF0YXNldCBhbmQgNTAwIG9ic2VydmF0aW9ucyBpbiB0aGUgdGVzdCBkYXRhc2V0LgoKNy4gU2VsZWN0ICRrJCBieSAxMCBmb2xkcyBjcm9zcy12YWxpZGF0aW9uLgoKCioqUmVtYXJrKio6IFdlIGNhbiB1c2UgdGhlICoqZG9NQyoqIHBhY2thZ2UgdG8gcGFyYWxsZWxpemUgY3Jvc3MtdmFsaWRhdGlvbjogCgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KGRvTUMpCmRldGVjdENvcmVzKCkKYGBgCgoKYGBge3J9CmN0cmw1IDwtIHRyYWluQ29udHJvbChtZXRob2Q9ImN2IixudW1iZXI9NTApCnJlZ2lzdGVyRG9NQyhjb3JlcyA9IDEpCnN5c3RlbS50aW1lKHNlbDUuayA8LSB0cmFpbihZfi4sZGF0YT1teV9kYXRhLG1ldGhvZD0ia25uIix0ckNvbnRyb2w9Y3RybDUsdHVuZUdyaWQ9Z3JpZC5rKSkKCnJlZ2lzdGVyRG9NQyhjb3JlcyA9IDUpCnN5c3RlbS50aW1lKHNlbDUuayA8LSB0cmFpbihZfi4sZGF0YT1teV9kYXRhLG1ldGhvZD0ia25uIix0ckNvbnRyb2w9Y3RybDUsdHVuZUdyaWQ9Z3JpZC5rKSkKYGBgCgoKOC4gRXhwbGFpbiBvdXRwdXRzIG9mIHRoZXNlIGNvbW1hbmRzLgoKYGBge3J9CmRhdGExIDwtIG15X2RhdGEKbmFtZXMoZGF0YTEpWzNdIDwtIGMoIkNsYXNzIikKbGV2ZWxzKGRhdGExJENsYXNzKSA8LSBjKCJHMCIsIkcxIikKY3RybDExIDwtIHRyYWluQ29udHJvbChtZXRob2Q9IkxHT0NWIixudW1iZXI9MSxpbmRleD1saXN0KDE6NzUwKSxjbGFzc1Byb2JzPVRSVUUsc3VtbWFyeT10d29DbGFzc1N1bW1hcnkscD0wLjY2KQphYSA8LSB0cmFpbihDbGFzc34uLGRhdGE9ZGF0YTEsbWV0aG9kPSJrbm4iLHRyQ29udHJvbD1jdHJsMTEsbWV0cmljPSJST0MiLHR1bmVHcmlkPWdyaWQuaykKYWEKZ2V0VHJhaW5QZXJmKGFhKQpgYGAKCldlIGNvbnNpZGVyIEFVQyBpbnN0ZWFkIG9mIHRoZSBlcnJvciBwcm9iYWJpbGl0eSAoY2hhbmdlIG9mIGNyaXRlcmlvbikuCgo=