Paula Cazali

Fiabilidad

Ejercicios de la seccion 4.7 libro ISLR Aplicados

10. This question should be answered using the Weekly data set, which is part of the ISLR package. This data is similar in nature to the Smarket data from this chapter’s lab, except that it contains 1, 089 weekly returns for 21 years, from the beginning of 1990 to the end of 2010.

library(ISLR)

(a) Produce some numerical and graphical summaries of the Weekly data. Do there appear to be any patterns?

attach(Weekly)
summary(Weekly)
      Year           Lag1               Lag2               Lag3               Lag4               Lag5              Volume       
 Min.   :1990   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950   Min.   :0.08747  
 1st Qu.:1995   1st Qu.: -1.1540   1st Qu.: -1.1540   1st Qu.: -1.1580   1st Qu.: -1.1580   1st Qu.: -1.1660   1st Qu.:0.33202  
 Median :2000   Median :  0.2410   Median :  0.2410   Median :  0.2410   Median :  0.2380   Median :  0.2340   Median :1.00268  
 Mean   :2000   Mean   :  0.1506   Mean   :  0.1511   Mean   :  0.1472   Mean   :  0.1458   Mean   :  0.1399   Mean   :1.57462  
 3rd Qu.:2005   3rd Qu.:  1.4050   3rd Qu.:  1.4090   3rd Qu.:  1.4090   3rd Qu.:  1.4090   3rd Qu.:  1.4050   3rd Qu.:2.05373  
 Max.   :2010   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260   Max.   :9.32821  
     Today          Direction 
 Min.   :-18.1950   Down:484  
 1st Qu.: -1.1540   Up  :605  
 Median :  0.2410             
 Mean   :  0.1499             
 3rd Qu.:  1.4050             
 Max.   : 12.0260             

(b) Use the full data set to perform a logistic regression with Direction as the response and the five lag variables plus Volume as predictors. Use the summary function to print the results. Do any of the predictors appear to be statistically significant? If so, which ones?

fit_1b <- glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume, data=Weekly, family = binomial)
summary(fit_1b)

Call:
glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + 
    Volume, family = binomial, data = Weekly)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.6949  -1.2565   0.9913   1.0849   1.4579  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)   
(Intercept)  0.26686    0.08593   3.106   0.0019 **
Lag1        -0.04127    0.02641  -1.563   0.1181   
Lag2         0.05844    0.02686   2.175   0.0296 * 
Lag3        -0.01606    0.02666  -0.602   0.5469   
Lag4        -0.02779    0.02646  -1.050   0.2937   
Lag5        -0.01447    0.02638  -0.549   0.5833   
Volume      -0.02274    0.03690  -0.616   0.5377   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1496.2  on 1088  degrees of freedom
Residual deviance: 1486.4  on 1082  degrees of freedom
AIC: 1500.4

Number of Fisher Scoring iterations: 4

Por lo que se ve que Lag2 es la variable mas significativa.

(c) Compute the confusion matrix and overall fraction of correct predictions. Explain what the confusion matrix is telling you about the types of mistakes made by logistic regression.

probabilidades <- predict(fit_1b, type = "response")
predictions_1c <- rep("Down", length(probabilidades))
predictions_1c[probabilidades > 0.5] <- "Up" 
table(predictions_1c, Direction)
              Direction
predictions_1c Down  Up
          Down   54  48
          Up    430 557

Las estimaciones correctas son las que se encuentran en la diagonal principal de la matriz de confusion, por lo que predijo que 54 Downs eran Downs y 557 Ups eran Ups El total de posibilidades son:

length(predictions_1c)
[1] 1089

Por lo que el porcentaje de prediccion es de \(56.1\%\):

(54+557)/length(predictions_1c)*100
[1] 56.10652

(d) Now fit the logistic regression model using a training data period from 1990 to 2008, with Lag2 as the only predictor. Compute the confusion matrix and the overall fraction of correct predictions for the held out data (that is, the data from 2009 and 2010).

Dividiendo los datos en un set de train y en un set de test. Train tendra la informacion desde el año 1990 hasta el año 2008

train_index <- (Year < 2009)
test_weekly <- Weekly[!train_index,]

Como estamos prediciendo Direction guardamos solo el valor de las Directions en test_direction. Usamos solo la variable Lag2 para hacer la regresion logistica.

test_direction <- Direction[!train_index]
fit_1d <- glm(Direction ~ Lag2, 
              data = Weekly, 
              family = binomial,
              subset = train_index)
summary(fit_1d)

Call:
glm(formula = Direction ~ Lag2, family = binomial, data = Weekly, 
    subset = train_index)

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-1.536  -1.264   1.021   1.091   1.368  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)   
(Intercept)  0.20326    0.06428   3.162  0.00157 **
Lag2         0.05810    0.02870   2.024  0.04298 * 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1354.7  on 984  degrees of freedom
Residual deviance: 1350.5  on 983  degrees of freedom
AIC: 1354.5

Number of Fisher Scoring iterations: 4

Ahora obtenemos la matriz de confusion:

prob_1d <- predict(fit_1d,
                   test_weekly,
                   type = "response")
predictions_1d <- rep("Down", length(prob_1d))
predictions_1d[prob_1d > 0.5] <- "Up" 
table(predictions_1d, test_direction)
              test_direction
predictions_1d Down Up
          Down    9  5
          Up     34 56

El porcentaje de predicciones correctas es de \(62.5\%\):

(9+56)/length(test_direction) * 100
[1] 62.5

Por lo que la tasa de error es de \(37.5\%\):

100 - ((9+56)/length(test_direction) * 100)
[1] 37.5

Y el nivel de prediccion cuando el mercado sube es de \(91.8\%\):

56/(5+56)*100
[1] 91.80328

(e) Repeat (d) using LDA.

Cargamos la libreria MASS la cual ya trae la funcion LDA.

library(MASS)
fit_lda1 <- lda(Direction ~ Lag2, 
                data = Weekly, 
                subset = train_index)
fit_lda1
Call:
lda(Direction ~ Lag2, data = Weekly, subset = train_index)

Prior probabilities of groups:
     Down        Up 
0.4477157 0.5522843 

Group means:
            Lag2
Down -0.03568254
Up    0.26036581

Coefficients of linear discriminants:
           LD1
Lag2 0.4414162

Obtenemos la matriz de confusion:

prediction_lda <- predict(fit_lda1, test_weekly)
table(prediction_lda$class, test_direction)
      test_direction
       Down Up
  Down    9  5
  Up     34 56

Por lo que se puede ver que los porcentajes de prediccion son iguales a los del modelo de regresion logistica.

(f) Repeat (d) using QDA. La libreria MASS tambien incluye la funcion para hacer QDA

fit_qda1 <- qda(Direction ~ Lag2, 
                data = Weekly, 
                subset = train_index)
fit_qda1
Call:
qda(Direction ~ Lag2, data = Weekly, subset = train_index)

Prior probabilities of groups:
     Down        Up 
0.4477157 0.5522843 

Group means:
            Lag2
Down -0.03568254
Up    0.26036581

Obtenemos la matriz de confusion:

prediction_qda <- predict(fit_qda1, test_weekly)
table(prediction_qda$class, test_direction)
      test_direction
       Down Up
  Down    0  0
  Up     43 61

Con esto podemos ver que el porcentaje de prediccion del modelo es de \(58.6\%\):

61/length(test_direction)*100
[1] 58.65385

Pero el modelo siempre dira que el mercado va para arriba, ya que el porcentaje de prediccion para “UP” es de \(100%\) y el porcentaje de prediccion para “Down” es de 0%.

(g) Repeat (d) using KNN with K = 1. Usaremos una libreria que tenga la funcion KNN. Adjuntamos la libreria class:

library(class)

Para usar la funcion knn se necesitan matrices

train_knn <- as.matrix(Lag2[train_index])
test_knn <- as.matrix(Lag2[!train_index])
train_direction <- Direction [train_index]
set.seed (1)
knn_pred_1g = knn(train_knn,
                  test_knn,
                  train_direction, 
                  k=1)
table(knn_pred_1g, test_direction)
           test_direction
knn_pred_1g Down Up
       Down   21 30
       Up     22 31

Por lo que el porcentaje de prediccion de el modelo en knn es de \(50\%\):

(21+31)/length(test_direction) * 100
[1] 50

(h) Which of these methods appears to provide the best results on this data?

El porcentaje de prediccion del LDA es de \(62.5%\) por lo que ese es mejor modelo que el QDA y el KNN.

(i) Experiment with different combinations of predictors, including possible transformations and interactions, for each of the methods. Report the variables, method, and associated confusion matrix that appears to provide the best results on the held out data. Note that you should also experiment with values for K in the KNN classifier.

set.seed (1)
knn_pred_1g = knn(train_knn,
                  test_knn,
                  train_direction, 
                  k=5)
table(knn_pred_1g, test_direction)
           test_direction
knn_pred_1g Down Up
       Down   16 21
       Up     27 40

Usando \(k=5\) obtenemos un porcentaje de prediccion de \(53.8\%\):

(16+40)/length(test_direction) * 100
[1] 53.84615

Por lo que vemos que respecto al modelo KNN anterior mejora en un \(3\%\).

————————————————————————————–

11. In this problem, you will develop a model to predict whether a given car gets high or low gas mileage based on the Auto data set.

(a) Create a binary variable, mpg01, that contains a 1 if mpg contains a value above its median, and a 0 if mpg contains a value below its median. You can compute the median using the median() function. Note you may find it helpful to use the data.frame() function to create a single data set containing both mpg01 and the other Auto variables.

Usaremos el dataset AUTO el cual ya esta en la libreria ISLR:

attach(Auto)

Si mpg tiene un valor mayor que la mediana de mpg, se le asignara un valor de \(1\), mientras que si el valor de mpg es menor que su mediana entonces se le asignara un \(0\).

mpg01 <- rep(1, length(mpg))
mpg01[mpg < median(mpg)] <- 0
auto <- data.frame(Auto, mpg01)
head(auto)

(b) Explore the data graphically in order to investigate the association between mpg01 and the other features. Which of the other features seem most likely to be useful in predicting mpg01? Scatterplots and boxplots may be useful tools to answer this question. Describe your findings.

Se haran graficas tipo boxplot para ver la relacion que hay entre la variable mpg01 y las demas.

library(ggplot2)
ggplot(auto, aes(x = auto$mpg01, y = auto$cylinders, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs cylinders")

Se puede ver que hay una relacion entre el numero de cilindros y mpg01, ya que la acumulacion de puntos estan separados.

ggplot(auto, aes(x = auto$mpg01, y = auto$displacement, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs displacement")

Se puede ver que hay una relacion entre displacement y mpg01, ya que la acumulacion de puntos estan separados.

ggplot(auto, aes(x = auto$mpg01, y = auto$horsepower, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs horsepower")

Se puede ver que hay una relacion entre los caballos de fueza y mpg01, ya que la acumulacion de puntos estan separados.

ggplot(auto, aes(x = auto$mpg01, y = auto$weight, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs weight")

Se puede ver que hay una relacion entre el peso y mpg01, ya que la acumulacion de puntos estan separados.

ggplot(auto, aes(x = auto$mpg01, y = auto$acceleration, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs acceleration")

Se puede ver que la relacion que hay entre la aceleracion y mpg01 no es mucha ya que mpg01 no depende de la aceleracion.

ggplot(auto, aes(x = auto$mpg01, y = auto$year, group = auto$mpg01)) + 
  geom_boxplot() +
  ggtitle("mpg01 vs year")

Se puede ver que la relacion que hay entre el año y mpg01 no es mucha ya que mpg01 no depente del año.

(c) Split the data into a training set and a test set.

train_auto_index <- sample(1:nrow(auto), size = nrow(auto)*0.7)
train_auto <- auto[train_auto_index,]
test_auto_index <- setdiff(1:nrow(auto), train_auto_index)
test_auto <- auto[test_auto_index,]
test_mpg01 <- auto[test_auto_index,10]

(d) Perform LDA on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?

auto_lda <- lda(mpg01 ~ cylinders + displacement + weight + horsepower, 
                data = train_auto)
auto_lda
Call:
lda(mpg01 ~ cylinders + displacement + weight + horsepower, data = train_auto)

Prior probabilities of groups:
        0         1 
0.5218978 0.4781022 

Group means:
  cylinders displacement   weight horsepower
0  6.783217     275.7413 3635.245  130.79021
1  4.183206     117.4847 2357.954   79.05344

Coefficients of linear discriminants:
                       LD1
cylinders    -0.5630605949
displacement  0.0008793225
weight       -0.0009804614
horsepower    0.0021865294
auto_lda_pred <- predict(auto_lda, test_auto)
table(auto_lda_pred$class, test_mpg01)
   test_mpg01
     0  1
  0 44  5
  1  9 60

Por lo que el porcentaje de prediccion del modelo es de \(88.1\%\):

(44+60)/nrow(test_auto) * 100
[1] 88.13559

Con un error de \(11.9\%\):

100 - (44+60)/nrow(test_auto) * 100
[1] 11.86441

(e) Perform QDA on the training data in order to predict mpg01using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?

auto_qda <- qda(mpg01 ~ cylinders + displacement + weight + horsepower, 
                data = train_auto)
auto_qda
Call:
qda(mpg01 ~ cylinders + displacement + weight + horsepower, data = train_auto)

Prior probabilities of groups:
        0         1 
0.5218978 0.4781022 

Group means:
  cylinders displacement   weight horsepower
0  6.783217     275.7413 3635.245  130.79021
1  4.183206     117.4847 2357.954   79.05344
auto_qda_pred <- predict(auto_qda, test_auto)
table(auto_qda_pred$class, test_mpg01)
   test_mpg01
     0  1
  0 46  7
  1  7 58

Por lo que el porcentaje de prediccion del modelo es de \(88.1\%\):

(46+58)/nrow(test_auto) * 100
[1] 88.13559

Con un error de \(11.9\%\):

100 - (46+58)/nrow(test_auto) * 100
[1] 11.86441

(f) Perform logistic regression on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?

auto_glm <- glm(mpg01 ~ cylinders + displacement + weight + horsepower, 
              data = train_auto, 
              family = binomial)
summary(auto_glm)

Call:
glm(formula = mpg01 ~ cylinders + displacement + weight + horsepower, 
    family = binomial, data = train_auto)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2010  -0.2305  -0.0024   0.3654   3.3926  

Coefficients:
               Estimate Std. Error z value Pr(>|z|)    
(Intercept)  14.2337614  2.3616028   6.027 1.67e-09 ***
cylinders    -0.4491175  0.4731190  -0.949 0.342484    
displacement -0.0013958  0.0107350  -0.130 0.896545    
weight       -0.0019274  0.0008083  -2.385 0.017099 *  
horsepower   -0.0670978  0.0187027  -3.588 0.000334 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 379.32  on 273  degrees of freedom
Residual deviance: 142.51  on 269  degrees of freedom
AIC: 152.51

Number of Fisher Scoring iterations: 7
auto_prob_glm <- predict(auto_glm,
                   test_auto,
                   type = "response")
predictions_auto <- rep(0, length(auto_prob_glm))
predictions_auto[auto_prob_glm > 0.5] <- 1 
table(predictions_auto, test_auto$mpg01)
                
predictions_auto  0  1
               0 46  7
               1  7 58

Por lo que el porcentaje de prediccion del modelo es de \(88.1\%\):

(46+58)/nrow(test_auto) * 100
[1] 88.13559

Con un error de \(11.9\%\):

100 - (46+58)/nrow(test_auto) * 100
[1] 11.86441

(g)Perform KNN on the training data, with several values of K, in order to predict mpg01. Use only the variables that seemed most associated with mpg01 in (b). What test errors do you obtain? Which value of K seems to perform the best on this data set?

train_knn_auto <- cbind(cylinders, displacement, weight, horsepower)[train_auto_index,]
test_knn_auto <- cbind(cylinders, displacement, weight, horsepower)[test_auto_index,]
train_auto_mpg01 <- train_auto$mpg01
set.seed (1)
knn_pred_auto = knn(train_knn_auto,
                  test_knn_auto,
                  train_auto_mpg01, 
                  k=1)
table(knn_pred_auto, test_auto$mpg01)
             
knn_pred_auto  0  1
            0 44  6
            1  9 59

Por lo que el porcentaje de prediccion del modelo es de \(87.3\%\):

(44+59)/nrow(test_auto) * 100
[1] 87.28814

Con un error de \(12.7\%\):

100 - (44+59)/nrow(test_auto) * 100
[1] 12.71186

Usando otro valor de k, \(k=5\):

set.seed (1)
knn_pred_auto = knn(train_knn_auto,
                  test_knn_auto,
                  train_auto_mpg01, 
                  k=5)
table(knn_pred_auto, test_auto$mpg01)
             
knn_pred_auto  0  1
            0 44  7
            1  9 58

Por lo que el porcentaje de prediccion del modelo es de \(86.4\%\):

(44+58)/nrow(test_auto) * 100
[1] 86.44068

Con un error de \(13.6\%\):

100 - (44+58)/nrow(test_auto) * 100
[1] 13.55932

————————————————————————————–

12. This problem involves writing functions. (a) Write a function, Power(), that prints out the result of raising 2 to the 3rd power. In other words, your function should compute 23 and print out the results.

Power <- function(){
  2^3
}
Power()
[1] 8

(b) Create a new function, Power2(), that allows you to pass any two numbers, x and a, and prints out the value of x^a.

Power2 <- function (x,a){
  x^a
}
Power2(3,8)
[1] 6561

(c) Using the Power2() function that you just wrote, compute \(10^3\),\(8^17\), and \(131^3\).

Power2(10,3)
[1] 1000
Power2(8,17)
[1] 2.2518e+15
Power2(131,3)
[1] 2248091

(d) Now create a new function, Power3(), that actually returns the result x^a as an R object, rather than simply printing it to the screen. That is, if you store the value x^a in an object called result within your function, then you can simply return() this result, using the following line return(result)

Power3 <- function(x,a){
  res <- x^a
  return(res)
}
Power3(3,8)
[1] 6561

(e) Now using the Power3() function, create a plot of \(f(x)=x^2\). The x-axis should display a range of integers from 1 to 10, and the y-axis should display \(x^2\). Label the axes appropriately, and use an appropriate title for the figure. Consider displaying either the x-axis, the y-axis, or both on the log-scale. You can do this by using log=“x”, log=“y”, or log=“xy” as arguments to the plot() function.

plot(1:10, Power3(1:10,2), xlab="X", ylab="f(X)", main="F(X)=X^2", log = "xy")

(f) Create a function, PlotPower(), that allows you to create a plot of x against x^a for a fixed a and for a range of values of x. For instance, if you call PlotPower (1:10 ,3) then a plot should be created

PlotPower <- function(x,a){
  plot(x, Power3(x,a), xlab="X", ylab="f(X)", main="F(X)=X^a")
}
PlotPower(1:10,3)

————————————————————————————–

13. Using the Boston data set, fit classification models in order to predict whether a given suburb has a crime rate above or below the median. Explore logistic regression, LDA, and KNN models using various subsets of the predictors. Describe your findings.

Usando el procedimiento en el ejercicio del dataset Auto:

attach(Boston)
crime_class <- rep(0, length(crim))
crime_class[crim > median(crim)] <- 1
boston <- data.frame(Boston, crime_class)

Ahora dividimos en train y test:

train_boston_index <- sample(1:nrow(boston), size = nrow(boston)*0.7)
train_boston <- boston[train_boston_index,]
test_boston_index <- setdiff(1:nrow(boston), train_boston_index)
test_boston <- boston[test_boston_index,]
test_crime <- boston[test_boston_index,15]

Regresion Logistica:

boston_glm <- glm(crime_class ~ zn + indus + nox + rm + age + dis + tax + black + medv, 
              data = train_boston, 
              family = binomial)
summary(boston_glm)

Call:
glm(formula = crime_class ~ zn + indus + nox + rm + age + dis + 
    tax + black + medv, family = binomial, data = train_boston)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.11496  -0.36107  -0.00967   0.19207   3.01037  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -24.051225   4.951735  -4.857 1.19e-06 ***
zn           -0.073246   0.030939  -2.367 0.017912 *  
indus        -0.042886   0.046894  -0.915 0.360433    
nox          42.940162   6.988294   6.145 8.02e-10 ***
rm           -0.670781   0.607233  -1.105 0.269311    
age           0.018056   0.010963   1.647 0.099545 .  
dis           0.867080   0.224782   3.857 0.000115 ***
tax           0.004184   0.002050   2.041 0.041264 *  
black        -0.009479   0.004828  -1.963 0.049603 *  
medv          0.163451   0.060531   2.700 0.006928 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 490.74  on 353  degrees of freedom
Residual deviance: 188.24  on 344  degrees of freedom
AIC: 208.24

Number of Fisher Scoring iterations: 7
boston_prob_glm <- predict(boston_glm,
                   test_boston,
                   type = "response")
predictions_boston <- rep(0, length(boston_prob_glm))
predictions_boston[boston_prob_glm > 0.5] <- 1 
table(predictions_boston, test_crime)
                  test_crime
predictions_boston  0  1
                 0 59  6
                 1 16 71

Por lo que el porcentaje de prediccion del modelo es de \(85.5\%\):

(59+71)/nrow(test_boston) * 100
[1] 85.52632

Con un error de \(14.5\%\):

100 - (59+71)/nrow(test_boston) * 100
[1] 14.47368

Usando LDA:

boston_lda <- lda(crime_class ~ zn + indus + nox + rm + age + dis + tax + black + medv, 
                data = train_boston)
boston_lda
Call:
lda(crime_class ~ zn + indus + nox + rm + age + dis + tax + black + 
    medv, data = train_boston)

Prior probabilities of groups:
        0         1 
0.5028249 0.4971751 

Group means:
         zn     indus       nox       rm      age      dis      tax    black     medv
0 21.626404  6.584101 0.4682011 6.398388 50.79101 5.076423 302.5843 388.2219 25.00730
1  1.386364 14.925284 0.6373580 6.165273 84.64091 2.560003 496.3807 324.7719 19.58295

Coefficients of linear discriminants:
               LD1
zn    -0.009317946
indus  0.015264766
nox    8.263293245
rm    -0.016244211
age    0.011390805
dis    0.093765135
tax    0.002882149
black -0.001307745
medv   0.037243898
boston_lda_pred <- predict(boston_lda, test_boston)
table(boston_lda_pred$class, test_crime)
   test_crime
     0  1
  0 67 12
  1  8 65

Por lo que el porcentaje de prediccion del modelo es de \(86.8\%\):

(67+65)/nrow(test_boston) * 100
[1] 86.84211

Con un error de \(13.2\%\):

100 - (67+65)/nrow(test_boston) * 100
[1] 13.15789

Usando Knn:

train_knn_boston <- cbind(zn, indus, nox, rm, age, dis, tax, black, medv)[train_boston_index,]
test_knn_boston <- cbind(zn, indus, nox, rm, age, dis, tax, black, medv)[test_boston_index,]
train_crime <- train_boston$crime_class
set.seed (1)
knn_pred_boston = knn(train_knn_boston,
                  test_knn_boston,
                  train_crime, 
                  k=1)
table(knn_pred_boston, test_crime)
               test_crime
knn_pred_boston  0  1
              0 63  2
              1 12 75

Por lo que el porcentaje de prediccion del modelo es de \(90.8\%\):

(63+75)/nrow(test_boston) * 100
[1] 90.78947

Con un error de \(9.2\%\):

100 - (63+75)/nrow(test_boston) * 100
[1] 9.210526

Por lo que podemos ver que el modelo que menor tasa de error tiene es el Knn, ya que tiene una tasa de error del \(9.2\%\).

LS0tDQp0aXRsZTogIkhvamEgZGUgVHJhYmFqbyAjIDMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIyBQYXVsYSBDYXphbGkNCiMjIyBGaWFiaWxpZGFkDQoNCiMjIyBFamVyY2ljaW9zIGRlIGxhIHNlY2Npb24gNC43IGxpYnJvIElTTFIgQXBsaWNhZG9zDQoNCioqMTAuIFRoaXMgcXVlc3Rpb24gc2hvdWxkIGJlIGFuc3dlcmVkIHVzaW5nIHRoZSBXZWVrbHkgZGF0YSBzZXQsIHdoaWNoIGlzIHBhcnQgb2YgdGhlIElTTFIgcGFja2FnZS4gVGhpcyBkYXRhIGlzIHNpbWlsYXIgaW4gbmF0dXJlIHRvIHRoZSBTbWFya2V0IGRhdGEgZnJvbSB0aGlzIGNoYXB0ZXIncyBsYWIsIGV4Y2VwdCB0aGF0IGl0IGNvbnRhaW5zIDEsIDA4OSB3ZWVrbHkgcmV0dXJucyBmb3IgMjEgeWVhcnMsIGZyb20gdGhlIGJlZ2lubmluZyBvZiAxOTkwIHRvIHRoZSBlbmQgb2YgMjAxMC4qKg0KYGBge3J9DQpsaWJyYXJ5KElTTFIpDQpgYGANCg0KKiooYSkgUHJvZHVjZSBzb21lIG51bWVyaWNhbCBhbmQgZ3JhcGhpY2FsIHN1bW1hcmllcyBvZiB0aGUgV2Vla2x5IGRhdGEuIERvIHRoZXJlIGFwcGVhciB0byBiZSBhbnkgcGF0dGVybnM/KioNCmBgYHtyfQ0KYXR0YWNoKFdlZWtseSkNCmBgYA0KYGBge3J9DQpzdW1tYXJ5KFdlZWtseSkNCmBgYA0KDQoqKihiKSBVc2UgdGhlIGZ1bGwgZGF0YSBzZXQgdG8gcGVyZm9ybSBhIGxvZ2lzdGljIHJlZ3Jlc3Npb24gd2l0aCBEaXJlY3Rpb24gYXMgdGhlIHJlc3BvbnNlIGFuZCB0aGUgZml2ZSBsYWcgdmFyaWFibGVzIHBsdXMgVm9sdW1lIGFzIHByZWRpY3RvcnMuIFVzZSB0aGUgc3VtbWFyeSBmdW5jdGlvbiB0byBwcmludCB0aGUgcmVzdWx0cy4gRG8gYW55IG9mIHRoZSBwcmVkaWN0b3JzIGFwcGVhciB0byBiZSBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50PyBJZiBzbywgd2hpY2ggb25lcz8qKg0KYGBge3J9DQpmaXRfMWIgPC0gZ2xtKERpcmVjdGlvbiB+IExhZzEgKyBMYWcyICsgTGFnMyArIExhZzQgKyBMYWc1ICsgVm9sdW1lLCBkYXRhPVdlZWtseSwgZmFtaWx5ID0gYmlub21pYWwpDQpzdW1tYXJ5KGZpdF8xYikNCmBgYA0KDQpQb3IgbG8gcXVlIHNlIHZlIHF1ZSAqTGFnMiogZXMgbGEgdmFyaWFibGUgbWFzIHNpZ25pZmljYXRpdmEuDQoNCioqKGMpIENvbXB1dGUgdGhlIGNvbmZ1c2lvbiBtYXRyaXggYW5kIG92ZXJhbGwgZnJhY3Rpb24gb2YgY29ycmVjdCBwcmVkaWN0aW9ucy4gRXhwbGFpbiB3aGF0IHRoZSBjb25mdXNpb24gbWF0cml4IGlzIHRlbGxpbmcgeW91IGFib3V0IHRoZSB0eXBlcyBvZiBtaXN0YWtlcyBtYWRlIGJ5IGxvZ2lzdGljIHJlZ3Jlc3Npb24uKioNCmBgYHtyfQ0KcHJvYmFiaWxpZGFkZXMgPC0gcHJlZGljdChmaXRfMWIsIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZGljdGlvbnNfMWMgPC0gcmVwKCJEb3duIiwgbGVuZ3RoKHByb2JhYmlsaWRhZGVzKSkNCnByZWRpY3Rpb25zXzFjW3Byb2JhYmlsaWRhZGVzID4gMC41XSA8LSAiVXAiIA0KdGFibGUocHJlZGljdGlvbnNfMWMsIERpcmVjdGlvbikNCmBgYA0KTGFzIGVzdGltYWNpb25lcyBjb3JyZWN0YXMgc29uIGxhcyBxdWUgc2UgZW5jdWVudHJhbiBlbiBsYSBkaWFnb25hbCBwcmluY2lwYWwgZGUgbGEgbWF0cml6IGRlIGNvbmZ1c2lvbiwgcG9yIGxvIHF1ZSBwcmVkaWpvIHF1ZSA1NCBEb3ducyBlcmFuIERvd25zIHkgNTU3IFVwcyBlcmFuIFVwcyANCkVsIHRvdGFsIGRlIHBvc2liaWxpZGFkZXMgc29uOg0KYGBge3J9DQpsZW5ndGgocHJlZGljdGlvbnNfMWMpDQpgYGANClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGVzIGRlICQ1Ni4xXCUkOg0KYGBge3J9DQooNTQrNTU3KS9sZW5ndGgocHJlZGljdGlvbnNfMWMpKjEwMA0KYGBgDQoNCioqKGQpIE5vdyBmaXQgdGhlIGxvZ2lzdGljIHJlZ3Jlc3Npb24gbW9kZWwgdXNpbmcgYSB0cmFpbmluZyBkYXRhIHBlcmlvZCBmcm9tIDE5OTAgdG8gMjAwOCwgd2l0aCBMYWcyIGFzIHRoZSBvbmx5IHByZWRpY3Rvci4gQ29tcHV0ZSB0aGUgY29uZnVzaW9uIG1hdHJpeCBhbmQgdGhlIG92ZXJhbGwgZnJhY3Rpb24gb2YgY29ycmVjdCBwcmVkaWN0aW9ucyBmb3IgdGhlIGhlbGQgb3V0IGRhdGEgKHRoYXQgaXMsIHRoZSBkYXRhIGZyb20gMjAwOSBhbmQgMjAxMCkuKioNCg0KRGl2aWRpZW5kbyBsb3MgZGF0b3MgZW4gdW4gc2V0IGRlIHRyYWluIHkgZW4gdW4gc2V0IGRlIHRlc3QuIFRyYWluIHRlbmRyYSBsYSBpbmZvcm1hY2lvbiBkZXNkZSBlbCBh8W8gMTk5MCBoYXN0YSBlbCBh8W8gMjAwOA0KYGBge3J9DQp0cmFpbl9pbmRleCA8LSAoWWVhciA8IDIwMDkpDQp0ZXN0X3dlZWtseSA8LSBXZWVrbHlbIXRyYWluX2luZGV4LF0NCmBgYA0KDQpDb21vIGVzdGFtb3MgcHJlZGljaWVuZG8gKkRpcmVjdGlvbiogZ3VhcmRhbW9zIHNvbG8gZWwgdmFsb3IgZGUgbGFzICpEaXJlY3Rpb25zKiBlbiBgdGVzdF9kaXJlY3Rpb25gLiBVc2Ftb3Mgc29sbyBsYSB2YXJpYWJsZSAqTGFnMiogcGFyYSBoYWNlciBsYSByZWdyZXNpb24gbG9naXN0aWNhLiANCmBgYHtyfQ0KdGVzdF9kaXJlY3Rpb24gPC0gRGlyZWN0aW9uWyF0cmFpbl9pbmRleF0NCmZpdF8xZCA8LSBnbG0oRGlyZWN0aW9uIH4gTGFnMiwgDQogICAgICAgICAgICAgIGRhdGEgPSBXZWVrbHksIA0KICAgICAgICAgICAgICBmYW1pbHkgPSBiaW5vbWlhbCwNCiAgICAgICAgICAgICAgc3Vic2V0ID0gdHJhaW5faW5kZXgpDQpzdW1tYXJ5KGZpdF8xZCkNCmBgYA0KQWhvcmEgb2J0ZW5lbW9zIGxhIG1hdHJpeiBkZSBjb25mdXNpb246DQpgYGB7cn0NCnByb2JfMWQgPC0gcHJlZGljdChmaXRfMWQsDQogICAgICAgICAgICAgICAgICAgdGVzdF93ZWVrbHksDQogICAgICAgICAgICAgICAgICAgdHlwZSA9ICJyZXNwb25zZSIpDQpwcmVkaWN0aW9uc18xZCA8LSByZXAoIkRvd24iLCBsZW5ndGgocHJvYl8xZCkpDQpwcmVkaWN0aW9uc18xZFtwcm9iXzFkID4gMC41XSA8LSAiVXAiIA0KdGFibGUocHJlZGljdGlvbnNfMWQsIHRlc3RfZGlyZWN0aW9uKQ0KYGBgDQoNCkVsIHBvcmNlbnRhamUgZGUgcHJlZGljY2lvbmVzIGNvcnJlY3RhcyBlcyBkZSAkNjIuNVwlJDoNCmBgYHtyfQ0KKDkrNTYpL2xlbmd0aCh0ZXN0X2RpcmVjdGlvbikgKiAxMDANCmBgYA0KUG9yIGxvIHF1ZSBsYSB0YXNhIGRlIGVycm9yIGVzIGRlICQzNy41XCUkOg0KYGBge3J9DQoxMDAgLSAoKDkrNTYpL2xlbmd0aCh0ZXN0X2RpcmVjdGlvbikgKiAxMDApDQpgYGANClkgZWwgbml2ZWwgZGUgcHJlZGljY2lvbiBjdWFuZG8gZWwgbWVyY2FkbyBzdWJlIGVzIGRlICQ5MS44XCUkOg0KYGBge3J9DQo1Ni8oNSs1NikqMTAwDQpgYGANCg0KKiooZSkgUmVwZWF0IChkKSB1c2luZyBMREEuKioNCg0KQ2FyZ2Ftb3MgbGEgbGlicmVyaWEgTUFTUyBsYSBjdWFsIHlhIHRyYWUgbGEgZnVuY2lvbiBMREEuDQpgYGB7cn0NCmxpYnJhcnkoTUFTUykNCmBgYA0KDQpgYGB7cn0NCmZpdF9sZGExIDwtIGxkYShEaXJlY3Rpb24gfiBMYWcyLCANCiAgICAgICAgICAgICAgICBkYXRhID0gV2Vla2x5LCANCiAgICAgICAgICAgICAgICBzdWJzZXQgPSB0cmFpbl9pbmRleCkNCmZpdF9sZGExDQpgYGANCg0KT2J0ZW5lbW9zIGxhIG1hdHJpeiBkZSBjb25mdXNpb246DQpgYGB7cn0NCnByZWRpY3Rpb25fbGRhIDwtIHByZWRpY3QoZml0X2xkYTEsIHRlc3Rfd2Vla2x5KQ0KdGFibGUocHJlZGljdGlvbl9sZGEkY2xhc3MsIHRlc3RfZGlyZWN0aW9uKQ0KYGBgDQpQb3IgbG8gcXVlIHNlIHB1ZWRlIHZlciBxdWUgbG9zIHBvcmNlbnRhamVzIGRlIHByZWRpY2Npb24gc29uIGlndWFsZXMgYSBsb3MgZGVsIG1vZGVsbyBkZSByZWdyZXNpb24gbG9naXN0aWNhLg0KDQoqKihmKSBSZXBlYXQgKGQpIHVzaW5nIFFEQS4qKg0KTGEgbGlicmVyaWEgTUFTUyB0YW1iaWVuIGluY2x1eWUgbGEgZnVuY2lvbiBwYXJhIGhhY2VyIFFEQQ0KYGBge3J9DQpmaXRfcWRhMSA8LSBxZGEoRGlyZWN0aW9uIH4gTGFnMiwgDQogICAgICAgICAgICAgICAgZGF0YSA9IFdlZWtseSwgDQogICAgICAgICAgICAgICAgc3Vic2V0ID0gdHJhaW5faW5kZXgpDQpmaXRfcWRhMQ0KYGBgDQoNCk9idGVuZW1vcyBsYSBtYXRyaXogZGUgY29uZnVzaW9uOg0KYGBge3J9DQpwcmVkaWN0aW9uX3FkYSA8LSBwcmVkaWN0KGZpdF9xZGExLCB0ZXN0X3dlZWtseSkNCnRhYmxlKHByZWRpY3Rpb25fcWRhJGNsYXNzLCB0ZXN0X2RpcmVjdGlvbikNCmBgYA0KDQpDb24gZXN0byBwb2RlbW9zIHZlciBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDU4LjZcJSQ6DQpgYGB7cn0NCjYxL2xlbmd0aCh0ZXN0X2RpcmVjdGlvbikqMTAwDQpgYGANCg0KUGVybyBlbCBtb2RlbG8gc2llbXByZSBkaXJhIHF1ZSBlbCBtZXJjYWRvIHZhIHBhcmEgYXJyaWJhLCB5YSBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIHBhcmEgIlVQIiBlcyBkZSAkMTAwJSQgeSBlbCBwb3JjZW50YWplIGRlIHByZWRpY2Npb24gcGFyYSAiRG93biIgZXMgZGUgMCUuDQoNCioqKGcpIFJlcGVhdCAoZCkgdXNpbmcgS05OIHdpdGggSyA9IDEuKioNClVzYXJlbW9zIHVuYSBsaWJyZXJpYSBxdWUgdGVuZ2EgbGEgZnVuY2lvbiBLTk4uIEFkanVudGFtb3MgbGEgbGlicmVyaWEgY2xhc3M6DQpgYGB7cn0NCmxpYnJhcnkoY2xhc3MpDQpgYGANCg0KUGFyYSB1c2FyIGxhIGZ1bmNpb24ga25uIHNlIG5lY2VzaXRhbiBtYXRyaWNlcyANCmBgYHtyfQ0KdHJhaW5fa25uIDwtIGFzLm1hdHJpeChMYWcyW3RyYWluX2luZGV4XSkNCnRlc3Rfa25uIDwtIGFzLm1hdHJpeChMYWcyWyF0cmFpbl9pbmRleF0pDQp0cmFpbl9kaXJlY3Rpb24gPC0gRGlyZWN0aW9uIFt0cmFpbl9pbmRleF0NCg0Kc2V0LnNlZWQgKDEpDQprbm5fcHJlZF8xZyA9IGtubih0cmFpbl9rbm4sDQogICAgICAgICAgICAgICAgICB0ZXN0X2tubiwNCiAgICAgICAgICAgICAgICAgIHRyYWluX2RpcmVjdGlvbiwgDQogICAgICAgICAgICAgICAgICBrPTEpDQp0YWJsZShrbm5fcHJlZF8xZywgdGVzdF9kaXJlY3Rpb24pDQpgYGANCg0KUG9yIGxvIHF1ZSBlbCBwb3JjZW50YWplIGRlIHByZWRpY2Npb24gZGUgZWwgbW9kZWxvIGVuIGtubiBlcyBkZSAkNTBcJSQ6DQpgYGB7cn0NCigyMSszMSkvbGVuZ3RoKHRlc3RfZGlyZWN0aW9uKSAqIDEwMA0KYGBgDQoNCioqKGgpIFdoaWNoIG9mIHRoZXNlIG1ldGhvZHMgYXBwZWFycyB0byBwcm92aWRlIHRoZSBiZXN0IHJlc3VsdHMgb24gdGhpcyBkYXRhPyoqDQoNCkVsIHBvcmNlbnRhamUgZGUgcHJlZGljY2lvbiBkZWwgTERBIGVzIGRlICQ2Mi41JSQgcG9yIGxvIHF1ZSBlc2UgZXMgbWVqb3IgbW9kZWxvIHF1ZSBlbCBRREEgeSBlbCBLTk4uDQoNCioqKGkpIEV4cGVyaW1lbnQgd2l0aCBkaWZmZXJlbnQgY29tYmluYXRpb25zIG9mIHByZWRpY3RvcnMsIGluY2x1ZGluZyBwb3NzaWJsZSB0cmFuc2Zvcm1hdGlvbnMgYW5kIGludGVyYWN0aW9ucywgZm9yIGVhY2ggb2YgdGhlIG1ldGhvZHMuIFJlcG9ydCB0aGUgdmFyaWFibGVzLCBtZXRob2QsIGFuZCBhc3NvY2lhdGVkIGNvbmZ1c2lvbiBtYXRyaXggdGhhdCBhcHBlYXJzIHRvIHByb3ZpZGUgdGhlIGJlc3QgcmVzdWx0cyBvbiB0aGUgaGVsZCBvdXQgZGF0YS4gTm90ZSB0aGF0IHlvdSBzaG91bGQgYWxzbyBleHBlcmltZW50IHdpdGggdmFsdWVzIGZvciBLIGluIHRoZSBLTk4gY2xhc3NpZmllci4qKg0KDQpgYGB7cn0NCnNldC5zZWVkICgxKQ0Ka25uX3ByZWRfMWcgPSBrbm4odHJhaW5fa25uLA0KICAgICAgICAgICAgICAgICAgdGVzdF9rbm4sDQogICAgICAgICAgICAgICAgICB0cmFpbl9kaXJlY3Rpb24sIA0KICAgICAgICAgICAgICAgICAgaz01KQ0KdGFibGUoa25uX3ByZWRfMWcsIHRlc3RfZGlyZWN0aW9uKQ0KYGBgDQpVc2FuZG8gJGs9NSQgb2J0ZW5lbW9zIHVuIHBvcmNlbnRhamUgZGUgcHJlZGljY2lvbiBkZSAkNTMuOFwlJDoNCmBgYHtyfQ0KKDE2KzQwKS9sZW5ndGgodGVzdF9kaXJlY3Rpb24pICogMTAwDQpgYGANClBvciBsbyBxdWUgdmVtb3MgcXVlIHJlc3BlY3RvIGFsIG1vZGVsbyBLTk4gYW50ZXJpb3IgbWVqb3JhIGVuIHVuICQzXCUkLg0KDQoNCiMjIC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tDQoqKjExLiBJbiB0aGlzIHByb2JsZW0sIHlvdSB3aWxsIGRldmVsb3AgYSBtb2RlbCB0byBwcmVkaWN0IHdoZXRoZXIgYSBnaXZlbiBjYXIgZ2V0cyBoaWdoIG9yIGxvdyBnYXMgbWlsZWFnZSBiYXNlZCBvbiB0aGUgQXV0byBkYXRhIHNldC4qKg0KDQoqKihhKSBDcmVhdGUgYSBiaW5hcnkgdmFyaWFibGUsIG1wZzAxLCB0aGF0IGNvbnRhaW5zIGEgMSBpZiBtcGcgY29udGFpbnMgYSB2YWx1ZSBhYm92ZSBpdHMgbWVkaWFuLCBhbmQgYSAwIGlmIG1wZyBjb250YWlucyBhIHZhbHVlIGJlbG93IGl0cyBtZWRpYW4uIFlvdSBjYW4gY29tcHV0ZSB0aGUgbWVkaWFuIHVzaW5nIHRoZSBtZWRpYW4oKSBmdW5jdGlvbi4gTm90ZSB5b3UgbWF5IGZpbmQgaXQgaGVscGZ1bCB0byB1c2UgdGhlIGRhdGEuZnJhbWUoKSBmdW5jdGlvbiB0byBjcmVhdGUgYSBzaW5nbGUgZGF0YSBzZXQgY29udGFpbmluZyBib3RoIG1wZzAxIGFuZCB0aGUgb3RoZXIgQXV0byB2YXJpYWJsZXMuKioNCg0KVXNhcmVtb3MgZWwgZGF0YXNldCBBVVRPIGVsIGN1YWwgeWEgZXN0YSBlbiBsYSBsaWJyZXJpYSBJU0xSOg0KYGBge3J9DQphdHRhY2goQXV0bykNCmBgYA0KU2kgbXBnIHRpZW5lIHVuIHZhbG9yIG1heW9yIHF1ZSBsYSBtZWRpYW5hIGRlIG1wZywgc2UgbGUgYXNpZ25hcmEgdW4gdmFsb3IgZGUgJDEkLCBtaWVudHJhcyBxdWUgc2kgZWwgdmFsb3IgZGUgbXBnIGVzIG1lbm9yIHF1ZSBzdSBtZWRpYW5hIGVudG9uY2VzIHNlIGxlIGFzaWduYXJhIHVuICQwJC4NCmBgYHtyfQ0KbXBnMDEgPC0gcmVwKDEsIGxlbmd0aChtcGcpKQ0KbXBnMDFbbXBnIDwgbWVkaWFuKG1wZyldIDwtIDANCmF1dG8gPC0gZGF0YS5mcmFtZShBdXRvLCBtcGcwMSkNCmhlYWQoYXV0bykNCmBgYA0KDQoqKihiKSBFeHBsb3JlIHRoZSBkYXRhIGdyYXBoaWNhbGx5IGluIG9yZGVyIHRvIGludmVzdGlnYXRlIHRoZSBhc3NvY2lhdGlvbiBiZXR3ZWVuIG1wZzAxIGFuZCB0aGUgb3RoZXIgZmVhdHVyZXMuIFdoaWNoIG9mIHRoZSBvdGhlciBmZWF0dXJlcyBzZWVtIG1vc3QgbGlrZWx5IHRvIGJlIHVzZWZ1bCBpbiBwcmVkaWN0aW5nIG1wZzAxPyBTY2F0dGVycGxvdHMgYW5kIGJveHBsb3RzIG1heSBiZSB1c2VmdWwgdG9vbHMgdG8gYW5zd2VyIHRoaXMgcXVlc3Rpb24uIERlc2NyaWJlIHlvdXIgZmluZGluZ3MuKioNCg0KU2UgaGFyYW4gZ3JhZmljYXMgdGlwbyBib3hwbG90IHBhcmEgdmVyIGxhIHJlbGFjaW9uIHF1ZSBoYXkgZW50cmUgbGEgdmFyaWFibGUgbXBnMDEgeSBsYXMgZGVtYXMuDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCmBgYA0KDQpgYGB7cn0NCmdncGxvdChhdXRvLCBhZXMoeCA9IGF1dG8kbXBnMDEsIHkgPSBhdXRvJGN5bGluZGVycywgZ3JvdXAgPSBhdXRvJG1wZzAxKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICBnZ3RpdGxlKCJtcGcwMSB2cyBjeWxpbmRlcnMiKQ0KYGBgDQpTZSBwdWVkZSB2ZXIgcXVlIGhheSB1bmEgcmVsYWNpb24gZW50cmUgZWwgbnVtZXJvIGRlIGNpbGluZHJvcyB5IG1wZzAxLCB5YSBxdWUgbGEgYWN1bXVsYWNpb24gZGUgcHVudG9zIGVzdGFuIHNlcGFyYWRvcy4NCg0KYGBge3J9DQpnZ3Bsb3QoYXV0bywgYWVzKHggPSBhdXRvJG1wZzAxLCB5ID0gYXV0byRkaXNwbGFjZW1lbnQsIGdyb3VwID0gYXV0byRtcGcwMSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2d0aXRsZSgibXBnMDEgdnMgZGlzcGxhY2VtZW50IikNCmBgYA0KU2UgcHVlZGUgdmVyIHF1ZSBoYXkgdW5hIHJlbGFjaW9uIGVudHJlICpkaXNwbGFjZW1lbnQqIHkgbXBnMDEsIHlhIHF1ZSBsYSBhY3VtdWxhY2lvbiBkZSBwdW50b3MgZXN0YW4gc2VwYXJhZG9zLg0KDQpgYGB7cn0NCmdncGxvdChhdXRvLCBhZXMoeCA9IGF1dG8kbXBnMDEsIHkgPSBhdXRvJGhvcnNlcG93ZXIsIGdyb3VwID0gYXV0byRtcGcwMSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2d0aXRsZSgibXBnMDEgdnMgaG9yc2Vwb3dlciIpDQpgYGANClNlIHB1ZWRlIHZlciBxdWUgaGF5IHVuYSByZWxhY2lvbiBlbnRyZSBsb3MgY2FiYWxsb3MgZGUgZnVlemEgeSBtcGcwMSwgeWEgcXVlIGxhIGFjdW11bGFjaW9uIGRlIHB1bnRvcyBlc3RhbiBzZXBhcmFkb3MuDQoNCmBgYHtyfQ0KZ2dwbG90KGF1dG8sIGFlcyh4ID0gYXV0byRtcGcwMSwgeSA9IGF1dG8kd2VpZ2h0LCBncm91cCA9IGF1dG8kbXBnMDEpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdndGl0bGUoIm1wZzAxIHZzIHdlaWdodCIpDQpgYGANClNlIHB1ZWRlIHZlciBxdWUgaGF5IHVuYSByZWxhY2lvbiBlbnRyZSBlbCBwZXNvIHkgbXBnMDEsIHlhIHF1ZSBsYSBhY3VtdWxhY2lvbiBkZSBwdW50b3MgZXN0YW4gc2VwYXJhZG9zLg0KDQpgYGB7cn0NCmdncGxvdChhdXRvLCBhZXMoeCA9IGF1dG8kbXBnMDEsIHkgPSBhdXRvJGFjY2VsZXJhdGlvbiwgZ3JvdXAgPSBhdXRvJG1wZzAxKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICBnZ3RpdGxlKCJtcGcwMSB2cyBhY2NlbGVyYXRpb24iKQ0KYGBgDQpTZSBwdWVkZSB2ZXIgcXVlIGxhIHJlbGFjaW9uIHF1ZSBoYXkgZW50cmUgbGEgYWNlbGVyYWNpb24geSBtcGcwMSBubyBlcyBtdWNoYSB5YSBxdWUgbXBnMDEgbm8gZGVwZW5kZSBkZSBsYSBhY2VsZXJhY2lvbi4NCg0KYGBge3J9DQpnZ3Bsb3QoYXV0bywgYWVzKHggPSBhdXRvJG1wZzAxLCB5ID0gYXV0byR5ZWFyLCBncm91cCA9IGF1dG8kbXBnMDEpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdndGl0bGUoIm1wZzAxIHZzIHllYXIiKQ0KYGBgDQpTZSBwdWVkZSB2ZXIgcXVlIGxhIHJlbGFjaW9uIHF1ZSBoYXkgZW50cmUgZWwgYfFvIHkgbXBnMDEgbm8gZXMgbXVjaGEgeWEgcXVlIG1wZzAxIG5vIGRlcGVudGUgZGVsIGHxby4NCg0KKiooYykgU3BsaXQgdGhlIGRhdGEgaW50byBhIHRyYWluaW5nIHNldCBhbmQgYSB0ZXN0IHNldC4qKg0KDQpgYGB7cn0NCnRyYWluX2F1dG9faW5kZXggPC0gc2FtcGxlKDE6bnJvdyhhdXRvKSwgc2l6ZSA9IG5yb3coYXV0bykqMC43KQ0KdHJhaW5fYXV0byA8LSBhdXRvW3RyYWluX2F1dG9faW5kZXgsXQ0KdGVzdF9hdXRvX2luZGV4IDwtIHNldGRpZmYoMTpucm93KGF1dG8pLCB0cmFpbl9hdXRvX2luZGV4KQ0KdGVzdF9hdXRvIDwtIGF1dG9bdGVzdF9hdXRvX2luZGV4LF0NCnRlc3RfbXBnMDEgPC0gYXV0b1t0ZXN0X2F1dG9faW5kZXgsMTBdDQpgYGANCg0KKiooZCkgUGVyZm9ybSBMREEgb24gdGhlIHRyYWluaW5nIGRhdGEgaW4gb3JkZXIgdG8gcHJlZGljdCBtcGcwMSB1c2luZyB0aGUgdmFyaWFibGVzIHRoYXQgc2VlbWVkIG1vc3QgYXNzb2NpYXRlZCB3aXRoIG1wZzAxIGluIChiKS4gV2hhdCBpcyB0aGUgdGVzdCBlcnJvciBvZiB0aGUgbW9kZWwgb2J0YWluZWQ/ICoqDQoNCmBgYHtyfQ0KYXV0b19sZGEgPC0gbGRhKG1wZzAxIH4gY3lsaW5kZXJzICsgZGlzcGxhY2VtZW50ICsgd2VpZ2h0ICsgaG9yc2Vwb3dlciwgDQogICAgICAgICAgICAgICAgZGF0YSA9IHRyYWluX2F1dG8pDQphdXRvX2xkYQ0KYGBgDQoNCmBgYHtyfQ0KYXV0b19sZGFfcHJlZCA8LSBwcmVkaWN0KGF1dG9fbGRhLCB0ZXN0X2F1dG8pDQp0YWJsZShhdXRvX2xkYV9wcmVkJGNsYXNzLCB0ZXN0X21wZzAxKQ0KYGBgDQoNClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDg4LjFcJSQ6DQpgYGB7cn0NCig0NCs2MCkvbnJvdyh0ZXN0X2F1dG8pICogMTAwDQpgYGANCkNvbiB1biBlcnJvciBkZSAkMTEuOVwlJDoNCmBgYHtyfQ0KMTAwIC0gKDQ0KzYwKS9ucm93KHRlc3RfYXV0bykgKiAxMDANCmBgYA0KDQoqKihlKSBQZXJmb3JtIFFEQSBvbiB0aGUgdHJhaW5pbmcgZGF0YSBpbiBvcmRlciB0byBwcmVkaWN0IG1wZzAxdXNpbmcgdGhlIHZhcmlhYmxlcyB0aGF0IHNlZW1lZCBtb3N0IGFzc29jaWF0ZWQgd2l0aCBtcGcwMSBpbiAoYikuIFdoYXQgaXMgdGhlIHRlc3QgZXJyb3Igb2YgdGhlIG1vZGVsIG9idGFpbmVkPyoqDQoNCmBgYHtyfQ0KYXV0b19xZGEgPC0gcWRhKG1wZzAxIH4gY3lsaW5kZXJzICsgZGlzcGxhY2VtZW50ICsgd2VpZ2h0ICsgaG9yc2Vwb3dlciwgDQogICAgICAgICAgICAgICAgZGF0YSA9IHRyYWluX2F1dG8pDQphdXRvX3FkYQ0KYGBgDQoNCmBgYHtyfQ0KYXV0b19xZGFfcHJlZCA8LSBwcmVkaWN0KGF1dG9fcWRhLCB0ZXN0X2F1dG8pDQp0YWJsZShhdXRvX3FkYV9wcmVkJGNsYXNzLCB0ZXN0X21wZzAxKQ0KYGBgDQoNClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDg4LjFcJSQ6DQpgYGB7cn0NCig0Nis1OCkvbnJvdyh0ZXN0X2F1dG8pICogMTAwDQpgYGANCkNvbiB1biBlcnJvciBkZSAkMTEuOVwlJDoNCmBgYHtyfQ0KMTAwIC0gKDQ2KzU4KS9ucm93KHRlc3RfYXV0bykgKiAxMDANCmBgYA0KDQoqKihmKSBQZXJmb3JtIGxvZ2lzdGljIHJlZ3Jlc3Npb24gb24gdGhlIHRyYWluaW5nIGRhdGEgaW4gb3JkZXIgdG8gcHJlZGljdCBtcGcwMSB1c2luZyB0aGUgdmFyaWFibGVzIHRoYXQgc2VlbWVkIG1vc3QgYXNzb2NpYXRlZCB3aXRoIG1wZzAxIGluIChiKS4gV2hhdCBpcyB0aGUgdGVzdCBlcnJvciBvZiB0aGUgbW9kZWwgb2J0YWluZWQ/KioNCg0KYGBge3J9DQphdXRvX2dsbSA8LSBnbG0obXBnMDEgfiBjeWxpbmRlcnMgKyBkaXNwbGFjZW1lbnQgKyB3ZWlnaHQgKyBob3JzZXBvd2VyLCANCiAgICAgICAgICAgICAgZGF0YSA9IHRyYWluX2F1dG8sIA0KICAgICAgICAgICAgICBmYW1pbHkgPSBiaW5vbWlhbCkNCnN1bW1hcnkoYXV0b19nbG0pDQpgYGANCg0KYGBge3J9DQphdXRvX3Byb2JfZ2xtIDwtIHByZWRpY3QoYXV0b19nbG0sDQogICAgICAgICAgICAgICAgICAgdGVzdF9hdXRvLA0KICAgICAgICAgICAgICAgICAgIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZGljdGlvbnNfYXV0byA8LSByZXAoMCwgbGVuZ3RoKGF1dG9fcHJvYl9nbG0pKQ0KcHJlZGljdGlvbnNfYXV0b1thdXRvX3Byb2JfZ2xtID4gMC41XSA8LSAxIA0KdGFibGUocHJlZGljdGlvbnNfYXV0bywgdGVzdF9hdXRvJG1wZzAxKQ0KYGBgDQoNClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDg4LjFcJSQ6DQpgYGB7cn0NCig0Nis1OCkvbnJvdyh0ZXN0X2F1dG8pICogMTAwDQpgYGANCg0KQ29uIHVuIGVycm9yIGRlICQxMS45XCUkOg0KYGBge3J9DQoxMDAgLSAoNDYrNTgpL25yb3codGVzdF9hdXRvKSAqIDEwMA0KYGBgDQoNCioqKGcpUGVyZm9ybSBLTk4gb24gdGhlIHRyYWluaW5nIGRhdGEsIHdpdGggc2V2ZXJhbCB2YWx1ZXMgb2YgSywgaW4gb3JkZXIgdG8gcHJlZGljdCBtcGcwMS4gVXNlIG9ubHkgdGhlIHZhcmlhYmxlcyB0aGF0IHNlZW1lZCBtb3N0IGFzc29jaWF0ZWQgd2l0aCBtcGcwMSBpbiAoYikuIFdoYXQgdGVzdCBlcnJvcnMgZG8geW91IG9idGFpbj8gV2hpY2ggdmFsdWUgb2YgSyBzZWVtcyB0byBwZXJmb3JtIHRoZSBiZXN0IG9uIHRoaXMgZGF0YSBzZXQ/KioNCg0KYGBge3J9DQp0cmFpbl9rbm5fYXV0byA8LSBjYmluZChjeWxpbmRlcnMsIGRpc3BsYWNlbWVudCwgd2VpZ2h0LCBob3JzZXBvd2VyKVt0cmFpbl9hdXRvX2luZGV4LF0NCnRlc3Rfa25uX2F1dG8gPC0gY2JpbmQoY3lsaW5kZXJzLCBkaXNwbGFjZW1lbnQsIHdlaWdodCwgaG9yc2Vwb3dlcilbdGVzdF9hdXRvX2luZGV4LF0NCnRyYWluX2F1dG9fbXBnMDEgPC0gdHJhaW5fYXV0byRtcGcwMQ0KDQpzZXQuc2VlZCAoMSkNCmtubl9wcmVkX2F1dG8gPSBrbm4odHJhaW5fa25uX2F1dG8sDQogICAgICAgICAgICAgICAgICB0ZXN0X2tubl9hdXRvLA0KICAgICAgICAgICAgICAgICAgdHJhaW5fYXV0b19tcGcwMSwgDQogICAgICAgICAgICAgICAgICBrPTEpDQp0YWJsZShrbm5fcHJlZF9hdXRvLCB0ZXN0X2F1dG8kbXBnMDEpDQpgYGANClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDg3LjNcJSQ6DQpgYGB7cn0NCig0NCs1OSkvbnJvdyh0ZXN0X2F1dG8pICogMTAwDQpgYGANCg0KQ29uIHVuIGVycm9yIGRlICQxMi43XCUkOg0KYGBge3J9DQoxMDAgLSAoNDQrNTkpL25yb3codGVzdF9hdXRvKSAqIDEwMA0KYGBgDQoNClVzYW5kbyBvdHJvIHZhbG9yIGRlIGssICRrPTUkOg0KYGBge3J9DQpzZXQuc2VlZCAoMSkNCmtubl9wcmVkX2F1dG8gPSBrbm4odHJhaW5fa25uX2F1dG8sDQogICAgICAgICAgICAgICAgICB0ZXN0X2tubl9hdXRvLA0KICAgICAgICAgICAgICAgICAgdHJhaW5fYXV0b19tcGcwMSwgDQogICAgICAgICAgICAgICAgICBrPTUpDQp0YWJsZShrbm5fcHJlZF9hdXRvLCB0ZXN0X2F1dG8kbXBnMDEpDQpgYGANClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDg2LjRcJSQ6DQpgYGB7cn0NCig0NCs1OCkvbnJvdyh0ZXN0X2F1dG8pICogMTAwDQpgYGANCg0KQ29uIHVuIGVycm9yIGRlICQxMy42XCUkOg0KYGBge3J9DQoxMDAgLSAoNDQrNTgpL25yb3codGVzdF9hdXRvKSAqIDEwMA0KYGBgDQoNCg0KIyMgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0NCg0KKioxMi4gVGhpcyBwcm9ibGVtIGludm9sdmVzIHdyaXRpbmcgZnVuY3Rpb25zLioqDQoqKihhKSBXcml0ZSBhIGZ1bmN0aW9uLCBQb3dlcigpLCB0aGF0IHByaW50cyBvdXQgdGhlIHJlc3VsdCBvZiByYWlzaW5nIDIgdG8gdGhlIDNyZCBwb3dlci4gSW4gb3RoZXIgd29yZHMsIHlvdXIgZnVuY3Rpb24gc2hvdWxkIGNvbXB1dGUgMjMgYW5kIHByaW50IG91dCB0aGUgcmVzdWx0cy4qKg0KYGBge3J9DQpQb3dlciA8LSBmdW5jdGlvbigpew0KICAyXjMNCn0NClBvd2VyKCkNCmBgYA0KDQoqKihiKSBDcmVhdGUgYSBuZXcgZnVuY3Rpb24sIFBvd2VyMigpLCB0aGF0IGFsbG93cyB5b3UgdG8gcGFzcyBhbnkgdHdvIG51bWJlcnMsIHggYW5kIGEsIGFuZCBwcmludHMgb3V0IHRoZSB2YWx1ZSBvZiB4XmEuKioNCmBgYHtyfQ0KUG93ZXIyIDwtIGZ1bmN0aW9uICh4LGEpew0KICB4XmENCn0NClBvd2VyMigzLDgpDQpgYGANCg0KKiooYykgVXNpbmcgdGhlIFBvd2VyMigpIGZ1bmN0aW9uIHRoYXQgeW91IGp1c3Qgd3JvdGUsIGNvbXB1dGUgJDEwXjMkLCQ4XjE3JCwgYW5kICQxMzFeMyQuKioNCmBgYHtyfQ0KUG93ZXIyKDEwLDMpDQpQb3dlcjIoOCwxNykNClBvd2VyMigxMzEsMykNCmBgYA0KDQoqKihkKSBOb3cgY3JlYXRlIGEgbmV3IGZ1bmN0aW9uLCBQb3dlcjMoKSwgdGhhdCBhY3R1YWxseSByZXR1cm5zIHRoZSByZXN1bHQgeF5hIGFzIGFuIFIgb2JqZWN0LCByYXRoZXIgdGhhbiBzaW1wbHkgcHJpbnRpbmcgaXQgdG8gdGhlIHNjcmVlbi4gVGhhdCBpcywgaWYgeW91IHN0b3JlIHRoZSB2YWx1ZSB4XmEgaW4gYW4gb2JqZWN0IGNhbGxlZCByZXN1bHQgd2l0aGluIHlvdXIgZnVuY3Rpb24sIHRoZW4geW91IGNhbiBzaW1wbHkgcmV0dXJuKCkgdGhpcyByZXN1bHQsIHVzaW5nIHRoZSBmb2xsb3dpbmcgbGluZSByZXR1cm4ocmVzdWx0KSoqDQpgYGB7cn0NClBvd2VyMyA8LSBmdW5jdGlvbih4LGEpew0KICByZXMgPC0geF5hDQogIHJldHVybihyZXMpDQp9DQpQb3dlcjMoMyw4KQ0KYGBgDQoNCioqKGUpIE5vdyB1c2luZyB0aGUgUG93ZXIzKCkgZnVuY3Rpb24sIGNyZWF0ZSBhIHBsb3Qgb2YgJGYoeCk9eF4yJC4gVGhlIHgtYXhpcyBzaG91bGQgZGlzcGxheSBhIHJhbmdlIG9mIGludGVnZXJzIGZyb20gMSB0byAxMCwgYW5kIHRoZSB5LWF4aXMgc2hvdWxkIGRpc3BsYXkgJHheMiQuIExhYmVsIHRoZSBheGVzIGFwcHJvcHJpYXRlbHksIGFuZCB1c2UgYW4gYXBwcm9wcmlhdGUgdGl0bGUgZm9yIHRoZSBmaWd1cmUuIENvbnNpZGVyIGRpc3BsYXlpbmcgZWl0aGVyIHRoZSB4LWF4aXMsIHRoZSB5LWF4aXMsIG9yIGJvdGggb24gdGhlIGxvZy1zY2FsZS4gWW91IGNhbiBkbyB0aGlzIGJ5IHVzaW5nIGxvZz0ieCIsIGxvZz0ieSIsIG9yIGxvZz0ieHkiIGFzIGFyZ3VtZW50cyB0byB0aGUgcGxvdCgpIGZ1bmN0aW9uLioqDQpgYGB7cn0NCnBsb3QoMToxMCwgUG93ZXIzKDE6MTAsMiksIHhsYWI9IlgiLCB5bGFiPSJmKFgpIiwgbWFpbj0iRihYKT1YXjIiLCBsb2cgPSAieHkiKQ0KYGBgDQoNCioqKGYpIENyZWF0ZSBhIGZ1bmN0aW9uLCBQbG90UG93ZXIoKSwgdGhhdCBhbGxvd3MgeW91IHRvIGNyZWF0ZSBhIHBsb3Qgb2YgeCBhZ2FpbnN0IHheYSBmb3IgYSBmaXhlZCBhIGFuZCBmb3IgYSByYW5nZSBvZiB2YWx1ZXMgb2YgeC4gRm9yIGluc3RhbmNlLCBpZiB5b3UgY2FsbCBQbG90UG93ZXIgKDE6MTAgLDMpIHRoZW4gYSBwbG90IHNob3VsZCBiZSBjcmVhdGVkKioNCmBgYHtyfQ0KUGxvdFBvd2VyIDwtIGZ1bmN0aW9uKHgsYSl7DQogIHBsb3QoeCwgUG93ZXIzKHgsYSksIHhsYWI9IlgiLCB5bGFiPSJmKFgpIiwgbWFpbj0iRihYKT1YXmEiKQ0KfQ0KUGxvdFBvd2VyKDE6MTAsMykNCmBgYA0KDQoNCiMjIC0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tDQoqKjEzLiBVc2luZyB0aGUgQm9zdG9uIGRhdGEgc2V0LCBmaXQgY2xhc3NpZmljYXRpb24gbW9kZWxzIGluIG9yZGVyIHRvIHByZWRpY3Qgd2hldGhlciBhIGdpdmVuIHN1YnVyYiBoYXMgYSBjcmltZSByYXRlIGFib3ZlIG9yIGJlbG93IHRoZSBtZWRpYW4uIEV4cGxvcmUgbG9naXN0aWMgcmVncmVzc2lvbiwgTERBLCBhbmQgS05OIG1vZGVscyB1c2luZyB2YXJpb3VzIHN1YnNldHMgb2YgdGhlIHByZWRpY3RvcnMuIERlc2NyaWJlIHlvdXIgZmluZGluZ3MuKioNCg0KVXNhbmRvIGVsIHByb2NlZGltaWVudG8gZW4gZWwgZWplcmNpY2lvIGRlbCBkYXRhc2V0IEF1dG86DQpgYGB7cn0NCmF0dGFjaChCb3N0b24pDQpgYGANCmBgYHtyfQ0KY3JpbWVfY2xhc3MgPC0gcmVwKDAsIGxlbmd0aChjcmltKSkNCmNyaW1lX2NsYXNzW2NyaW0gPiBtZWRpYW4oY3JpbSldIDwtIDENCmJvc3RvbiA8LSBkYXRhLmZyYW1lKEJvc3RvbiwgY3JpbWVfY2xhc3MpDQpgYGANCg0KQWhvcmEgZGl2aWRpbW9zIGVuIHRyYWluIHkgdGVzdDoNCmBgYHtyfQ0KdHJhaW5fYm9zdG9uX2luZGV4IDwtIHNhbXBsZSgxOm5yb3coYm9zdG9uKSwgc2l6ZSA9IG5yb3coYm9zdG9uKSowLjcpDQp0cmFpbl9ib3N0b24gPC0gYm9zdG9uW3RyYWluX2Jvc3Rvbl9pbmRleCxdDQp0ZXN0X2Jvc3Rvbl9pbmRleCA8LSBzZXRkaWZmKDE6bnJvdyhib3N0b24pLCB0cmFpbl9ib3N0b25faW5kZXgpDQp0ZXN0X2Jvc3RvbiA8LSBib3N0b25bdGVzdF9ib3N0b25faW5kZXgsXQ0KdGVzdF9jcmltZSA8LSBib3N0b25bdGVzdF9ib3N0b25faW5kZXgsMTVdDQpgYGANCg0KUmVncmVzaW9uIExvZ2lzdGljYToNCmBgYHtyfQ0KYm9zdG9uX2dsbSA8LSBnbG0oY3JpbWVfY2xhc3MgfiB6biArIGluZHVzICsgbm94ICsgcm0gKyBhZ2UgKyBkaXMgKyB0YXggKyBibGFjayArIG1lZHYsIA0KICAgICAgICAgICAgICBkYXRhID0gdHJhaW5fYm9zdG9uLCANCiAgICAgICAgICAgICAgZmFtaWx5ID0gYmlub21pYWwpDQpzdW1tYXJ5KGJvc3Rvbl9nbG0pDQpgYGANCg0KYGBge3J9DQpib3N0b25fcHJvYl9nbG0gPC0gcHJlZGljdChib3N0b25fZ2xtLA0KICAgICAgICAgICAgICAgICAgIHRlc3RfYm9zdG9uLA0KICAgICAgICAgICAgICAgICAgIHR5cGUgPSAicmVzcG9uc2UiKQ0KcHJlZGljdGlvbnNfYm9zdG9uIDwtIHJlcCgwLCBsZW5ndGgoYm9zdG9uX3Byb2JfZ2xtKSkNCnByZWRpY3Rpb25zX2Jvc3Rvbltib3N0b25fcHJvYl9nbG0gPiAwLjVdIDwtIDEgDQp0YWJsZShwcmVkaWN0aW9uc19ib3N0b24sIHRlc3RfY3JpbWUpDQpgYGANCg0KUG9yIGxvIHF1ZSBlbCBwb3JjZW50YWplIGRlIHByZWRpY2Npb24gZGVsIG1vZGVsbyBlcyBkZSAkODUuNVwlJDoNCmBgYHtyfQ0KKDU5KzcxKS9ucm93KHRlc3RfYm9zdG9uKSAqIDEwMA0KYGBgDQoNCkNvbiB1biBlcnJvciBkZSAkMTQuNVwlJDoNCmBgYHtyfQ0KMTAwIC0gKDU5KzcxKS9ucm93KHRlc3RfYm9zdG9uKSAqIDEwMA0KYGBgDQoNClVzYW5kbyBMREE6DQpgYGB7cn0NCmJvc3Rvbl9sZGEgPC0gbGRhKGNyaW1lX2NsYXNzIH4gem4gKyBpbmR1cyArIG5veCArIHJtICsgYWdlICsgZGlzICsgdGF4ICsgYmxhY2sgKyBtZWR2LCANCiAgICAgICAgICAgICAgICBkYXRhID0gdHJhaW5fYm9zdG9uKQ0KYm9zdG9uX2xkYQ0KYGBgDQoNCmBgYHtyfQ0KYm9zdG9uX2xkYV9wcmVkIDwtIHByZWRpY3QoYm9zdG9uX2xkYSwgdGVzdF9ib3N0b24pDQp0YWJsZShib3N0b25fbGRhX3ByZWQkY2xhc3MsIHRlc3RfY3JpbWUpDQpgYGANCg0KUG9yIGxvIHF1ZSBlbCBwb3JjZW50YWplIGRlIHByZWRpY2Npb24gZGVsIG1vZGVsbyBlcyBkZSAkODYuOFwlJDoNCmBgYHtyfQ0KKDY3KzY1KS9ucm93KHRlc3RfYm9zdG9uKSAqIDEwMA0KYGBgDQpDb24gdW4gZXJyb3IgZGUgJDEzLjJcJSQ6DQpgYGB7cn0NCjEwMCAtICg2Nys2NSkvbnJvdyh0ZXN0X2Jvc3RvbikgKiAxMDANCmBgYA0KDQpVc2FuZG8gS25uOg0KYGBge3J9DQp0cmFpbl9rbm5fYm9zdG9uIDwtIGNiaW5kKHpuLCBpbmR1cywgbm94LCBybSwgYWdlLCBkaXMsIHRheCwgYmxhY2ssIG1lZHYpW3RyYWluX2Jvc3Rvbl9pbmRleCxdDQp0ZXN0X2tubl9ib3N0b24gPC0gY2JpbmQoem4sIGluZHVzLCBub3gsIHJtLCBhZ2UsIGRpcywgdGF4LCBibGFjaywgbWVkdilbdGVzdF9ib3N0b25faW5kZXgsXQ0KdHJhaW5fY3JpbWUgPC0gdHJhaW5fYm9zdG9uJGNyaW1lX2NsYXNzDQoNCnNldC5zZWVkICgxKQ0Ka25uX3ByZWRfYm9zdG9uID0ga25uKHRyYWluX2tubl9ib3N0b24sDQogICAgICAgICAgICAgICAgICB0ZXN0X2tubl9ib3N0b24sDQogICAgICAgICAgICAgICAgICB0cmFpbl9jcmltZSwgDQogICAgICAgICAgICAgICAgICBrPTEpDQp0YWJsZShrbm5fcHJlZF9ib3N0b24sIHRlc3RfY3JpbWUpDQpgYGANClBvciBsbyBxdWUgZWwgcG9yY2VudGFqZSBkZSBwcmVkaWNjaW9uIGRlbCBtb2RlbG8gZXMgZGUgJDkwLjhcJSQ6DQpgYGB7cn0NCig2Mys3NSkvbnJvdyh0ZXN0X2Jvc3RvbikgKiAxMDANCmBgYA0KDQpDb24gdW4gZXJyb3IgZGUgJDkuMlwlJDoNCmBgYHtyfQ0KMTAwIC0gKDYzKzc1KS9ucm93KHRlc3RfYm9zdG9uKSAqIDEwMA0KYGBgDQoNClBvciBsbyBxdWUgcG9kZW1vcyB2ZXIgcXVlIGVsIG1vZGVsbyBxdWUgbWVub3IgdGFzYSBkZSBlcnJvciB0aWVuZSBlcyBlbCBLbm4sIHlhIHF1ZSB0aWVuZSB1bmEgdGFzYSBkZSBlcnJvciBkZWwgJDkuMlwlJC4NCg==