library(tidyverse)

Exercise 1: Hypothesis testing

Similarly to dataset mtcars, the dataset mpg from ggplot package includes data on automobiles. However, mpg includes data for newer cars from year 1999 and 2008. The variables measured for each car is slighly different. Here we are interested in the variable, hwy, the highway miles per gallon.

# We first format the column trans to contain only info on transmission auto/manual
mpg
mpg <- mpg %>% 
  mutate(
    transmission = factor(
        gsub("\\((.*)", "", trans), levels = c("auto", "manual"))
  )
mpg

Part 1: One-sample test

  1. Subset the mpg dataset to inlude only cars from year 2008.
mpg2008 <- mpg %>% 
  filter(year == 2008)
  1. Test whether cars from 2008 have mean the highway miles per gallon, hwy, equal to 30 mpg.
t.test(mpg2008$hwy, mu = 30, alternative = "two.sided")

    One Sample t-test

data:  mpg2008$hwy
t = -12.11, df = 116, p-value < 2.2e-16
alternative hypothesis: true mean is not equal to 30
95 percent confidence interval:
 22.38218 24.52380
sample estimates:
mean of x 
 23.45299
  1. Test whether cars from 2008 with 4 cylinders have mean hwy equal to 30 mpg.
mpg2008_4cyl <- mpg %>% 
  filter(year == 2008, cyl == 4)
t.test(mpg2008_4cyl$hwy, mu = 30, alternative = "two.sided")

    One Sample t-test

data:  mpg2008_4cyl$hwy
t = -1.1492, df = 35, p-value = 0.2582
alternative hypothesis: true mean is not equal to 30
95 percent confidence interval:
 28.15568 30.51098
sample estimates:
mean of x 
 29.33333

Part 2: Two-sample test

  1. Test if the mean hwy for automatic is less than that for manual cars in 2008. Generate a boxplot with jittered points for hwy for each transmission group.
t.test(data = mpg2008, hwy ~ transmission, alternative = "less")

    Welch Two Sample t-test

data:  hwy by transmission
t = -3.1269, df = 64.928, p-value = 0.001322
alternative hypothesis: true difference in means is less than 0
95 percent confidence interval:
      -Inf -1.635703
sample estimates:
  mean in group auto mean in group manual 
            22.43373             25.94118 
# or
# t.test(x = mpg2008 %>% filter(transmission == "auto") %>% pull(hwy),
#        y = mpg2008 %>% filter(transmission == "manual") %>% pull(hwy), 
#        alternative = "less")
ggplot(mpg2008, aes(x = transmission, y = hwy)) +
  geom_boxplot() + geom_jitter(height = 0, width = 0.2)

  1. Test if the mean hwy for cars from 1999 and is greater than that for cars from 2008. Generate a boxplot with jittered points for hwy for each year group.
t.test(data = mpg, hwy ~ year, alternative = "greater")

    Welch Two Sample t-test

data:  hwy by year
t = -0.032864, df = 231.64, p-value = 0.5131
alternative hypothesis: true difference in means is greater than 0
95 percent confidence interval:
 -1.314123       Inf
sample estimates:
mean in group 1999 mean in group 2008 
          23.42735           23.45299 
ggplot(mpg, aes(x = factor(year), y = hwy)) +
  geom_boxplot() + geom_jitter(height = 0, width = 0.2)

Exercise 2: Logistic Regression

In this you will use a dataset Default, on customer default records for a credit card company, which is included in ISL book. To obtain the data you will need to install a package ISLR.

# install.packages("ISLR")
library(ISLR)
(Default <- tbl_df(Default))
  1. First, divide your dataset into a train and test set. Randomly sample 6000 observations and include them in the train set, and the remaining use as a test set.
train.idx <- sample(1:nrow(Default), 6000, replace = FALSE)
train <- Default[train.idx, ]
test <- Default[-train.idx, ]
  1. Fit a logistic regression including all the features to predict whether a customer defaulted or not.
fit.logit <- glm(default ~ student + balance + income, data = train, 
                 family = "binomial")
summary(fit.logit)

Call:
glm(formula = default ~ student + balance + income, family = "binomial", 
    data = train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2577  -0.1408  -0.0541  -0.0200   3.7847  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -1.074e+01  6.418e-01 -16.739   <2e-16 ***
studentYes  -4.658e-01  3.097e-01  -1.504    0.133    
balance      5.738e-03  3.066e-04  18.716   <2e-16 ***
income      -3.509e-06  1.112e-05  -0.316    0.752    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1658.42  on 5999  degrees of freedom
Residual deviance:  903.93  on 5996  degrees of freedom
AIC: 911.93

Number of Fisher Scoring iterations: 8
  1. Note if any variables seem not significant. Then, adjust your model accordingly (by removing them).
fit.logit <- glm(default ~ student + balance, data = train, 
                 family = "binomial")
summary(fit.logit)

Call:
glm(formula = default ~ student + balance, family = "binomial", 
    data = train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2420  -0.1412  -0.0541  -0.0201   3.7776  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -10.874551   0.490137 -22.187   <2e-16 ***
studentYes   -0.388055   0.188726  -2.056   0.0398 *  
balance       0.005733   0.000306  18.737   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1658.42  on 5999  degrees of freedom
Residual deviance:  904.03  on 5997  degrees of freedom
AIC: 910.03

Number of Fisher Scoring iterations: 8
  1. Compute the predicted probabilities of ‘default’ for the observations in the test set. Then evaluate the model accuracy.
pred.prob.default <- predict(fit.logit, test, type = "response")
pred.default <- factor(pred.prob.default > 0.5, levels = c(FALSE, TRUE),
                       labels = c( "No", "Yes"))
(tab <- table(pred = pred.default, true = test$default))
     true
pred    No  Yes
  No  3833  102
  Yes   20   45
(accuracy <- sum(diag(tab))/nrow(test))
[1] 0.9695
  1. For the test set, generate a scatterplot of ‘balance’ vs ‘default’ with points colored by ‘student’ factor. Then, overlay a line plot of the predicted probability of default as computed in the previous question. You should plot two lines for student and non student separately by setting the ‘color = student’.
train$default.numeric <- as.numeric(train$default) - 1
test$default.numeric <- as.numeric(test$default) - 1
ggplot(test, aes(x = balance, color = student)) +
  geom_point(aes(y = default.numeric)) + 
  geom_line(aes(y = pred.prob.default), lwd = 1)

Exercise 3: Random Forest

In this exercise we will build a random forest model based on the data used to create the visualization here.

# Skip first 2 lines since they were comments
url <- paste0("https://raw.githubusercontent.com/jadeyee/r2d3-part-1-data/",
              "master/part_1_data.csv")
houses <- read.csv(url, skip = 2)
houses <- tbl_df(houses)
houses <- houses %>%
    mutate(city = factor(in_sf, levels = c(1, 0), labels = c("SF", "NYC")))
houses
  1. Using pairs() function plot the relationship between every variable pairs. You can color the points by the city the observation corresponds to; set the color argument in pairs() as follows: col = houses$in_sf + 3L
city.colors <- houses$in_sf + 3L
pairs(houses[, -1], col = city.colors, pch = 16)

  1. Split the data into (70%-30%) train and test set. How many observations are in your train and test sets?
set.seed(123)
train.idx <- sample(nrow(houses), 0.7 * nrow(houses))
train <- houses[train.idx, ]
test <- houses[-train.idx, ]
dim(train)
[1] 344   9
dim(test)
[1] 148   9
  1. Train a random forest on the train set, using all the variables in the model, to classify houses into the ones from San Francisco and from New York. Remember to remove ‘in_sf’, as it is the same variable as ‘city’.
library(randomForest)
randomForest 4.6-14
Type rfNews() to see new features/changes/bug fixes.

Attaching package: ‘randomForest’

The following object is masked from ‘package:dplyr’:

    combine

The following object is masked from ‘package:ggplot2’:

    margin
houses.rf <- randomForest(city ~ . -in_sf, data = train, importance = TRUE, proximity = TRUE)
houses.rf

Call:
 randomForest(formula = city ~ . - in_sf, data = train, importance = TRUE,      proximity = TRUE) 
               Type of random forest: classification
                     Number of trees: 500
No. of variables tried at each split: 2

        OOB estimate of  error rate: 7.56%
Confusion matrix:
     SF NYC class.error
SF  161  17  0.09550562
NYC   9 157  0.05421687
  1. Compute predictions and print out the confusion (error) matrix for the test set to asses the model accuracy. Also, compute the model accuracy.
pred <- predict(houses.rf, newdata = test)
(confusion.mat <- table(pred, truth = test$city))
     truth
pred  SF NYC
  SF  77   9
  NYC 13  49
(accuracy <- sum(diag(confusion.mat))/nrow(test))
[1] 0.8513514
  1. Which features were the most predictive for classifying houses into SF vs NYC groups? Use importance measures to answer the question.
varImpPlot(houses.rf)

LS0tCnRpdGxlOiAiTGVjdHVyZSA3OiBFeGVyY2lzZXMgd2l0aCBBbnN3ZXJzIgpkYXRlOiBPY3RvYmVyIDE4dGgsIDIwMTgKb3V0cHV0OiAKICBodG1sX25vdGVib29rOgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKLS0tCgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmBgYAoKCiMgRXhlcmNpc2UgMTogSHlwb3RoZXNpcyB0ZXN0aW5nCgpTaW1pbGFybHkgdG8gZGF0YXNldCBgbXRjYXJzYCwgdGhlIGRhdGFzZXQgYG1wZ2AgZnJvbSBgZ2dwbG90YCBwYWNrYWdlIAppbmNsdWRlcyBkYXRhIG9uIGF1dG9tb2JpbGVzLiBIb3dldmVyLCBgbXBnYCBpbmNsdWRlcyBkYXRhIGZvciBuZXdlcgpjYXJzIGZyb20geWVhciAxOTk5IGFuZCAyMDA4LiBUaGUgdmFyaWFibGVzIG1lYXN1cmVkIGZvciBlYWNoIGNhciBpcyBzbGlnaGx5IApkaWZmZXJlbnQuIEhlcmUgd2UgYXJlIGludGVyZXN0ZWQgaW4gdGhlIHZhcmlhYmxlLCBgaHd5YCwgdGhlIGhpZ2h3YXkgbWlsZXMgcGVyIApnYWxsb24uCgoKYGBge3J9CiMgV2UgZmlyc3QgZm9ybWF0IHRoZSBjb2x1bW4gdHJhbnMgdG8gY29udGFpbiBvbmx5IGluZm8gb24gdHJhbnNtaXNzaW9uIGF1dG8vbWFudWFsCm1wZwptcGcgPC0gbXBnICU+JSAKICBtdXRhdGUoCiAgICB0cmFuc21pc3Npb24gPSBmYWN0b3IoCiAgICAgICAgZ3N1YigiXFwoKC4qKSIsICIiLCB0cmFucyksIGxldmVscyA9IGMoImF1dG8iLCAibWFudWFsIikpCiAgKQptcGcKYGBgCgojIyBQYXJ0IDE6IE9uZS1zYW1wbGUgdGVzdAoKYS4gU3Vic2V0IHRoZSBgbXBnYCBkYXRhc2V0IHRvIGlubHVkZSBvbmx5IGNhcnMgZnJvbSAgeWVhciAyMDA4LgoKYGBge3J9Cm1wZzIwMDggPC0gbXBnICU+JSAKICBmaWx0ZXIoeWVhciA9PSAyMDA4KQpgYGAKCmIuIFRlc3Qgd2hldGhlciBjYXJzIGZyb20gMjAwOCBoYXZlIG1lYW4gdGhlIGhpZ2h3YXkgbWlsZXMgcGVyIGdhbGxvbiwgYGh3eWAsIAplcXVhbCB0byAzMCBtcGcuCgpgYGB7cn0KdC50ZXN0KG1wZzIwMDgkaHd5LCBtdSA9IDMwLCBhbHRlcm5hdGl2ZSA9ICJ0d28uc2lkZWQiKQpgYGAKCmMuIFRlc3Qgd2hldGhlciBjYXJzIGZyb20gMjAwOCB3aXRoIDQgY3lsaW5kZXJzIGhhdmUgbWVhbiBgaHd5YCBlcXVhbCB0byAzMCBtcGcuCgpgYGB7cn0KbXBnMjAwOF80Y3lsIDwtIG1wZyAlPiUgCiAgZmlsdGVyKHllYXIgPT0gMjAwOCwgY3lsID09IDQpCgp0LnRlc3QobXBnMjAwOF80Y3lsJGh3eSwgbXUgPSAzMCwgYWx0ZXJuYXRpdmUgPSAidHdvLnNpZGVkIikKYGBgCgojIyBQYXJ0IDI6IFR3by1zYW1wbGUgdGVzdAoKYS4gVGVzdCBpZiB0aGUgbWVhbiBgaHd5YCBmb3IgYXV0b21hdGljIGlzICoqbGVzcyB0aGFuKiogdGhhdCBmb3IgbWFudWFsIGNhcnMKKippbiAyMDA4KiouIEdlbmVyYXRlIGEgYm94cGxvdCB3aXRoIGppdHRlcmVkIHBvaW50cyBmb3IgYGh3eWAgZm9yIGVhY2ggCnRyYW5zbWlzc2lvbiBncm91cC4KCmBgYHtyfQp0LnRlc3QoZGF0YSA9IG1wZzIwMDgsIGh3eSB+IHRyYW5zbWlzc2lvbiwgYWx0ZXJuYXRpdmUgPSAibGVzcyIpCiMgb3IKIyB0LnRlc3QoeCA9IG1wZzIwMDggJT4lIGZpbHRlcih0cmFuc21pc3Npb24gPT0gImF1dG8iKSAlPiUgcHVsbChod3kpLAojICAgICAgICB5ID0gbXBnMjAwOCAlPiUgZmlsdGVyKHRyYW5zbWlzc2lvbiA9PSAibWFudWFsIikgJT4lIHB1bGwoaHd5KSwgCiMgICAgICAgIGFsdGVybmF0aXZlID0gImxlc3MiKQpgYGAKCmBgYHtyfQpnZ3Bsb3QobXBnMjAwOCwgYWVzKHggPSB0cmFuc21pc3Npb24sIHkgPSBod3kpKSArCiAgZ2VvbV9ib3hwbG90KCkgKyBnZW9tX2ppdHRlcihoZWlnaHQgPSAwLCB3aWR0aCA9IDAuMikKYGBgCgpiLiBUZXN0IGlmIHRoZSBtZWFuIGBod3lgIGZvciBjYXJzIGZyb20gMTk5OSBhbmQgaXMgZ3JlYXRlciB0aGFuIHRoYXQgZm9yCmNhcnMgZnJvbSAyMDA4LiBHZW5lcmF0ZSBhIGJveHBsb3Qgd2l0aCBqaXR0ZXJlZCBwb2ludHMKZm9yIGBod3lgIGZvciBlYWNoIHllYXIgZ3JvdXAuCgpgYGB7cn0KdC50ZXN0KGRhdGEgPSBtcGcsIGh3eSB+IHllYXIsIGFsdGVybmF0aXZlID0gImdyZWF0ZXIiKQpgYGAKCmBgYHtyfQpnZ3Bsb3QobXBnLCBhZXMoeCA9IGZhY3Rvcih5ZWFyKSwgeSA9IGh3eSkpICsKICBnZW9tX2JveHBsb3QoKSArIGdlb21faml0dGVyKGhlaWdodCA9IDAsIHdpZHRoID0gMC4yKQpgYGAKCgoKIyBFeGVyY2lzZSAyOiBMb2dpc3RpYyBSZWdyZXNzaW9uCgpJbiB0aGlzIHlvdSB3aWxsIHVzZSBhIGRhdGFzZXQgYERlZmF1bHRgLCBvbiBjdXN0b21lciBkZWZhdWx0IHJlY29yZHMgZm9yIAphIGNyZWRpdCBjYXJkIGNvbXBhbnksIHdoaWNoIGlzIGluY2x1ZGVkIGluIFtJU0wgYm9va10od3d3LnN0YXRsZWFybmluZy5jb20pLiAKVG8gb2J0YWluIHRoZSBkYXRhIHlvdSB3aWxsIG5lZWQgdG8gaW5zdGFsbCBhIHBhY2thZ2UgYElTTFJgLgoKYGBge3J9CiMgaW5zdGFsbC5wYWNrYWdlcygiSVNMUiIpCmxpYnJhcnkoSVNMUikKKERlZmF1bHQgPC0gdGJsX2RmKERlZmF1bHQpKQpgYGAKCgphLiBGaXJzdCwgZGl2aWRlIHlvdXIgZGF0YXNldCBpbnRvIGEgdHJhaW4gYW5kIHRlc3Qgc2V0LiBSYW5kb21seSBzYW1wbGUKNjAwMCBvYnNlcnZhdGlvbnMgYW5kIGluY2x1ZGUgdGhlbSBpbiB0aGUgdHJhaW4gc2V0LCBhbmQgdGhlIHJlbWFpbmluZyB1c2UKYXMgYSB0ZXN0IHNldC4KCmBgYHtyfQp0cmFpbi5pZHggPC0gc2FtcGxlKDE6bnJvdyhEZWZhdWx0KSwgNjAwMCwgcmVwbGFjZSA9IEZBTFNFKQp0cmFpbiA8LSBEZWZhdWx0W3RyYWluLmlkeCwgXQp0ZXN0IDwtIERlZmF1bHRbLXRyYWluLmlkeCwgXQpgYGAKCmIuIEZpdCBhIGxvZ2lzdGljIHJlZ3Jlc3Npb24gaW5jbHVkaW5nIGFsbCB0aGUgZmVhdHVyZXMgdG8gcHJlZGljdAp3aGV0aGVyIGEgY3VzdG9tZXIgZGVmYXVsdGVkIG9yIG5vdC4KCmBgYHtyfQpmaXQubG9naXQgPC0gZ2xtKGRlZmF1bHQgfiBzdHVkZW50ICsgYmFsYW5jZSArIGluY29tZSwgZGF0YSA9IHRyYWluLCAKICAgICAgICAgICAgICAgICBmYW1pbHkgPSAiYmlub21pYWwiKQpzdW1tYXJ5KGZpdC5sb2dpdCkKYGBgCgpjLiBOb3RlIGlmIGFueSB2YXJpYWJsZXMgc2VlbSBub3Qgc2lnbmlmaWNhbnQuIFRoZW4sIGFkanVzdCB5b3VyIG1vZGVsCmFjY29yZGluZ2x5IChieSByZW1vdmluZyB0aGVtKS4KCmBgYHtyfQpmaXQubG9naXQgPC0gZ2xtKGRlZmF1bHQgfiBzdHVkZW50ICsgYmFsYW5jZSwgZGF0YSA9IHRyYWluLCAKICAgICAgICAgICAgICAgICBmYW1pbHkgPSAiYmlub21pYWwiKQpzdW1tYXJ5KGZpdC5sb2dpdCkKYGBgCgpkLiBDb21wdXRlIHRoZSBwcmVkaWN0ZWQgcHJvYmFiaWxpdGllcyBvZiAnZGVmYXVsdCcgZm9yIHRoZSBvYnNlcnZhdGlvbnMKaW4gdGhlIHRlc3Qgc2V0LiBUaGVuIGV2YWx1YXRlIHRoZSBtb2RlbCBhY2N1cmFjeS4KCmBgYHtyfQpwcmVkLnByb2IuZGVmYXVsdCA8LSBwcmVkaWN0KGZpdC5sb2dpdCwgdGVzdCwgdHlwZSA9ICJyZXNwb25zZSIpCnByZWQuZGVmYXVsdCA8LSBmYWN0b3IocHJlZC5wcm9iLmRlZmF1bHQgPiAwLjUsIGxldmVscyA9IGMoRkFMU0UsIFRSVUUpLAogICAgICAgICAgICAgICAgICAgICAgIGxhYmVscyA9IGMoICJObyIsICJZZXMiKSkKKHRhYiA8LSB0YWJsZShwcmVkID0gcHJlZC5kZWZhdWx0LCB0cnVlID0gdGVzdCRkZWZhdWx0KSkKKGFjY3VyYWN5IDwtIHN1bShkaWFnKHRhYikpL25yb3codGVzdCkpCmBgYAoKCmQuIEZvciB0aGUgdGVzdCBzZXQsIGdlbmVyYXRlIGEgc2NhdHRlcnBsb3Qgb2YgJ2JhbGFuY2UnIHZzICdkZWZhdWx0JyAKd2l0aCBwb2ludHMgY29sb3JlZCBieSAnc3R1ZGVudCcgZmFjdG9yLiBUaGVuLCBvdmVybGF5IGEgbGluZSBwbG90IApvZiB0aGUgcHJlZGljdGVkIHByb2JhYmlsaXR5IG9mIGRlZmF1bHQgYXMgY29tcHV0ZWQgaW4gdGhlIHByZXZpb3VzIHF1ZXN0aW9uLgpZb3Ugc2hvdWxkIHBsb3QgdHdvIGxpbmVzIGZvciBzdHVkZW50IGFuZCBub24gc3R1ZGVudCBzZXBhcmF0ZWx5IGJ5IHNldHRpbmcgCnRoZSAnY29sb3IgPSBzdHVkZW50Jy4KCgpgYGB7cn0KdHJhaW4kZGVmYXVsdC5udW1lcmljIDwtIGFzLm51bWVyaWModHJhaW4kZGVmYXVsdCkgLSAxCnRlc3QkZGVmYXVsdC5udW1lcmljIDwtIGFzLm51bWVyaWModGVzdCRkZWZhdWx0KSAtIDEKCmdncGxvdCh0ZXN0LCBhZXMoeCA9IGJhbGFuY2UsIGNvbG9yID0gc3R1ZGVudCkpICsKICBnZW9tX3BvaW50KGFlcyh5ID0gZGVmYXVsdC5udW1lcmljKSkgKyAKICBnZW9tX2xpbmUoYWVzKHkgPSBwcmVkLnByb2IuZGVmYXVsdCksIGx3ZCA9IDEpCmBgYAoKCgoKIyBFeGVyY2lzZSAzOiBSYW5kb20gRm9yZXN0CgpJbiB0aGlzIGV4ZXJjaXNlIHdlIHdpbGwgYnVpbGQgYSByYW5kb20gZm9yZXN0IG1vZGVsIGJhc2VkCm9uIHRoZSBkYXRhIHVzZWQgdG8gY3JlYXRlIHRoZSB2aXN1YWxpemF0aW9uIFtoZXJlXShodHRwOi8vd3d3LnIyZDMudXMvdmlzdWFsLWludHJvLXRvLW1hY2hpbmUtbGVhcm5pbmctcGFydC0xLykuCgpgYGB7cn0KIyBTa2lwIGZpcnN0IDIgbGluZXMgc2luY2UgdGhleSB3ZXJlIGNvbW1lbnRzCnVybCA8LSBwYXN0ZTAoImh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9qYWRleWVlL3IyZDMtcGFydC0xLWRhdGEvIiwKICAgICAgICAgICAgICAibWFzdGVyL3BhcnRfMV9kYXRhLmNzdiIpCmhvdXNlcyA8LSByZWFkLmNzdih1cmwsIHNraXAgPSAyKQpob3VzZXMgPC0gdGJsX2RmKGhvdXNlcykKaG91c2VzIDwtIGhvdXNlcyAlPiUKICAgIG11dGF0ZShjaXR5ID0gZmFjdG9yKGluX3NmLCBsZXZlbHMgPSBjKDEsIDApLCBsYWJlbHMgPSBjKCJTRiIsICJOWUMiKSkpCmhvdXNlcyAKYGBgCgphLiBVc2luZyBgcGFpcnMoKWAgZnVuY3Rpb24gcGxvdCB0aGUgcmVsYXRpb25zaGlwIGJldHdlZW4gZXZlcnkgdmFyaWFibGUgcGFpcnMuCllvdSBjYW4gY29sb3IgdGhlIHBvaW50cyBieSB0aGUgY2l0eSB0aGUgb2JzZXJ2YXRpb24gY29ycmVzcG9uZHMgdG87IHNldCB0aGUgY29sb3IgYXJndW1lbnQgCmluIGBwYWlycygpYCBhcyBmb2xsb3dzOiBgY29sID0gaG91c2VzJGluX3NmICsgM0xgIAoKYGBge3IsIGZpZy53aWR0aD04LCBmaWcuaGVpZ2h0PTd9CmNpdHkuY29sb3JzIDwtIGhvdXNlcyRpbl9zZiArIDNMCnBhaXJzKGhvdXNlc1ssIC0xXSwgY29sID0gY2l0eS5jb2xvcnMsIHBjaCA9IDE2KQpgYGAKCmIuIFNwbGl0IHRoZSBkYXRhIGludG8gKDcwJS0zMCUpIHRyYWluIGFuZCB0ZXN0IHNldC4KSG93IG1hbnkgb2JzZXJ2YXRpb25zIGFyZSBpbiB5b3VyIHRyYWluIGFuZCB0ZXN0IHNldHM/CgoKYGBge3J9CnNldC5zZWVkKDEyMykKdHJhaW4uaWR4IDwtIHNhbXBsZShucm93KGhvdXNlcyksIDAuNyAqIG5yb3coaG91c2VzKSkKdHJhaW4gPC0gaG91c2VzW3RyYWluLmlkeCwgXQp0ZXN0IDwtIGhvdXNlc1stdHJhaW4uaWR4LCBdCmRpbSh0cmFpbikKZGltKHRlc3QpCmBgYAoKYy4gVHJhaW4gYSByYW5kb20gZm9yZXN0IG9uIHRoZSB0cmFpbiBzZXQsIHVzaW5nIGFsbCB0aGUgdmFyaWFibGVzIGluIHRoZSBtb2RlbCwKdG8gY2xhc3NpZnkgaG91c2VzIGludG8gdGhlIG9uZXMgZnJvbSBTYW4gRnJhbmNpc2NvIGFuZCBmcm9tIE5ldyBZb3JrLgpSZW1lbWJlciB0byByZW1vdmUgJ2luX3NmJywgYXMgaXQgaXMgdGhlIHNhbWUgdmFyaWFibGUgYXMgJ2NpdHknLiAKCmBgYHtyfQpsaWJyYXJ5KHJhbmRvbUZvcmVzdCkKaG91c2VzLnJmIDwtIHJhbmRvbUZvcmVzdChjaXR5IH4gLiAtaW5fc2YsIGRhdGEgPSB0cmFpbiwgaW1wb3J0YW5jZSA9IFRSVUUsIHByb3hpbWl0eSA9IFRSVUUpCmhvdXNlcy5yZgpgYGAKCmQuIENvbXB1dGUgcHJlZGljdGlvbnMgYW5kIHByaW50IG91dCAKW3RoZSBjb25mdXNpb24gKGVycm9yKSBtYXRyaXhdKGh0dHBzOi8vZW4ud2lraXBlZGlhLm9yZy93aWtpL0NvbmZ1c2lvbl9tYXRyaXgpCmZvciB0aGUgdGVzdCBzZXQgdG8gYXNzZXMgdGhlIG1vZGVsIGFjY3VyYWN5LiBBbHNvLCBjb21wdXRlIHRoZSBtb2RlbCAKYWNjdXJhY3kuCgpgYGB7cn0KcHJlZCA8LSBwcmVkaWN0KGhvdXNlcy5yZiwgbmV3ZGF0YSA9IHRlc3QpCihjb25mdXNpb24ubWF0IDwtIHRhYmxlKHByZWQsIHRydXRoID0gdGVzdCRjaXR5KSkKKGFjY3VyYWN5IDwtIHN1bShkaWFnKGNvbmZ1c2lvbi5tYXQpKS9ucm93KHRlc3QpKQpgYGAKCmUuIFdoaWNoIGZlYXR1cmVzIHdlcmUgdGhlIG1vc3QgcHJlZGljdGl2ZSBmb3IgY2xhc3NpZnlpbmcgaG91c2VzIGludG8gU0YgdnMgTllDIGdyb3Vwcz8KVXNlIGltcG9ydGFuY2UgbWVhc3VyZXMgdG8gYW5zd2VyIHRoZSBxdWVzdGlvbi4KCmBgYHtyfQp2YXJJbXBQbG90KGhvdXNlcy5yZikKYGBgCgoKCgoKCg==