Los datos proceden de un estudio sobre diagnóstico del cáncer de mama por imagen. Mediante una punción con aguja fina se extrae una muestra del tejido sospechoso de la paciente. La muestra se tiñe para resaltar los núcleos de las células y se determinan los límites exactos de los núcleos. Las variables consideradas corresponden a distintos aspectos de la forma del núcleo. El fichero contiene un data frame, llamado breast.cancer2, con 2 variables explicativas medidas en pacientes cuyos tumores fueron diagnosticados posteriormente como benignos o malignos y el factor y que toma los valores 0 o 1 en función de si las variables corresponden a un tumor benigno o maligno respectivamente.

En este ejemplo se testearán diferentes algoritmos de aprendizaje para determinar cuál de ellos obtiene mejores resultado en la predicción de los diagnósticos.

if (!require("caret")) { install.packages("caret"); library(caret) }

if (!require("ggplot2")) { install.packages("ggplot2"); library(ggplot2) }
if (!require("lattice")) { install.packages("lattice"); library(lattice) }
load('breastCancer.RData')
dataCancer=breast.cancer2
head(dataCancer)
summary(dataCancer)
  x.smoothness     x.concavepoints   y      
 Min.   :0.05263   Min.   :0.00000   0:357  
 1st Qu.:0.08637   1st Qu.:0.02031   1:212  
 Median :0.09587   Median :0.03350          
 Mean   :0.09636   Mean   :0.04892          
 3rd Qu.:0.10530   3rd Qu.:0.07400          
 Max.   :0.16340   Max.   :0.20120          

Realizaremos una representación gráfica de los datos, dibujando en dos colores diferentes aquellos casos en los que el diagnóstico ha sido benigno o maligno.


summary(dataCancer)
  x.smoothness     x.concavepoints   y      
 Min.   :0.05263   Min.   :0.00000   0:357  
 1st Qu.:0.08637   1st Qu.:0.02031   1:212  
 Median :0.09587   Median :0.03350          
 Mean   :0.09636   Mean   :0.04892          
 3rd Qu.:0.10530   3rd Qu.:0.07400          
 Max.   :0.16340   Max.   :0.20120          
ggplot(dataCancer, aes(x=dataCancer$x.smoothness, y=dataCancer$x.concavepoints, color=y))+
  geom_point()

Si queremos ver cómo está distribuido el dataset en cuanto a tipos de cancer

#Es binario 
ggplot(dataCancer, aes(x = y, color = y)) + geom_bar(stat = "count", aes(fill = y))

Dividir los datos en muestras para entrenamiento y test

Para dividir los datos en una muestra de entrenamiento y otra de test se usa el comando createDataPartition. En el código siguiente p representa la proporción de datos en la muestra de entrenamiento. La partición se lleva a cabo para cada nivel de la variable y que aparece como primer argumento. El resultado es un vector con los índices de las filas seleccionadas para formar parte de la muestra de entrenamiento.

Un aspecto importante, sobre todo pensando en la reproducibilidad de nuestro trabajo, es que si iniciamos al generador de números aleatorios con un valor determinado, la secuencia de números pseudo-aleatorios se va a repetir y por lo tanto podemos reproducir exactamente una simulación estocástica.R utiliza la función set.seed(numero entero) para inicializar el generador de números aleatorios.

set.seed(100)  # Para reproducir los mismos resultados
IndicesEntrenamiento <- createDataPartition(y = dataCancer$y,
                                            p = 0.75,
                                            list = FALSE)
Entrenamiento <- dataCancer[IndicesEntrenamiento,]
Test <- dataCancer[-IndicesEntrenamiento,]

Es importante verificar que la distribución de la variable respuesta es similar en el conjunto de entrenamiento y en el de test. Por defecto, la función createDataPartition() garantiza una distribución aproximada.

# Porcentajes en el dataset original de cada una de las clases
prop.table(table(dataCancer$y))

        0         1 
0.6274165 0.3725835 
#Numero de elementos de cada clase en el dataset de entrenamiento
table(Entrenamiento$y)

  0   1 
268 159 
prop.table(table(Entrenamiento$y))

        0         1 
0.6276347 0.3723653 
#Numero de elementos de cada clase en el dataset de test
table(Test$y)

 0  1 
89 53 
prop.table(table(Test$y))

        0         1 
0.6267606 0.3732394 

En efecto, vemos que para ambos conjuntos, la relación benigo/maligno se mantiene.

El comando train

Se puede usar este comando único para aplicar un gran número de métodos de clasificación determinando (en caso necesario) los valores óptimos de sus parámetros mediante validación cruzada u otros métodos de remuestreo. Para usar train en general es necesario:

K vecinos más próximos

Vamos a entrenar el modelo con el método KNN. Al visualizar el modelo obtenido, se obtiene una tabla donde se muestran las diferentes k’s utilizadas, de la cual se elegirá aquella cuya precisión sea mayor.

modeloKNN <- train(y ~ ., data = Entrenamiento, method = "knn")
modeloKNN
k-Nearest Neighbors 

427 samples
  2 predictor
  2 classes: '0', '1' 

No pre-processing
Resampling: Bootstrapped (25 reps) 
Summary of sample sizes: 427, 427, 427, 427, 427, 427, ... 
Resampling results across tuning parameters:

  k  Accuracy   Kappa   
  5  0.8957298  0.777192
  7  0.9015849  0.788328
  9  0.9064723  0.798766

Accuracy was used to select the optimal model using the largest value.
The final value used for the model was k = 9.
# Predict
predictKNN <- predict(modeloKNN, Test)
# Genera una matriz de confusion
confusionMatrix(predictKNN, Test$y)$table
# Mostrar la precision
confusionMatrix(predictKNN, Test$y)$overall

Revisar el siguiente link (https://rdrr.io/cran/caret/man/confusionMatrix.html) para ver cómo obtener los valores de la precisión de la tabla de confusión.

Arboles

modeloTrees <- train(y ~ ., data = Entrenamiento, method = "rpart")
modeloTrees
CART 

427 samples
  2 predictor
  2 classes: '0', '1' 

No pre-processing
Resampling: Bootstrapped (25 reps) 
Summary of sample sizes: 427, 427, 427, 427, 427, 427, ... 
Resampling results across tuning parameters:

  cp          Accuracy   Kappa    
  0.00000000  0.8879192  0.7561404
  0.01572327  0.9116285  0.8065149
  0.78616352  0.7860269  0.4479170

Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.01572327.
#rpart.plot(modeloTrees$finalModel, main="Classification Tree2")
# Predict
predictTrees <- predict(modeloTrees, Test)
# Genera una matriz de confusion
confusionMatrix(predictTrees, Test$y)$table
          Reference
Prediction  0  1
         0 79  4
         1 10 49
# Mostrar la precision
confusionMatrix(predictTrees, Test$y)$overall
      Accuracy          Kappa  AccuracyLower  AccuracyUpper   AccuracyNull AccuracyPValue 
  9.014085e-01   7.939896e-01   8.401141e-01   9.450435e-01   6.267606e-01   1.063270e-13 
 McnemarPValue 
  1.814492e-01 

Support Vector Machine (SVM)

modelSVM <- train(y ~ ., data = Entrenamiento, method = "svmLinear")
modelSVM
Support Vector Machines with Linear Kernel 

427 samples
  2 predictor
  2 classes: '0', '1' 

No pre-processing
Resampling: Bootstrapped (25 reps) 
Summary of sample sizes: 427, 427, 427, 427, 427, 427, ... 
Resampling results:

  Accuracy   Kappa    
  0.9184446  0.8221616

Tuning parameter 'C' was held constant at a value of 1
# Predict
predictSVN <- predict(modelSVM, Test)
# Genera una matriz de confusion
confusionMatrix(predictSVN, Test$y)$table
          Reference
Prediction  0  1
         0 81  7
         1  8 46
# Mostrar la precision
confusionMatrix(predictSVN, Test$y)$overall
      Accuracy          Kappa  AccuracyLower  AccuracyUpper   AccuracyNull AccuracyPValue 
  8.943662e-01   7.750792e-01   8.317627e-01   9.396605e-01   6.267606e-01   5.498251e-13 
 McnemarPValue 
  1.000000e+00 

Random Forest

modeloRForest <- train(y ~ ., data = Entrenamiento, method = "cforest")
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
modeloRForest
Conditional Inference Random Forest 

427 samples
  2 predictor
  2 classes: '0', '1' 

No pre-processing
Resampling: Bootstrapped (25 reps) 
Summary of sample sizes: 427, 427, 427, 427, 427, 427, ... 
Resampling results:

  Accuracy  Kappa    
  0.909362  0.8044448

Tuning parameter 'mtry' was held constant at a value of 2
# Predict
predictRF <- predict(modeloRForest, Test)
# Genera una matriz de confusion
confusionMatrix(predictRF, Test$y)$table
          Reference
Prediction  0  1
         0 80  7
         1  9 46
# Mostrar la precision
confusionMatrix(predictRF, Test$y)$overall
      Accuracy          Kappa  AccuracyLower  AccuracyUpper   AccuracyNull AccuracyPValue 
  8.873239e-01   7.609931e-01   8.234763e-01   9.342073e-01   6.267606e-01   2.646163e-12 
 McnemarPValue 
  8.025873e-01 

¿Qué modelo es más preciso? Podemos ver que el metodo SVN tiene precision del 100% y accuracy del 89%, pero como el metodo KNN tiene presicion del 100% y accurary del 90%, eligiriamos el KNN.

LS0tCnRpdGxlOiAiQ2xhc2lmaWNhY2nDs24gZGUgdHVtb3JlcyIKb3V0cHV0OiBodG1sX25vdGVib29rCmh0bWxfZG9jdW1lbnQ6CmRmX3ByaW50OiBwYWdlZAoKLS0tCgpMb3MgZGF0b3MgcHJvY2VkZW4gZGUgdW4gZXN0dWRpbyBzb2JyZSBkaWFnbsOzc3RpY28gZGVsIGPDoW5jZXIgZGUgbWFtYSBwb3IgaW1hZ2VuLiBNZWRpYW50ZSB1bmEgcHVuY2nDs24gY29uIGFndWphIGZpbmEgc2UgZXh0cmFlIHVuYSBtdWVzdHJhIGRlbCB0ZWppZG8gc29zcGVjaG9zbyBkZSBsYSBwYWNpZW50ZS4gTGEgbXVlc3RyYSBzZSB0acOxZSBwYXJhIHJlc2FsdGFyIGxvcyBuw7pjbGVvcyBkZSBsYXMgY8OpbHVsYXMgeSBzZSBkZXRlcm1pbmFuIGxvcyBsw61taXRlcyBleGFjdG9zIGRlIGxvcyBuw7pjbGVvcy4gTGFzIHZhcmlhYmxlcyBjb25zaWRlcmFkYXMgY29ycmVzcG9uZGVuIGEgZGlzdGludG9zIGFzcGVjdG9zIGRlIGxhIGZvcm1hIGRlbCBuw7pjbGVvLiBFbCBmaWNoZXJvIGNvbnRpZW5lIHVuIGRhdGEgZnJhbWUsIGxsYW1hZG8gIGJyZWFzdC5jYW5jZXIyLCBjb24gMiB2YXJpYWJsZXMgZXhwbGljYXRpdmFzIG1lZGlkYXMgZW4gcGFjaWVudGVzIGN1eW9zIHR1bW9yZXMgZnVlcm9uIGRpYWdub3N0aWNhZG9zIHBvc3Rlcmlvcm1lbnRlIGNvbW8gYmVuaWdub3MgbyBtYWxpZ25vcyB5IGVsIGZhY3RvciB5IHF1ZSB0b21hIGxvcyB2YWxvcmVzIDAgbyAxIGVuIGZ1bmNpw7NuIGRlIHNpIGxhcyB2YXJpYWJsZXMgY29ycmVzcG9uZGVuIGEgdW4gdHVtb3IgYmVuaWdubyBvIG1hbGlnbm8gcmVzcGVjdGl2YW1lbnRlLiAKCkVuIGVzdGUgZWplbXBsbyBzZSB0ZXN0ZWFyw6FuIGRpZmVyZW50ZXMgYWxnb3JpdG1vcyBkZSBhcHJlbmRpemFqZSBwYXJhIGRldGVybWluYXIgY3XDoWwgZGUgZWxsb3Mgb2J0aWVuZSBtZWpvcmVzIHJlc3VsdGFkbyBlbiBsYSBwcmVkaWNjacOzbiBkZSBsb3MgZGlhZ27Ds3N0aWNvcy4gCgpgYGB7cn0KaWYgKCFyZXF1aXJlKCJjYXJldCIpKSB7IGluc3RhbGwucGFja2FnZXMoImNhcmV0Iik7IGxpYnJhcnkoY2FyZXQpIH0KCmlmICghcmVxdWlyZSgiZ2dwbG90MiIpKSB7IGluc3RhbGwucGFja2FnZXMoImdncGxvdDIiKTsgbGlicmFyeShnZ3Bsb3QyKSB9CmlmICghcmVxdWlyZSgibGF0dGljZSIpKSB7IGluc3RhbGwucGFja2FnZXMoImxhdHRpY2UiKTsgbGlicmFyeShsYXR0aWNlKSB9CgpgYGAKCgoKYGBge3J9CmxvYWQoJ2JyZWFzdENhbmNlci5SRGF0YScpCmRhdGFDYW5jZXI9YnJlYXN0LmNhbmNlcjIKaGVhZChkYXRhQ2FuY2VyKQpzdW1tYXJ5KGRhdGFDYW5jZXIpCgoKYGBgCgpSZWFsaXphcmVtb3MgdW5hIHJlcHJlc2VudGFjacOzbiBncsOhZmljYSBkZSBsb3MgZGF0b3MsIGRpYnVqYW5kbyBlbiBkb3MgY29sb3JlcyBkaWZlcmVudGVzIGFxdWVsbG9zIGNhc29zIGVuIGxvcyBxdWUgZWwgZGlhZ27Ds3N0aWNvIGhhIHNpZG8gYmVuaWdubyBvIG1hbGlnbm8uICAKCmBgYHtyfQoKc3VtbWFyeShkYXRhQ2FuY2VyKQpnZ3Bsb3QoZGF0YUNhbmNlciwgYWVzKHg9ZGF0YUNhbmNlciR4LnNtb290aG5lc3MsIHk9ZGF0YUNhbmNlciR4LmNvbmNhdmVwb2ludHMsIGNvbG9yPXkpKSsKICBnZW9tX3BvaW50KCkKCmBgYAoKCgpTaSBxdWVyZW1vcyB2ZXIgY8OzbW8gZXN0w6EgZGlzdHJpYnVpZG8gZWwgZGF0YXNldCBlbiBjdWFudG8gYSB0aXBvcyBkZSBjYW5jZXIKCmBgYHtyfQojRXMgYmluYXJpbyAKZ2dwbG90KGRhdGFDYW5jZXIsIGFlcyh4ID0geSwgY29sb3IgPSB5KSkgKyBnZW9tX2JhcihzdGF0ID0gImNvdW50IiwgYWVzKGZpbGwgPSB5KSkKYGBgCgoKIyBEaXZpZGlyIGxvcyBkYXRvcyBlbiBtdWVzdHJhcyBwYXJhIGVudHJlbmFtaWVudG8geSB0ZXN0CgpQYXJhIGRpdmlkaXIgbG9zIGRhdG9zIGVuIHVuYSBtdWVzdHJhIGRlIGVudHJlbmFtaWVudG8geSBvdHJhIGRlIHRlc3Qgc2UgdXNhIGVsIGNvbWFuZG8gY3JlYXRlRGF0YVBhcnRpdGlvbi4gRW4gZWwgY8OzZGlnbyBzaWd1aWVudGUgcCByZXByZXNlbnRhIGxhIHByb3BvcmNpw7NuIGRlIGRhdG9zIGVuIGxhIG11ZXN0cmEgZGUgZW50cmVuYW1pZW50by4gTGEgcGFydGljacOzbiBzZSBsbGV2YSBhIGNhYm8gcGFyYSBjYWRhIG5pdmVsIGRlIGxhIHZhcmlhYmxlIHkgcXVlIGFwYXJlY2UgY29tbyBwcmltZXIgYXJndW1lbnRvLiBFbCByZXN1bHRhZG8gZXMgdW4gdmVjdG9yIGNvbiBsb3Mgw61uZGljZXMgZGUgbGFzIGZpbGFzIHNlbGVjY2lvbmFkYXMgcGFyYSBmb3JtYXIgcGFydGUgZGUgbGEgbXVlc3RyYSBkZSBlbnRyZW5hbWllbnRvLiAKClVuIGFzcGVjdG8gaW1wb3J0YW50ZSwgc29icmUgdG9kbyBwZW5zYW5kbyBlbiBsYSByZXByb2R1Y2liaWxpZGFkIGRlIG51ZXN0cm8gdHJhYmFqbywgZXMgcXVlIHNpIGluaWNpYW1vcyBhbCBnZW5lcmFkb3IgZGUgbsO6bWVyb3MgYWxlYXRvcmlvcyBjb24gdW4gdmFsb3IgZGV0ZXJtaW5hZG8sIGxhIHNlY3VlbmNpYSBkZSBuw7ptZXJvcyBwc2V1ZG8tYWxlYXRvcmlvcyBzZSB2YSBhIHJlcGV0aXIgeSBwb3IgbG8gdGFudG8gcG9kZW1vcyByZXByb2R1Y2lyIGV4YWN0YW1lbnRlIHVuYSBzaW11bGFjacOzbiBlc3RvY8Ohc3RpY2EuUiB1dGlsaXphIGxhIGZ1bmNpw7NuIHNldC5zZWVkKG51bWVybyBlbnRlcm8pIHBhcmEgaW5pY2lhbGl6YXIgZWwgZ2VuZXJhZG9yIGRlIG7Dum1lcm9zIGFsZWF0b3Jpb3MuCgpgYGB7cn0Kc2V0LnNlZWQoMTAwKSAgIyBQYXJhIHJlcHJvZHVjaXIgbG9zIG1pc21vcyByZXN1bHRhZG9zCkluZGljZXNFbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oeSA9IGRhdGFDYW5jZXIkeSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwID0gMC43NSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsaXN0ID0gRkFMU0UpCkVudHJlbmFtaWVudG8gPC0gZGF0YUNhbmNlcltJbmRpY2VzRW50cmVuYW1pZW50byxdClRlc3QgPC0gZGF0YUNhbmNlclstSW5kaWNlc0VudHJlbmFtaWVudG8sXQpgYGAKCgpFcyBpbXBvcnRhbnRlIHZlcmlmaWNhciBxdWUgbGEgZGlzdHJpYnVjacOzbiBkZSBsYSB2YXJpYWJsZSByZXNwdWVzdGEgZXMgc2ltaWxhciBlbiBlbCBjb25qdW50byBkZSBlbnRyZW5hbWllbnRvIHkgZW4gZWwgZGUgdGVzdC4gUG9yIGRlZmVjdG8sIGxhIGZ1bmNpw7NuIGNyZWF0ZURhdGFQYXJ0aXRpb24oKSBnYXJhbnRpemEgdW5hIGRpc3RyaWJ1Y2nDs24gYXByb3hpbWFkYS4KYGBge3J9CiMgUG9yY2VudGFqZXMgZW4gZWwgZGF0YXNldCBvcmlnaW5hbCBkZSBjYWRhIHVuYSBkZSBsYXMgY2xhc2VzCnByb3AudGFibGUodGFibGUoZGF0YUNhbmNlciR5KSkKI051bWVybyBkZSBlbGVtZW50b3MgZGUgY2FkYSBjbGFzZSBlbiBlbCBkYXRhc2V0IGRlIGVudHJlbmFtaWVudG8KdGFibGUoRW50cmVuYW1pZW50byR5KQpwcm9wLnRhYmxlKHRhYmxlKEVudHJlbmFtaWVudG8keSkpCiNOdW1lcm8gZGUgZWxlbWVudG9zIGRlIGNhZGEgY2xhc2UgZW4gZWwgZGF0YXNldCBkZSB0ZXN0CnRhYmxlKFRlc3QkeSkKcHJvcC50YWJsZSh0YWJsZShUZXN0JHkpKQoKYGBgCkVuIGVmZWN0bywgdmVtb3MgcXVlIHBhcmEgYW1ib3MgY29uanVudG9zLCBsYSByZWxhY2nDs24gYmVuaWdvL21hbGlnbm8gc2UgbWFudGllbmUuCgojIEVsIGNvbWFuZG8gdHJhaW4KClNlIHB1ZWRlIHVzYXIgZXN0ZSBjb21hbmRvIMO6bmljbyBwYXJhIGFwbGljYXIgdW4gZ3JhbiBuw7ptZXJvIGRlIG3DqXRvZG9zIGRlIGNsYXNpZmljYWNpw7NuIGRldGVybWluYW5kbyAoZW4gY2FzbyBuZWNlc2FyaW8pIGxvcyB2YWxvcmVzIMOzcHRpbW9zIGRlIHN1cyBwYXLDoW1ldHJvcyBtZWRpYW50ZSB2YWxpZGFjacOzbiBjcnV6YWRhIHUgb3Ryb3MgbcOpdG9kb3MgZGUgcmVtdWVzdHJlby4gUGFyYSB1c2FyICB0cmFpbiBlbiBnZW5lcmFsIGVzIG5lY2VzYXJpbzoKCiogRWxlZ2lyIGVsIG3DqXRvZG8gZGUgY2xhc2lmaWNhY2nDs24gcXVlIHF1ZXJlbW9zIHVzYXIuIEVsIGNhdMOhbG9nbyBkZSB0b2RvcyBsb3MgbcOpdG9kb3MgZGlzcG9uaWJsZXMgc2UgcHVlZGUgY29uc3VsdGFyIGVuIGVzdGUgZW5sYWNlLiBVbmEgaW5mb3JtYWNpw7NuIHTDqWNuaWNhIGRldGFsbGFkYSBkZSBjYWRhIG3DqXRvZG8gc2UgcHVlZGUgb2J0ZW5lciBjb24gZWwgY29tYW5kbyBnZXRNb2RlbEluZm8uCgoqIFNpIGVsIG3DqXRvZG8gZGUgY2xhc2lmaWNhY2nDs24gcmVxdWllcmUgZGV0ZXJtaW5hciBwYXLDoW1ldHJvcywgZXMgbmVjZXNhcmlvIGZpamFyIGN1w6FsZXMgeSBlbiBxdcOpIHJhbmdvIGRlIHZhbG9yZXMuCgoqIFRhbWJpw6luIGhheSBxdWUgZGVmaW5pciBlbCBtw6l0b2RvIGRlIHJlbXVlc3RyZW8gcXVlIHNlIHZhIGEgdXRpbGl6YXIgcGFyYSBkZXRlcm1pbmFyIGVzdG9zIHBhcsOhbWV0cm9zLgoKCiMgSyB2ZWNpbm9zIG3DoXMgcHLDs3hpbW9zCgpWYW1vcyBhIGVudHJlbmFyIGVsIG1vZGVsbyBjb24gZWwgbcOpdG9kbyBLTk4uCkFsIHZpc3VhbGl6YXIgZWwgbW9kZWxvIG9idGVuaWRvLCBzZSBvYnRpZW5lIHVuYSB0YWJsYSBkb25kZSBzZSBtdWVzdHJhbiBsYXMgZGlmZXJlbnRlcyBrJ3MgdXRpbGl6YWRhcywgZGUgbGEgY3VhbCBzZSBlbGVnaXLDoSBhcXVlbGxhIGN1eWEgcHJlY2lzacOzbiBzZWEgbWF5b3IuIAoKYGBge3J9Cm1vZGVsb0tOTiA8LSB0cmFpbih5IH4gLiwgZGF0YSA9IEVudHJlbmFtaWVudG8sIG1ldGhvZCA9ICJrbm4iKQptb2RlbG9LTk4KYGBgCgpgYGB7cn0KIyBQcmVkaWN0CnByZWRpY3RLTk4gPC0gcHJlZGljdChtb2RlbG9LTk4sIFRlc3QpCiMgR2VuZXJhIHVuYSBtYXRyaXogZGUgY29uZnVzaW9uCmNvbmZ1c2lvbk1hdHJpeChwcmVkaWN0S05OLCBUZXN0JHkpJHRhYmxlCiMgTW9zdHJhciBsYSBwcmVjaXNpb24KY29uZnVzaW9uTWF0cml4KHByZWRpY3RLTk4sIFRlc3QkeSkkb3ZlcmFsbAoKCmBgYAoKUmV2aXNhciBlbCBzaWd1aWVudGUgbGluayAoaHR0cHM6Ly9yZHJyLmlvL2NyYW4vY2FyZXQvbWFuL2NvbmZ1c2lvbk1hdHJpeC5odG1sKSBwYXJhIHZlciBjw7NtbyBvYnRlbmVyIGxvcyB2YWxvcmVzIGRlIGxhIHByZWNpc2nDs24gZGUgbGEgdGFibGEgZGUgY29uZnVzacOzbi4gCgojIEFyYm9sZXMKYGBge3J9Cm1vZGVsb1RyZWVzIDwtIHRyYWluKHkgfiAuLCBkYXRhID0gRW50cmVuYW1pZW50bywgbWV0aG9kID0gInJwYXJ0IikKbW9kZWxvVHJlZXMKI3JwYXJ0LnBsb3QobW9kZWxvVHJlZXMkZmluYWxNb2RlbCwgbWFpbj0iQ2xhc3NpZmljYXRpb24gVHJlZTIiKQpgYGAKCgpgYGB7cn0KIyBQcmVkaWN0CnByZWRpY3RUcmVlcyA8LSBwcmVkaWN0KG1vZGVsb1RyZWVzLCBUZXN0KQojIEdlbmVyYSB1bmEgbWF0cml6IGRlIGNvbmZ1c2lvbgpjb25mdXNpb25NYXRyaXgocHJlZGljdFRyZWVzLCBUZXN0JHkpJHRhYmxlCiMgTW9zdHJhciBsYSBwcmVjaXNpb24KY29uZnVzaW9uTWF0cml4KHByZWRpY3RUcmVlcywgVGVzdCR5KSRvdmVyYWxsCmBgYAoKCiMgU3VwcG9ydCBWZWN0b3IgTWFjaGluZSAoU1ZNKQoKCmBgYHtyfQptb2RlbFNWTSA8LSB0cmFpbih5IH4gLiwgZGF0YSA9IEVudHJlbmFtaWVudG8sIG1ldGhvZCA9ICJzdm1MaW5lYXIiKQptb2RlbFNWTQpgYGAKCgpgYGB7cn0KIyBQcmVkaWN0CnByZWRpY3RTVk4gPC0gcHJlZGljdChtb2RlbFNWTSwgVGVzdCkKIyBHZW5lcmEgdW5hIG1hdHJpeiBkZSBjb25mdXNpb24KY29uZnVzaW9uTWF0cml4KHByZWRpY3RTVk4sIFRlc3QkeSkkdGFibGUKIyBNb3N0cmFyIGxhIHByZWNpc2lvbgpjb25mdXNpb25NYXRyaXgocHJlZGljdFNWTiwgVGVzdCR5KSRvdmVyYWxsCgpgYGAKCgoKIyBSYW5kb20gRm9yZXN0CgpgYGB7cn0KbW9kZWxvUkZvcmVzdCA8LSB0cmFpbih5IH4gLiwgZGF0YSA9IEVudHJlbmFtaWVudG8sIG1ldGhvZCA9ICJjZm9yZXN0IikKbW9kZWxvUkZvcmVzdAoKYGBgCgoKYGBge3J9CiMgUHJlZGljdApwcmVkaWN0UkYgPC0gcHJlZGljdChtb2RlbG9SRm9yZXN0LCBUZXN0KQojIEdlbmVyYSB1bmEgbWF0cml6IGRlIGNvbmZ1c2lvbgpjb25mdXNpb25NYXRyaXgocHJlZGljdFJGLCBUZXN0JHkpJHRhYmxlCiMgTW9zdHJhciBsYSBwcmVjaXNpb24KY29uZnVzaW9uTWF0cml4KHByZWRpY3RSRiwgVGVzdCR5KSRvdmVyYWxsCmBgYAoKCgrCv1F1w6kgbW9kZWxvIGVzIG3DoXMgcHJlY2lzbz8gClBvZGVtb3MgdmVyIHF1ZSBlbCBtZXRvZG8gU1ZOIHRpZW5lIHByZWNpc2lvbiBkZWwgMTAwJSB5IGFjY3VyYWN5IGRlbCA4OSUsIHBlcm8gY29tbyBlbCBtZXRvZG8gS05OIHRpZW5lIHByZXNpY2lvbiBkZWwgMTAwJSB5IGFjY3VyYXJ5IGRlbCA5MCUsIGVsaWdpcmlhbW9zIGVsIEtOTi4K