Part 1: Linear Regression

####Part 1: EXPLAIN THE DIFFERENCES WITH THE CHALLENGER 1 VS CHALLENGER 2

Understanding regression

#We can say that this new document is worst in terms of results. This is not a usual lenear model. #The variables are more but since they are not relative between each other and there is not a real regression. #As the professor added more data we have data that we can tell that is not worth it for this problem. #We can get into the conclurion that that challenger 1 is more effective than number 2

## Example: Space Shuttle Launch Data
launch <- read.csv("challenger2.csv")
# estimate beta manually
b <- cov(launch$temperature, launch$distress_ct) / var(launch$temperature)
b
[1] -0.03364796

#The result is worst than the previous that we got.

# estimate alpha manually
a <- mean(launch$distress_ct) - b * mean(launch$temperature)
a
[1] 2.814585
# calculate the correlation of launch data
r <- cov(launch$temperature, launch$distress_ct) /
       (sd(launch$temperature) * sd(launch$distress_ct))
r
[1] -0.3359996
cor(launch$temperature, launch$distress_ct)
[1] -0.3359996
# computing the slope using correlation
r * (sd(launch$distress_ct) / sd(launch$temperature))
[1] -0.03364796
# confirming the regression line using the lm function (not in text)
model <- lm(distress_ct ~ temperature, data = launch)
model

Call:
lm(formula = distress_ct ~ temperature, data = launch)

Coefficients:
(Intercept)  temperature  
    2.81458     -0.03365  
summary(model)

Call:
lm(formula = distress_ct ~ temperature, data = launch)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.0649 -0.4929 -0.2573  0.3052  1.7090 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)  
(Intercept)  2.81458    1.24629   2.258   0.0322 *
temperature -0.03365    0.01815  -1.854   0.0747 .
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.7076 on 27 degrees of freedom
Multiple R-squared:  0.1129,    Adjusted R-squared:  0.08004 
F-statistic: 3.436 on 1 and 27 DF,  p-value: 0.07474
# creating a simple multiple regression function
reg <- function(y, x) {
  x <- as.matrix(x)
  x <- cbind(Intercept = 1, x)
  b <- solve(t(x) %*% x) %*% t(x) %*% y
  colnames(b) <- "estimate"
  print(b)
}
# examine the launch data
str(launch)
'data.frame':   29 obs. of  4 variables:
 $ distress_ct         : int  0 1 0 0 0 0 0 0 1 1 ...
 $ temperature         : int  66 70 69 68 67 72 73 70 57 63 ...
 $ field_check_pressure: int  50 50 50 50 50 50 100 100 200 200 ...
 $ flight_num          : int  1 2 3 4 5 6 7 8 9 10 ...
# test regression model with simple linear regression
reg(y = launch$distress_ct, x = launch[2])
               estimate
Intercept    2.81458456
temperature -0.03364796
# use regression model with multiple regression
reg(y = launch$distress_ct, x = launch[2:4])
                          estimate
Intercept             2.239817e+00
temperature          -3.124185e-02
field_check_pressure -2.586765e-05
flight_num            2.762455e-02
# confirming the multiple regression result using the lm function (not in text)
model <- lm(distress_ct ~ temperature + field_check_pressure + flight_num, data = launch)
model

Call:
lm(formula = distress_ct ~ temperature + field_check_pressure + 
    flight_num, data = launch)

Coefficients:
         (Intercept)           temperature  field_check_pressure            flight_num  
           2.240e+00            -3.124e-02            -2.587e-05             2.762e-02  

Predicting Medical Expenses

## Step 2: Exploring and preparing the data ----
insurance <- read.csv("insurance.csv", stringsAsFactors = TRUE)
str(insurance)
'data.frame':   1338 obs. of  7 variables:
 $ age     : int  19 18 28 33 32 31 46 37 37 60 ...
 $ sex     : Factor w/ 2 levels "female","male": 1 2 2 2 2 1 1 1 2 1 ...
 $ bmi     : num  27.9 33.8 33 22.7 28.9 25.7 33.4 27.7 29.8 25.8 ...
 $ children: int  0 1 3 0 0 0 1 3 2 0 ...
 $ smoker  : Factor w/ 2 levels "no","yes": 2 1 1 1 1 1 1 1 1 1 ...
 $ region  : Factor w/ 4 levels "northeast","northwest",..: 4 3 3 2 2 3 3 2 1 2 ...
 $ expenses: num  16885 1726 4449 21984 3867 ...
# summarize the charges variable
summary(insurance$expenses)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   1122    4740    9382   13270   16640   63770 
# histogram of insurance charges
hist(insurance$expenses)

# table of region
table(insurance$region)

northeast northwest southeast southwest 
      324       325       364       325 
# exploring relationships among features: correlation matrix
cor(insurance[c("age", "bmi", "children", "expenses")])
               age        bmi   children   expenses
age      1.0000000 0.10934101 0.04246900 0.29900819
bmi      0.1093410 1.00000000 0.01264471 0.19857626
children 0.0424690 0.01264471 1.00000000 0.06799823
expenses 0.2990082 0.19857626 0.06799823 1.00000000
# visualing relationships among features: scatterplot matrix
pairs(insurance[c("age", "bmi", "children", "expenses")])

## Step 3: Training a model on the data ----
ins_model <- lm(expenses ~ age + children + bmi + sex + smoker + region,
                data = insurance)
ins_model <- lm(expenses ~ ., data = insurance) # this is equivalent to above

# see the estimated beta coefficients
ins_model

Call:
lm(formula = expenses ~ ., data = insurance)

Coefficients:
    (Intercept)              age          sexmale              bmi         children        smokeryes  
       -11941.6            256.8           -131.4            339.3            475.7          23847.5  
regionnorthwest  regionsoutheast  regionsouthwest  
         -352.8          -1035.6           -959.3  

Step 4: Evaluating model performance

# see more detail about the estimated beta coefficients
summary(ins_model)

Call:
lm(formula = expenses ~ ., data = insurance)

Residuals:
     Min       1Q   Median       3Q      Max 
-11302.7  -2850.9   -979.6   1383.9  29981.7 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     -11941.6      987.8 -12.089  < 2e-16 ***
age                256.8       11.9  21.586  < 2e-16 ***
sexmale           -131.3      332.9  -0.395 0.693255    
bmi                339.3       28.6  11.864  < 2e-16 ***
children           475.7      137.8   3.452 0.000574 ***
smokeryes        23847.5      413.1  57.723  < 2e-16 ***
regionnorthwest   -352.8      476.3  -0.741 0.458976    
regionsoutheast  -1035.6      478.7  -2.163 0.030685 *  
regionsouthwest   -959.3      477.9  -2.007 0.044921 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 6062 on 1329 degrees of freedom
Multiple R-squared:  0.7509,    Adjusted R-squared:  0.7494 
F-statistic: 500.9 on 8 and 1329 DF,  p-value: < 2.2e-16

Step 5: Improving model performance

# add a higher-order "age" term
insurance$age2 <- insurance$age^2
# add an indicator for BMI >= 30
insurance$bmi30 <- ifelse(insurance$bmi >= 30, 1, 0)
# create final model
ins_model2 <- lm(expenses ~ age + age2 + children + bmi + sex +
                   bmi30*smoker + region, data = insurance)
summary(ins_model2)

Call:
lm(formula = expenses ~ age + age2 + children + bmi + sex + bmi30 * 
    smoker + region, data = insurance)

Residuals:
     Min       1Q   Median       3Q      Max 
-17297.1  -1656.0  -1262.7   -727.8  24161.6 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       139.0053  1363.1359   0.102 0.918792    
age               -32.6181    59.8250  -0.545 0.585690    
age2                3.7307     0.7463   4.999 6.54e-07 ***
children          678.6017   105.8855   6.409 2.03e-10 ***
bmi               119.7715    34.2796   3.494 0.000492 ***
sexmale          -496.7690   244.3713  -2.033 0.042267 *  
bmi30            -997.9355   422.9607  -2.359 0.018449 *  
smokeryes       13404.5952   439.9591  30.468  < 2e-16 ***
regionnorthwest  -279.1661   349.2826  -0.799 0.424285    
regionsoutheast  -828.0345   351.6484  -2.355 0.018682 *  
regionsouthwest -1222.1619   350.5314  -3.487 0.000505 ***
bmi30:smokeryes 19810.1534   604.6769  32.762  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 4445 on 1326 degrees of freedom
Multiple R-squared:  0.8664,    Adjusted R-squared:  0.8653 
F-statistic: 781.7 on 11 and 1326 DF,  p-value: < 2.2e-16
# making predictions with the regression model
insurance$pred <- predict(ins_model2, insurance)
cor(insurance$pred, insurance$expenses)
[1] 0.9307999
plot(insurance$pred, insurance$expenses)
abline(a = 0, b = 1, col = "red", lwd = 3, lty = 2)
predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "male", bmi30 = 1,
                   smoker = "no", region = "northeast"))
       1 
5973.774 
predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))
       1 
6470.543 
predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 0,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))
      1 
5113.34 

Part 2: Regression Trees and Model Trees

Understanding regression trees and model trees

Example: Calculating SDR

# set up the data
tee <- c(1, 1, 1, 2, 2, 3, 4, 5, 5, 6, 6, 7, 7, 7, 7)
at1 <- c(1, 1, 1, 2, 2, 3, 4, 5, 5)
at2 <- c(6, 6, 7, 7, 7, 7)
bt1 <- c(1, 1, 1, 2, 2, 3, 4)
bt2 <- c(5, 5, 6, 6, 7, 7, 7, 7)
# compute the SDR
sdr_a <- sd(tee) - (length(at1) / length(tee) * sd(at1) + length(at2) / length(tee) * sd(at2))
sdr_b <- sd(tee) - (length(bt1) / length(tee) * sd(bt1) + length(bt2) / length(tee) * sd(bt2))
# compare the SDR for each split
sdr_a
[1] 1.202815
sdr_b
[1] 1.392751

Exercise No 3: Estimating Wine Quality

Step 2: Exploring and preparing the data

wine <- read.csv("whitewines.csv")
# examine the wine data
str(wine)
'data.frame':   4898 obs. of  12 variables:
 $ fixed.acidity       : num  6.7 5.7 5.9 5.3 6.4 7 7.9 6.6 7 6.5 ...
 $ volatile.acidity    : num  0.62 0.22 0.19 0.47 0.29 0.14 0.12 0.38 0.16 0.37 ...
 $ citric.acid         : num  0.24 0.2 0.26 0.1 0.21 0.41 0.49 0.28 0.3 0.33 ...
 $ residual.sugar      : num  1.1 16 7.4 1.3 9.65 0.9 5.2 2.8 2.6 3.9 ...
 $ chlorides           : num  0.039 0.044 0.034 0.036 0.041 0.037 0.049 0.043 0.043 0.027 ...
 $ free.sulfur.dioxide : num  6 41 33 11 36 22 33 17 34 40 ...
 $ total.sulfur.dioxide: num  62 113 123 74 119 95 152 67 90 130 ...
 $ density             : num  0.993 0.999 0.995 0.991 0.993 ...
 $ pH                  : num  3.41 3.22 3.49 3.48 2.99 3.25 3.18 3.21 2.88 3.28 ...
 $ sulphates           : num  0.32 0.46 0.42 0.54 0.34 0.43 0.47 0.47 0.47 0.39 ...
 $ alcohol             : num  10.4 8.9 10.1 11.2 10.9 ...
 $ quality             : int  5 6 6 4 6 6 6 6 6 7 ...
# the distribution of quality ratings
hist(wine$quality)

# summary statistics of the wine data
summary(wine)
 fixed.acidity    volatile.acidity  citric.acid     residual.sugar     chlorides       free.sulfur.dioxide
 Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.600   Min.   :0.00900   Min.   :  2.00     
 1st Qu.: 6.300   1st Qu.:0.2100   1st Qu.:0.2700   1st Qu.: 1.700   1st Qu.:0.03600   1st Qu.: 23.00     
 Median : 6.800   Median :0.2600   Median :0.3200   Median : 5.200   Median :0.04300   Median : 34.00     
 Mean   : 6.855   Mean   :0.2782   Mean   :0.3342   Mean   : 6.391   Mean   :0.04577   Mean   : 35.31     
 3rd Qu.: 7.300   3rd Qu.:0.3200   3rd Qu.:0.3900   3rd Qu.: 9.900   3rd Qu.:0.05000   3rd Qu.: 46.00     
 Max.   :14.200   Max.   :1.1000   Max.   :1.6600   Max.   :65.800   Max.   :0.34600   Max.   :289.00     
 total.sulfur.dioxide    density             pH          sulphates         alcohol         quality     
 Min.   :  9.0        Min.   :0.9871   Min.   :2.720   Min.   :0.2200   Min.   : 8.00   Min.   :3.000  
 1st Qu.:108.0        1st Qu.:0.9917   1st Qu.:3.090   1st Qu.:0.4100   1st Qu.: 9.50   1st Qu.:5.000  
 Median :134.0        Median :0.9937   Median :3.180   Median :0.4700   Median :10.40   Median :6.000  
 Mean   :138.4        Mean   :0.9940   Mean   :3.188   Mean   :0.4898   Mean   :10.51   Mean   :5.878  
 3rd Qu.:167.0        3rd Qu.:0.9961   3rd Qu.:3.280   3rd Qu.:0.5500   3rd Qu.:11.40   3rd Qu.:6.000  
 Max.   :440.0        Max.   :1.0390   Max.   :3.820   Max.   :1.0800   Max.   :14.20   Max.   :9.000  
wine_train <- wine[1:3750, ]
wine_test <- wine[3751:4898, ]

Step 3: Training a model on the data

# regression tree using rpart
library(rpart)
m.rpart <- rpart(quality ~ ., data = wine_train)
# get basic information about the tree
m.rpart
n= 3750 

node), split, n, deviance, yval
      * denotes terminal node

 1) root 3750 2945.53200 5.870933  
   2) alcohol< 10.85 2372 1418.86100 5.604975  
     4) volatile.acidity>=0.2275 1611  821.30730 5.432030  
       8) volatile.acidity>=0.3025 688  278.97670 5.255814 *
       9) volatile.acidity< 0.3025 923  505.04230 5.563380 *
     5) volatile.acidity< 0.2275 761  447.36400 5.971091 *
   3) alcohol>=10.85 1378 1070.08200 6.328737  
     6) free.sulfur.dioxide< 10.5 84   95.55952 5.369048 *
     7) free.sulfur.dioxide>=10.5 1294  892.13600 6.391036  
      14) alcohol< 11.76667 629  430.11130 6.173291  
        28) volatile.acidity>=0.465 11   10.72727 4.545455 *
        29) volatile.acidity< 0.465 618  389.71680 6.202265 *
      15) alcohol>=11.76667 665  403.99400 6.596992 *
# get more detailed information about the tree
summary(m.rpart)
Call:
rpart(formula = quality ~ ., data = wine_train)
  n= 3750 

          CP nsplit rel error    xerror       xstd
1 0.15501053      0 1.0000000 1.0006015 0.02445529
2 0.05098911      1 0.8449895 0.8498773 0.02342953
3 0.02796998      2 0.7940004 0.8032331 0.02271648
4 0.01970128      3 0.7660304 0.7722064 0.02131921
5 0.01265926      4 0.7463291 0.7565898 0.02066583
6 0.01007193      5 0.7336698 0.7511867 0.02056388
7 0.01000000      6 0.7235979 0.7445897 0.02033262

Variable importance
             alcohol              density     volatile.acidity            chlorides total.sulfur.dioxide 
                  34                   21                   15                   11                    7 
 free.sulfur.dioxide       residual.sugar            sulphates          citric.acid 
                   6                    3                    1                    1 

Node number 1: 3750 observations,    complexity param=0.1550105
  mean=5.870933, MSE=0.7854751 
  left son=2 (2372 obs) right son=3 (1378 obs)
  Primary splits:
      alcohol              < 10.85    to the left,  improve=0.15501050, (0 missing)
      density              < 0.992035 to the right, improve=0.10915940, (0 missing)
      chlorides            < 0.0395   to the right, improve=0.07682258, (0 missing)
      total.sulfur.dioxide < 158.5    to the right, improve=0.04089663, (0 missing)
      citric.acid          < 0.235    to the left,  improve=0.03636458, (0 missing)
  Surrogate splits:
      density              < 0.991995 to the right, agree=0.869, adj=0.644, (0 split)
      chlorides            < 0.0375   to the right, agree=0.757, adj=0.339, (0 split)
      total.sulfur.dioxide < 103.5    to the right, agree=0.690, adj=0.155, (0 split)
      residual.sugar       < 5.375    to the right, agree=0.667, adj=0.094, (0 split)
      sulphates            < 0.345    to the right, agree=0.647, adj=0.038, (0 split)

Node number 2: 2372 observations,    complexity param=0.05098911
  mean=5.604975, MSE=0.5981709 
  left son=4 (1611 obs) right son=5 (761 obs)
  Primary splits:
      volatile.acidity    < 0.2275   to the right, improve=0.10585250, (0 missing)
      free.sulfur.dioxide < 13.5     to the left,  improve=0.03390500, (0 missing)
      citric.acid         < 0.235    to the left,  improve=0.03204075, (0 missing)
      alcohol             < 10.11667 to the left,  improve=0.03136524, (0 missing)
      chlorides           < 0.0585   to the right, improve=0.01633599, (0 missing)
  Surrogate splits:
      pH                   < 3.485    to the left,  agree=0.694, adj=0.047, (0 split)
      sulphates            < 0.755    to the left,  agree=0.685, adj=0.020, (0 split)
      total.sulfur.dioxide < 105.5    to the right, agree=0.683, adj=0.011, (0 split)
      residual.sugar       < 0.75     to the right, agree=0.681, adj=0.007, (0 split)
      chlorides            < 0.0285   to the right, agree=0.680, adj=0.003, (0 split)

Node number 3: 1378 observations,    complexity param=0.02796998
  mean=6.328737, MSE=0.7765472 
  left son=6 (84 obs) right son=7 (1294 obs)
  Primary splits:
      free.sulfur.dioxide  < 10.5     to the left,  improve=0.07699080, (0 missing)
      alcohol              < 11.76667 to the left,  improve=0.06210660, (0 missing)
      total.sulfur.dioxide < 67.5     to the left,  improve=0.04438619, (0 missing)
      residual.sugar       < 1.375    to the left,  improve=0.02905351, (0 missing)
      fixed.acidity        < 7.35     to the right, improve=0.02613259, (0 missing)
  Surrogate splits:
      total.sulfur.dioxide < 53.5     to the left,  agree=0.952, adj=0.214, (0 split)
      volatile.acidity     < 0.875    to the right, agree=0.940, adj=0.024, (0 split)

Node number 4: 1611 observations,    complexity param=0.01265926
  mean=5.43203, MSE=0.5098121 
  left son=8 (688 obs) right son=9 (923 obs)
  Primary splits:
      volatile.acidity    < 0.3025   to the right, improve=0.04540111, (0 missing)
      alcohol             < 10.05    to the left,  improve=0.03874403, (0 missing)
      free.sulfur.dioxide < 13.5     to the left,  improve=0.03338886, (0 missing)
      chlorides           < 0.0495   to the right, improve=0.02574623, (0 missing)
      citric.acid         < 0.195    to the left,  improve=0.02327981, (0 missing)
  Surrogate splits:
      citric.acid          < 0.215    to the left,  agree=0.633, adj=0.141, (0 split)
      free.sulfur.dioxide  < 20.5     to the left,  agree=0.600, adj=0.063, (0 split)
      chlorides            < 0.0595   to the right, agree=0.593, adj=0.047, (0 split)
      residual.sugar       < 1.15     to the left,  agree=0.583, adj=0.023, (0 split)
      total.sulfur.dioxide < 219.25   to the right, agree=0.582, adj=0.022, (0 split)

Node number 5: 761 observations
  mean=5.971091, MSE=0.5878633 

Node number 6: 84 observations
  mean=5.369048, MSE=1.137613 

Node number 7: 1294 observations,    complexity param=0.01970128
  mean=6.391036, MSE=0.6894405 
  left son=14 (629 obs) right son=15 (665 obs)
  Primary splits:
      alcohol              < 11.76667 to the left,  improve=0.06504696, (0 missing)
      chlorides            < 0.0395   to the right, improve=0.02758705, (0 missing)
      fixed.acidity        < 7.35     to the right, improve=0.02750932, (0 missing)
      pH                   < 3.055    to the left,  improve=0.02307356, (0 missing)
      total.sulfur.dioxide < 191.5    to the right, improve=0.02186818, (0 missing)
  Surrogate splits:
      density              < 0.990885 to the right, agree=0.720, adj=0.424, (0 split)
      volatile.acidity     < 0.2675   to the left,  agree=0.637, adj=0.253, (0 split)
      chlorides            < 0.0365   to the right, agree=0.630, adj=0.238, (0 split)
      residual.sugar       < 1.475    to the left,  agree=0.575, adj=0.126, (0 split)
      total.sulfur.dioxide < 128.5    to the right, agree=0.574, adj=0.124, (0 split)

Node number 8: 688 observations
  mean=5.255814, MSE=0.4054895 

Node number 9: 923 observations
  mean=5.56338, MSE=0.5471747 

Node number 14: 629 observations,    complexity param=0.01007193
  mean=6.173291, MSE=0.6838017 
  left son=28 (11 obs) right son=29 (618 obs)
  Primary splits:
      volatile.acidity     < 0.465    to the right, improve=0.06897561, (0 missing)
      total.sulfur.dioxide < 200      to the right, improve=0.04223066, (0 missing)
      residual.sugar       < 0.975    to the left,  improve=0.03061714, (0 missing)
      fixed.acidity        < 7.35     to the right, improve=0.02978501, (0 missing)
      sulphates            < 0.575    to the left,  improve=0.02165970, (0 missing)
  Surrogate splits:
      citric.acid          < 0.045    to the left,  agree=0.986, adj=0.182, (0 split)
      total.sulfur.dioxide < 279.25   to the right, agree=0.986, adj=0.182, (0 split)

Node number 15: 665 observations
  mean=6.596992, MSE=0.6075098 

Node number 28: 11 observations
  mean=4.545455, MSE=0.9752066 

Node number 29: 618 observations
  mean=6.202265, MSE=0.6306098 
install.packages("rpart.plot")
WARNING: Rtools is required to build R packages but is not currently installed. Please download and install the appropriate version of Rtools before proceeding:

https://cran.rstudio.com/bin/windows/Rtools/
Installing package into ‘C:/Users/n0898873/AppData/Local/R/win-library/4.2’
(as ‘lib’ is unspecified)
trying URL 'https://cran.rstudio.com/bin/windows/contrib/4.2/rpart.plot_3.1.1.zip'
Content type 'application/zip' length 1035186 bytes (1010 KB)
downloaded 1010 KB
package ‘rpart.plot’ successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\n0898873\AppData\Local\Temp\RtmpqIsQTp\downloaded_packages
# use the rpart.plot package to create a visualization
library(rpart.plot)
# a basic decision tree diagram
rpart.plot(m.rpart, digits = 3)
# a few adjustments to the diagram
rpart.plot(m.rpart, digits = 4, fallen.leaves = TRUE, type = 3, extra = 101)

Step 4: Evaluate model performanc

# generate predictions for the testing dataset
p.rpart <- predict(m.rpart, wine_test)
# compare the distribution of predicted values vs. actual values
summary(p.rpart)
summary(wine_test$quality)
# compare the correlation
cor(p.rpart, wine_test$quality)
# function to calculate the mean absolute error
MAE <- function(actual, predicted) {
  mean(abs(actual - predicted))  
}
# mean absolute error between predicted and actual values
MAE(p.rpart, wine_test$quality)
# mean absolute error between actual values and mean value
mean(wine_train$quality) # result = 5.87
MAE(5.87, wine_test$quality)

Step 5: Improving model performance

#install.packages("plyr")
#install.packages("Cubist")
# train a Cubist Model Tree
library(Cubist)
m.cubist <- cubist(x = wine_train[-12], y = wine_train$quality)
# display basic information about the model tree
m.cubist
# display the tree itself
summary(m.cubist)
# generate predictions for the model
p.cubist <- predict(m.cubist, wine_test)
# summary statistics about the predictions
summary(p.cubist)
# correlation between the predicted and true values
cor(p.cubist, wine_test$quality)
# mean absolute error of predicted and true values
# (uses a custom function defined above)
MAE(wine_test$quality, p.cubist) 
LS0tDQp0aXRsZTogIkNoYXB0ZXIgNjogUmVncmVzc2lvbiBNZXRob2RzIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KDQojIyMjIFBhcnQgMTogTGluZWFyIFJlZ3Jlc3Npb24NCg0KIyMjI1BhcnQgMTogRVhQTEFJTiBUSEUgRElGRkVSRU5DRVMgV0lUSCBUSEUgQ0hBTExFTkdFUiAxIFZTIENIQUxMRU5HRVIgMg0KDQoNCiMjIFVuZGVyc3RhbmRpbmcgcmVncmVzc2lvbg0KDQojV2UgY2FuIHNheSB0aGF0IHRoaXMgbmV3IGRvY3VtZW50IGlzIHdvcnN0IGluIHRlcm1zIG9mIHJlc3VsdHMuIFRoaXMgaXMgbm90IGEgdXN1YWwgbGVuZWFyIG1vZGVsLg0KI1RoZSB2YXJpYWJsZXMgYXJlIG1vcmUgYnV0IHNpbmNlIHRoZXkgYXJlIG5vdCByZWxhdGl2ZSBiZXR3ZWVuIGVhY2ggb3RoZXIgYW5kIHRoZXJlIGlzIG5vdCBhIHJlYWwgcmVncmVzc2lvbi4NCiNBcyB0aGUgcHJvZmVzc29yIGFkZGVkIG1vcmUgZGF0YSB3ZSBoYXZlIGRhdGEgdGhhdCB3ZSBjYW4gdGVsbCB0aGF0IGlzIG5vdCB3b3J0aCBpdCBmb3IgdGhpcyBwcm9ibGVtLg0KI1dlIGNhbiBnZXQgaW50byB0aGUgY29uY2x1cmlvbiB0aGF0IHRoYXQgY2hhbGxlbmdlciAxIGlzIG1vcmUgZWZmZWN0aXZlIHRoYW4gbnVtYmVyIDINCg0KYGBge3J9DQojIyBFeGFtcGxlOiBTcGFjZSBTaHV0dGxlIExhdW5jaCBEYXRhDQpsYXVuY2ggPC0gcmVhZC5jc3YoImNoYWxsZW5nZXIyLmNzdiIpDQpgYGANCg0KDQpgYGB7cn0NCiMgZXN0aW1hdGUgYmV0YSBtYW51YWxseQ0KYiA8LSBjb3YobGF1bmNoJHRlbXBlcmF0dXJlLCBsYXVuY2gkZGlzdHJlc3NfY3QpIC8gdmFyKGxhdW5jaCR0ZW1wZXJhdHVyZSkNCmINCmBgYA0KI1RoZSByZXN1bHQgaXMgd29yc3QgdGhhbiB0aGUgcHJldmlvdXMgdGhhdCB3ZSBnb3QuIA0KDQpgYGB7cn0NCiMgZXN0aW1hdGUgYWxwaGEgbWFudWFsbHkNCmEgPC0gbWVhbihsYXVuY2gkZGlzdHJlc3NfY3QpIC0gYiAqIG1lYW4obGF1bmNoJHRlbXBlcmF0dXJlKQ0KYQ0KYGBgDQoNCg0KDQpgYGB7cn0NCiMgY2FsY3VsYXRlIHRoZSBjb3JyZWxhdGlvbiBvZiBsYXVuY2ggZGF0YQ0KciA8LSBjb3YobGF1bmNoJHRlbXBlcmF0dXJlLCBsYXVuY2gkZGlzdHJlc3NfY3QpIC8NCiAgICAgICAoc2QobGF1bmNoJHRlbXBlcmF0dXJlKSAqIHNkKGxhdW5jaCRkaXN0cmVzc19jdCkpDQpyDQpgYGANCg0KDQpgYGB7cn0NCmNvcihsYXVuY2gkdGVtcGVyYXR1cmUsIGxhdW5jaCRkaXN0cmVzc19jdCkNCmBgYA0KDQoNCg0KDQpgYGB7cn0NCiMgY29tcHV0aW5nIHRoZSBzbG9wZSB1c2luZyBjb3JyZWxhdGlvbg0KciAqIChzZChsYXVuY2gkZGlzdHJlc3NfY3QpIC8gc2QobGF1bmNoJHRlbXBlcmF0dXJlKSkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBjb25maXJtaW5nIHRoZSByZWdyZXNzaW9uIGxpbmUgdXNpbmcgdGhlIGxtIGZ1bmN0aW9uIChub3QgaW4gdGV4dCkNCm1vZGVsIDwtIGxtKGRpc3RyZXNzX2N0IH4gdGVtcGVyYXR1cmUsIGRhdGEgPSBsYXVuY2gpDQptb2RlbA0KYGBgDQoNCg0KDQpgYGB7cn0NCnN1bW1hcnkobW9kZWwpDQpgYGANCg0KDQpgYGB7cn0NCiMgY3JlYXRpbmcgYSBzaW1wbGUgbXVsdGlwbGUgcmVncmVzc2lvbiBmdW5jdGlvbg0KcmVnIDwtIGZ1bmN0aW9uKHksIHgpIHsNCiAgeCA8LSBhcy5tYXRyaXgoeCkNCiAgeCA8LSBjYmluZChJbnRlcmNlcHQgPSAxLCB4KQ0KICBiIDwtIHNvbHZlKHQoeCkgJSolIHgpICUqJSB0KHgpICUqJSB5DQogIGNvbG5hbWVzKGIpIDwtICJlc3RpbWF0ZSINCiAgcHJpbnQoYikNCn0NCmBgYA0KDQoNCg0KDQpgYGB7cn0NCiMgZXhhbWluZSB0aGUgbGF1bmNoIGRhdGENCnN0cihsYXVuY2gpDQpgYGANCg0KDQoNCmBgYHtyfQ0KIyB0ZXN0IHJlZ3Jlc3Npb24gbW9kZWwgd2l0aCBzaW1wbGUgbGluZWFyIHJlZ3Jlc3Npb24NCnJlZyh5ID0gbGF1bmNoJGRpc3RyZXNzX2N0LCB4ID0gbGF1bmNoWzJdKQ0KYGBgDQoNCg0KYGBge3J9DQojIHVzZSByZWdyZXNzaW9uIG1vZGVsIHdpdGggbXVsdGlwbGUgcmVncmVzc2lvbg0KcmVnKHkgPSBsYXVuY2gkZGlzdHJlc3NfY3QsIHggPSBsYXVuY2hbMjo0XSkNCmBgYA0KDQoNCg0KYGBge3J9DQojIGNvbmZpcm1pbmcgdGhlIG11bHRpcGxlIHJlZ3Jlc3Npb24gcmVzdWx0IHVzaW5nIHRoZSBsbSBmdW5jdGlvbiAobm90IGluIHRleHQpDQptb2RlbCA8LSBsbShkaXN0cmVzc19jdCB+IHRlbXBlcmF0dXJlICsgZmllbGRfY2hlY2tfcHJlc3N1cmUgKyBmbGlnaHRfbnVtLCBkYXRhID0gbGF1bmNoKQ0KbW9kZWwNCmBgYA0KDQoNCiMjIFByZWRpY3RpbmcgTWVkaWNhbCBFeHBlbnNlcw0KDQpgYGB7cn0NCiMjIFN0ZXAgMjogRXhwbG9yaW5nIGFuZCBwcmVwYXJpbmcgdGhlIGRhdGEgLS0tLQ0KaW5zdXJhbmNlIDwtIHJlYWQuY3N2KCJpbnN1cmFuY2UuY3N2Iiwgc3RyaW5nc0FzRmFjdG9ycyA9IFRSVUUpDQpzdHIoaW5zdXJhbmNlKQ0KYGBgDQoNCg0KDQpgYGB7cn0NCiMgc3VtbWFyaXplIHRoZSBjaGFyZ2VzIHZhcmlhYmxlDQpzdW1tYXJ5KGluc3VyYW5jZSRleHBlbnNlcykNCmBgYA0KDQoNCmBgYHtyfQ0KIyBoaXN0b2dyYW0gb2YgaW5zdXJhbmNlIGNoYXJnZXMNCmhpc3QoaW5zdXJhbmNlJGV4cGVuc2VzKQ0KYGBgDQoNCg0KDQpgYGB7cn0NCiMgdGFibGUgb2YgcmVnaW9uDQp0YWJsZShpbnN1cmFuY2UkcmVnaW9uKQ0KYGBgDQoNCg0KDQpgYGB7cn0NCiMgZXhwbG9yaW5nIHJlbGF0aW9uc2hpcHMgYW1vbmcgZmVhdHVyZXM6IGNvcnJlbGF0aW9uIG1hdHJpeA0KY29yKGluc3VyYW5jZVtjKCJhZ2UiLCAiYm1pIiwgImNoaWxkcmVuIiwgImV4cGVuc2VzIildKQ0KYGBgDQoNCg0KYGBge3J9DQojIHZpc3VhbGluZyByZWxhdGlvbnNoaXBzIGFtb25nIGZlYXR1cmVzOiBzY2F0dGVycGxvdCBtYXRyaXgNCnBhaXJzKGluc3VyYW5jZVtjKCJhZ2UiLCAiYm1pIiwgImNoaWxkcmVuIiwgImV4cGVuc2VzIildKQ0KYGBgDQoNCg0KDQoNCmBgYHtyfQ0KIyMgU3RlcCAzOiBUcmFpbmluZyBhIG1vZGVsIG9uIHRoZSBkYXRhIC0tLS0NCmluc19tb2RlbCA8LSBsbShleHBlbnNlcyB+IGFnZSArIGNoaWxkcmVuICsgYm1pICsgc2V4ICsgc21va2VyICsgcmVnaW9uLA0KICAgICAgICAgICAgICAgIGRhdGEgPSBpbnN1cmFuY2UpDQppbnNfbW9kZWwgPC0gbG0oZXhwZW5zZXMgfiAuLCBkYXRhID0gaW5zdXJhbmNlKSAjIHRoaXMgaXMgZXF1aXZhbGVudCB0byBhYm92ZQ0KDQojIHNlZSB0aGUgZXN0aW1hdGVkIGJldGEgY29lZmZpY2llbnRzDQppbnNfbW9kZWwNCmBgYA0KDQoNCiMjIFN0ZXAgNDogRXZhbHVhdGluZyBtb2RlbCBwZXJmb3JtYW5jZQ0KDQpgYGB7cn0NCiMgc2VlIG1vcmUgZGV0YWlsIGFib3V0IHRoZSBlc3RpbWF0ZWQgYmV0YSBjb2VmZmljaWVudHMNCnN1bW1hcnkoaW5zX21vZGVsKQ0KYGBgDQoNCg0KIyMgU3RlcCA1OiBJbXByb3ZpbmcgbW9kZWwgcGVyZm9ybWFuY2UNCg0KDQoNCmBgYHtyfQ0KIyBhZGQgYSBoaWdoZXItb3JkZXIgImFnZSIgdGVybQ0KaW5zdXJhbmNlJGFnZTIgPC0gaW5zdXJhbmNlJGFnZV4yDQpgYGANCg0KDQoNCmBgYHtyfQ0KIyBhZGQgYW4gaW5kaWNhdG9yIGZvciBCTUkgPj0gMzANCmluc3VyYW5jZSRibWkzMCA8LSBpZmVsc2UoaW5zdXJhbmNlJGJtaSA+PSAzMCwgMSwgMCkNCmBgYA0KDQoNCg0KYGBge3J9DQojIGNyZWF0ZSBmaW5hbCBtb2RlbA0KaW5zX21vZGVsMiA8LSBsbShleHBlbnNlcyB+IGFnZSArIGFnZTIgKyBjaGlsZHJlbiArIGJtaSArIHNleCArDQogICAgICAgICAgICAgICAgICAgYm1pMzAqc21va2VyICsgcmVnaW9uLCBkYXRhID0gaW5zdXJhbmNlKQ0KYGBgDQoNCg0KYGBge3J9DQpzdW1tYXJ5KGluc19tb2RlbDIpDQpgYGANCg0KDQpgYGB7cn0NCiMgbWFraW5nIHByZWRpY3Rpb25zIHdpdGggdGhlIHJlZ3Jlc3Npb24gbW9kZWwNCmluc3VyYW5jZSRwcmVkIDwtIHByZWRpY3QoaW5zX21vZGVsMiwgaW5zdXJhbmNlKQ0KY29yKGluc3VyYW5jZSRwcmVkLCBpbnN1cmFuY2UkZXhwZW5zZXMpDQpgYGANCg0KDQoNCmBgYHtyfQ0KcGxvdChpbnN1cmFuY2UkcHJlZCwgaW5zdXJhbmNlJGV4cGVuc2VzKQ0KYWJsaW5lKGEgPSAwLCBiID0gMSwgY29sID0gInJlZCIsIGx3ZCA9IDMsIGx0eSA9IDIpDQpgYGANCg0KDQoNCg0KYGBge3J9DQpwcmVkaWN0KGluc19tb2RlbDIsDQogICAgICAgIGRhdGEuZnJhbWUoYWdlID0gMzAsIGFnZTIgPSAzMF4yLCBjaGlsZHJlbiA9IDIsDQogICAgICAgICAgICAgICAgICAgYm1pID0gMzAsIHNleCA9ICJtYWxlIiwgYm1pMzAgPSAxLA0KICAgICAgICAgICAgICAgICAgIHNtb2tlciA9ICJubyIsIHJlZ2lvbiA9ICJub3J0aGVhc3QiKSkNCmBgYA0KDQoNCmBgYHtyfQ0KcHJlZGljdChpbnNfbW9kZWwyLA0KICAgICAgICBkYXRhLmZyYW1lKGFnZSA9IDMwLCBhZ2UyID0gMzBeMiwgY2hpbGRyZW4gPSAyLA0KICAgICAgICAgICAgICAgICAgIGJtaSA9IDMwLCBzZXggPSAiZmVtYWxlIiwgYm1pMzAgPSAxLA0KICAgICAgICAgICAgICAgICAgIHNtb2tlciA9ICJubyIsIHJlZ2lvbiA9ICJub3J0aGVhc3QiKSkNCmBgYA0KDQoNCmBgYHtyfQ0KcHJlZGljdChpbnNfbW9kZWwyLA0KICAgICAgICBkYXRhLmZyYW1lKGFnZSA9IDMwLCBhZ2UyID0gMzBeMiwgY2hpbGRyZW4gPSAwLA0KICAgICAgICAgICAgICAgICAgIGJtaSA9IDMwLCBzZXggPSAiZmVtYWxlIiwgYm1pMzAgPSAxLA0KICAgICAgICAgICAgICAgICAgIHNtb2tlciA9ICJubyIsIHJlZ2lvbiA9ICJub3J0aGVhc3QiKSkNCmBgYA0KDQoNCg0KIyMjIyBQYXJ0IDI6IFJlZ3Jlc3Npb24gVHJlZXMgYW5kIE1vZGVsIFRyZWVzDQoNCiMjIFVuZGVyc3RhbmRpbmcgcmVncmVzc2lvbiB0cmVlcyBhbmQgbW9kZWwgdHJlZXMNCg0KIyMgRXhhbXBsZTogQ2FsY3VsYXRpbmcgU0RSDQoNCmBgYHtyfQ0KIyBzZXQgdXAgdGhlIGRhdGENCnRlZSA8LSBjKDEsIDEsIDEsIDIsIDIsIDMsIDQsIDUsIDUsIDYsIDYsIDcsIDcsIDcsIDcpDQphdDEgPC0gYygxLCAxLCAxLCAyLCAyLCAzLCA0LCA1LCA1KQ0KYXQyIDwtIGMoNiwgNiwgNywgNywgNywgNykNCmJ0MSA8LSBjKDEsIDEsIDEsIDIsIDIsIDMsIDQpDQpidDIgPC0gYyg1LCA1LCA2LCA2LCA3LCA3LCA3LCA3KQ0KYGBgDQoNCg0KDQoNCmBgYHtyfQ0KIyBjb21wdXRlIHRoZSBTRFINCnNkcl9hIDwtIHNkKHRlZSkgLSAobGVuZ3RoKGF0MSkgLyBsZW5ndGgodGVlKSAqIHNkKGF0MSkgKyBsZW5ndGgoYXQyKSAvIGxlbmd0aCh0ZWUpICogc2QoYXQyKSkNCnNkcl9iIDwtIHNkKHRlZSkgLSAobGVuZ3RoKGJ0MSkgLyBsZW5ndGgodGVlKSAqIHNkKGJ0MSkgKyBsZW5ndGgoYnQyKSAvIGxlbmd0aCh0ZWUpICogc2QoYnQyKSkNCmBgYA0KDQoNCg0KYGBge3J9DQojIGNvbXBhcmUgdGhlIFNEUiBmb3IgZWFjaCBzcGxpdA0Kc2RyX2ENCnNkcl9iDQpgYGANCg0KDQoNCiMjIEV4ZXJjaXNlIE5vIDM6IEVzdGltYXRpbmcgV2luZSBRdWFsaXR5DQoNCg0KIyMgU3RlcCAyOiBFeHBsb3JpbmcgYW5kIHByZXBhcmluZyB0aGUgZGF0YQ0KDQpgYGB7cn0NCndpbmUgPC0gcmVhZC5jc3YoIndoaXRld2luZXMuY3N2IikNCmBgYA0KDQoNCg0KYGBge3J9DQojIGV4YW1pbmUgdGhlIHdpbmUgZGF0YQ0Kc3RyKHdpbmUpDQpgYGANCg0KDQpgYGB7cn0NCiMgdGhlIGRpc3RyaWJ1dGlvbiBvZiBxdWFsaXR5IHJhdGluZ3MNCmhpc3Qod2luZSRxdWFsaXR5KQ0KYGBgDQoNCg0KYGBge3J9DQojIHN1bW1hcnkgc3RhdGlzdGljcyBvZiB0aGUgd2luZSBkYXRhDQpzdW1tYXJ5KHdpbmUpDQpgYGANCg0KDQoNCmBgYHtyfQ0Kd2luZV90cmFpbiA8LSB3aW5lWzE6Mzc1MCwgXQ0Kd2luZV90ZXN0IDwtIHdpbmVbMzc1MTo0ODk4LCBdDQpgYGANCg0KDQoNCiMjIFN0ZXAgMzogVHJhaW5pbmcgYSBtb2RlbCBvbiB0aGUgZGF0YQ0KDQpgYGB7cn0NCiMgcmVncmVzc2lvbiB0cmVlIHVzaW5nIHJwYXJ0DQpsaWJyYXJ5KHJwYXJ0KQ0KbS5ycGFydCA8LSBycGFydChxdWFsaXR5IH4gLiwgZGF0YSA9IHdpbmVfdHJhaW4pDQpgYGANCg0KDQpgYGB7cn0NCiMgZ2V0IGJhc2ljIGluZm9ybWF0aW9uIGFib3V0IHRoZSB0cmVlDQptLnJwYXJ0DQpgYGANCg0KDQoNCmBgYHtyfQ0KIyBnZXQgbW9yZSBkZXRhaWxlZCBpbmZvcm1hdGlvbiBhYm91dCB0aGUgdHJlZQ0Kc3VtbWFyeShtLnJwYXJ0KQ0KYGBgDQoNCg0KYGBge3J9DQppbnN0YWxsLnBhY2thZ2VzKCJycGFydC5wbG90IikNCmBgYA0KDQoNCmBgYHtyfQ0KIyB1c2UgdGhlIHJwYXJ0LnBsb3QgcGFja2FnZSB0byBjcmVhdGUgYSB2aXN1YWxpemF0aW9uDQpsaWJyYXJ5KHJwYXJ0LnBsb3QpDQpgYGANCg0KDQpgYGB7cn0NCiMgYSBiYXNpYyBkZWNpc2lvbiB0cmVlIGRpYWdyYW0NCnJwYXJ0LnBsb3QobS5ycGFydCwgZGlnaXRzID0gMykNCmBgYA0KDQoNCmBgYHtyfQ0KIyBhIGZldyBhZGp1c3RtZW50cyB0byB0aGUgZGlhZ3JhbQ0KcnBhcnQucGxvdChtLnJwYXJ0LCBkaWdpdHMgPSA0LCBmYWxsZW4ubGVhdmVzID0gVFJVRSwgdHlwZSA9IDMsIGV4dHJhID0gMTAxKQ0KYGBgDQoNCg0KIyMgU3RlcCA0OiBFdmFsdWF0ZSBtb2RlbCBwZXJmb3JtYW5jDQoNCmBgYHtyfQ0KIyBnZW5lcmF0ZSBwcmVkaWN0aW9ucyBmb3IgdGhlIHRlc3RpbmcgZGF0YXNldA0KcC5ycGFydCA8LSBwcmVkaWN0KG0ucnBhcnQsIHdpbmVfdGVzdCkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBjb21wYXJlIHRoZSBkaXN0cmlidXRpb24gb2YgcHJlZGljdGVkIHZhbHVlcyB2cy4gYWN0dWFsIHZhbHVlcw0Kc3VtbWFyeShwLnJwYXJ0KQ0Kc3VtbWFyeSh3aW5lX3Rlc3QkcXVhbGl0eSkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBjb21wYXJlIHRoZSBjb3JyZWxhdGlvbg0KY29yKHAucnBhcnQsIHdpbmVfdGVzdCRxdWFsaXR5KQ0KYGBgDQoNCg0KYGBge3J9DQojIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSB0aGUgbWVhbiBhYnNvbHV0ZSBlcnJvcg0KTUFFIDwtIGZ1bmN0aW9uKGFjdHVhbCwgcHJlZGljdGVkKSB7DQogIG1lYW4oYWJzKGFjdHVhbCAtIHByZWRpY3RlZCkpICANCn0NCmBgYA0KDQoNCg0KYGBge3J9DQojIG1lYW4gYWJzb2x1dGUgZXJyb3IgYmV0d2VlbiBwcmVkaWN0ZWQgYW5kIGFjdHVhbCB2YWx1ZXMNCk1BRShwLnJwYXJ0LCB3aW5lX3Rlc3QkcXVhbGl0eSkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBtZWFuIGFic29sdXRlIGVycm9yIGJldHdlZW4gYWN0dWFsIHZhbHVlcyBhbmQgbWVhbiB2YWx1ZQ0KbWVhbih3aW5lX3RyYWluJHF1YWxpdHkpICMgcmVzdWx0ID0gNS44Nw0KTUFFKDUuODcsIHdpbmVfdGVzdCRxdWFsaXR5KQ0KYGBgDQoNCg0KIyMgU3RlcCA1OiBJbXByb3ZpbmcgbW9kZWwgcGVyZm9ybWFuY2UNCg0KYGBge3J9DQojaW5zdGFsbC5wYWNrYWdlcygicGx5ciIpDQojaW5zdGFsbC5wYWNrYWdlcygiQ3ViaXN0IikNCmBgYA0KDQoNCmBgYHtyfQ0KIyB0cmFpbiBhIEN1YmlzdCBNb2RlbCBUcmVlDQpsaWJyYXJ5KEN1YmlzdCkNCm0uY3ViaXN0IDwtIGN1YmlzdCh4ID0gd2luZV90cmFpblstMTJdLCB5ID0gd2luZV90cmFpbiRxdWFsaXR5KQ0KYGBgDQoNCg0KYGBge3J9DQojIGRpc3BsYXkgYmFzaWMgaW5mb3JtYXRpb24gYWJvdXQgdGhlIG1vZGVsIHRyZWUNCm0uY3ViaXN0DQpgYGANCg0KDQoNCmBgYHtyfQ0KIyBkaXNwbGF5IHRoZSB0cmVlIGl0c2VsZg0Kc3VtbWFyeShtLmN1YmlzdCkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBnZW5lcmF0ZSBwcmVkaWN0aW9ucyBmb3IgdGhlIG1vZGVsDQpwLmN1YmlzdCA8LSBwcmVkaWN0KG0uY3ViaXN0LCB3aW5lX3Rlc3QpDQpgYGANCg0KDQpgYGB7cn0NCiMgc3VtbWFyeSBzdGF0aXN0aWNzIGFib3V0IHRoZSBwcmVkaWN0aW9ucw0Kc3VtbWFyeShwLmN1YmlzdCkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBjb3JyZWxhdGlvbiBiZXR3ZWVuIHRoZSBwcmVkaWN0ZWQgYW5kIHRydWUgdmFsdWVzDQpjb3IocC5jdWJpc3QsIHdpbmVfdGVzdCRxdWFsaXR5KQ0KYGBgDQoNCg0KYGBge3J9DQojIG1lYW4gYWJzb2x1dGUgZXJyb3Igb2YgcHJlZGljdGVkIGFuZCB0cnVlIHZhbHVlcw0KIyAodXNlcyBhIGN1c3RvbSBmdW5jdGlvbiBkZWZpbmVkIGFib3ZlKQ0KTUFFKHdpbmVfdGVzdCRxdWFsaXR5LCBwLmN1YmlzdCkgDQpgYGANCg0KDQoNCg==