Tensorflow with R

pkgs <- c("keras", "lime", "rsample", "recipes", "yardstick", "corrr")
install.packages(pkgs)

Parsed with column specification:
cols(
  .default = col_character(),
  SeniorCitizen = col_double(),
  tenure = col_double(),
  MonthlyCharges = col_double(),
  TotalCharges = col_double()
)
See spec(...) for full column specifications.

glimpse(churn_data_raw)

Observations: 7,043
Variables: 21
$ customerID       <chr> "7590-VHVEG", "5575-GNVDE", "3668-QPYBK", "7795-CFOCW", "9237-H...
$ gender           <chr> "Female", "Male", "Male", "Male", "Female", "Female", "Male", "...
$ SeniorCitizen    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, ...
$ Partner          <chr> "Yes", "No", "No", "No", "No", "No", "No", "No", "Yes", "No", "...
$ Dependents       <chr> "No", "No", "No", "No", "No", "No", "Yes", "No", "No", "Yes", "...
$ tenure           <dbl> 1, 34, 2, 45, 2, 8, 22, 10, 28, 62, 13, 16, 58, 49, 25, 69, 52,...
$ PhoneService     <chr> "No", "Yes", "Yes", "No", "Yes", "Yes", "Yes", "No", "Yes", "Ye...
$ MultipleLines    <chr> "No phone service", "No", "No", "No phone service", "No", "Yes"...
$ InternetService  <chr> "DSL", "DSL", "DSL", "DSL", "Fiber optic", "Fiber optic", "Fibe...
$ OnlineSecurity   <chr> "No", "Yes", "Yes", "Yes", "No", "No", "No", "Yes", "No", "Yes"...
$ OnlineBackup     <chr> "Yes", "No", "Yes", "No", "No", "No", "Yes", "No", "No", "Yes",...
$ DeviceProtection <chr> "No", "Yes", "No", "Yes", "No", "Yes", "No", "No", "Yes", "No",...
$ TechSupport      <chr> "No", "No", "No", "Yes", "No", "No", "No", "No", "Yes", "No", "...
$ StreamingTV      <chr> "No", "No", "No", "No", "No", "Yes", "Yes", "No", "Yes", "No", ...
$ StreamingMovies  <chr> "No", "No", "No", "No", "No", "Yes", "No", "No", "Yes", "No", "...
$ Contract         <chr> "Month-to-month", "One year", "Month-to-month", "One year", "Mo...
$ PaperlessBilling <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "Yes", "No", "Yes", "No...
$ PaymentMethod    <chr> "Electronic check", "Mailed check", "Mailed check", "Bank trans...
$ MonthlyCharges   <dbl> 29.85, 56.95, 53.85, 42.30, 70.70, 99.65, 89.10, 29.75, 104.80,...
$ TotalCharges     <dbl> 29.85, 1889.50, 108.15, 1840.75, 151.65, 820.50, 1949.40, 301.9...
$ Churn            <chr> "No", "No", "Yes", "No", "Yes", "Yes", "No", "No", "Yes", "No",...

library(rsample)

set.seed(100)

train_test_split <- initial_split(
  churn_data_raw, 
  prop = 0.3)

train_tbl <- training(train_test_split)
test_tbl  <- testing(train_test_split)

library(recipes)

rec_obj <- train_tbl %>%
  recipe(Churn ~ .) %>%
  step_rm(customerID) %>%
  step_naomit(all_outcomes(), all_predictors()) %>%
  step_discretize(tenure, options = list(cuts = 6)) %>%
  step_log(TotalCharges) %>%
  step_mutate(Churn = ifelse(Churn == "Yes", 1, 0)) %>%
  step_dummy(all_nominal(), -all_outcomes()) %>%
  step_center(all_predictors(), -all_outcomes()) %>%
  step_scale(all_predictors(), -all_outcomes()) %>%
  prep()

summary(rec_obj)

save(rec_obj, file = "../shiny-app/rec_obj.RData")

x_train_tbl <- juice(rec_obj, all_predictors(), composition = "matrix") 
y_train_vec <- juice(rec_obj, all_outcomes()) %>% pull()

baked_test <- bake(rec_obj, test_tbl)

x_test_tbl <- baked_test %>%
  select(-Churn) %>%
  as.matrix()

y_test_vec <- baked_test %>%
  select(Churn) %>%
  pull()

library(tensorflow)
library(keras)

#install_tensorflow()
#install_keras()

model_keras <- keras_model_sequential() %>%
  layer_dense(
    units = 16, 
    kernel_initializer = "uniform", 
    activation = "relu", 
    input_shape = ncol(x_train_tbl)) %>% 
  layer_dropout(rate = 0.1) %>%
  layer_dense(
    units = 16, 
    kernel_initializer = "uniform", 
    activation = "relu") %>% 
  layer_dropout(rate = 0.1) %>%
  layer_dense(
    units = 1, 
    kernel_initializer = "uniform", 
    activation = "sigmoid") %>% 
  compile(
    optimizer = 'adam',
    loss = 'binary_crossentropy',
    metrics = c('accuracy')
  )

model_keras

Model
_____________________________________________________________________________________________
Layer (type)                             Output Shape                          Param #       
=============================================================================================
dense_1 (Dense)                          (None, 16)                            576           
_____________________________________________________________________________________________
dropout_1 (Dropout)                      (None, 16)                            0             
_____________________________________________________________________________________________
dense_2 (Dense)                          (None, 16)                            272           
_____________________________________________________________________________________________
dropout_2 (Dropout)                      (None, 16)                            0             
_____________________________________________________________________________________________
dense_3 (Dense)                          (None, 1)                             17            
=============================================================================================
Total params: 865
Trainable params: 865
Non-trainable params: 0
_____________________________________________________________________________________________

# Fit the keras model to the training data
history <- fit(
  object = model_keras, 
  x = x_train_tbl, 
  y = y_train_vec,
  batch_size = 50, 
  epochs = 35,
  validation_split = 0.30,
  verbose = 0
)

2019-03-13 13:43:31.622924: I T:\src\github\tensorflow\tensorflow\core\platform\cpu_feature_guard.cc:141] Your CPU supports instructions that this TensorFlow binary was not compiled to use: AVX2

print(history)

Trained on 1,478 samples, validated on 634 samples (batch_size=50, epochs=35)
Final epoch (plot to see history):
val_loss: 0.4457
 val_acc: 0.7981
    loss: 0.3909
     acc: 0.816 

theme_set(theme_bw())

# Plot the training/validation history of our Keras model
plot(history) 

# Predicted Class
yhat_keras_class_vec <- model_keras %>%
  predict_classes(x_test_tbl) %>%
  as.factor() %>%
  fct_recode(yes = "1", no = "0")

# Predicted Class Probability
yhat_keras_prob_vec  <- model_keras %>%
  predict_proba(x_test_tbl) %>%
  as.vector()

test_truth <- y_test_vec %>% 
  as.factor() %>% 
  fct_recode(yes = "1", no = "0")

# Format test data and predictions for yardstick metrics
estimates_keras_tbl <- tibble(
  truth      = test_truth,
  estimate   = yhat_keras_class_vec,
  class_prob = yhat_keras_prob_vec
)

estimates_keras_tbl

library(yardstick)

options(yardstick.event_first = FALSE)

# Confusion Table
estimates_keras_tbl %>% 
  conf_mat(truth, estimate)

          Truth
Prediction   no  yes
       no  3247  564
       yes  378  731

# Accuracy
estimates_keras_tbl %>% 
  metrics(truth, estimate)

# AUC
estimates_keras_tbl %>% 
  roc_auc(truth, class_prob)

# Precision
estimates_keras_tbl %>%
  precision(truth, estimate) %>%
  bind_rows(
    estimates_keras_tbl %>% 
      recall(truth, estimate) 
  ) 

# F1-Statistic
estimates_keras_tbl %>% 
  f_meas(truth, estimate, beta = 1)

library(lime)

model_type.keras.engine.sequential.Sequential <- function(x, ...) {
  "classification"
}
# Setup lime::predict_model() function for keras
predict_model.keras.engine.sequential.Sequential <- function(x, newdata, type, ...) {
  pred <- predict_proba(object = x, x = as.matrix(newdata))
  data.frame(Yes = pred, No = 1 - pred)
}

# Test our predict_model() function
model_keras %>%
  predict_model(x_test_tbl, "raw") %>%
  as_tibble()

library(lime)

# Run lime() on training set
explainer <- x_train_tbl %>%
  as_tibble() %>% 
  lime(model_keras, 
       bin_continuous = FALSE)
  
# Run explain() on explainer
explanation <-  x_train_tbl %>%
  as.data.frame() %>%
  head(40) %>%
  lime::explain(
    explainer    = explainer, 
    n_labels     = 1, 
    n_features   = 4,
    kernel_width = 0.5
    )

plot_explanations(explanation) +
  labs(title = "LIME Feature Importance Heatmap",
       subtitle = "Hold Out (Test) Set, First 40 Cases Shown")

library(corrr)

corrr_analysis <- x_train_tbl %>%
  as_tibble() %>%
  mutate(Churn = y_train_vec) %>%
  correlate() %>%
  focus(Churn) %>%
  rename(feature = rowname) %>%
  arrange(abs(Churn)) %>%
  mutate(feature = as_factor(feature)) 

Correlation method: 'pearson'
Missing treated using: 'pairwise.complete.obs'

corrr_analysis

over <- corrr_analysis %>%
  filter(Churn > 0)

under <- corrr_analysis %>%
  filter(Churn < 0)

corrr_analysis %>%
  ggplot(aes(x = Churn, y = fct_reorder(feature, desc(Churn)))) +
    geom_point() +
    geom_segment(aes(xend = 0, yend = feature), data = under, color = "orange") +
    geom_point(data = under, color = "orange") +
    geom_segment(aes(xend = 0, yend = feature), data = over, color = "blue") +
    geom_point(data = over, color = "blue") +
  labs(title = "Churn correlations", y = "")

NA

churn_data_raw %>%
  group_by(Contract, Churn) %>%
  tally() %>%
  spread(Churn, n)

churn_data_raw %>%
  group_by(InternetService, Churn) %>%
  tally() %>%
  spread(Churn, n)

export_savedmodel(model_keras, "tfmodel")

library(rsconnect)
deployTFModel(
  "tfmodel", 
  server = "colorado.rstudio.com", 
  account = rstudioapi::askForPassword("Enter Connect Username:")
  )

library(httr)

baked_numeric <- x_test_tbl %>%
  as_tibble() %>%
  head(4) %>%
  transpose() %>%
  map(as.numeric)

body <- list(instances = list(baked_numeric))

r <- POST("https://colorado.rstudio.com/rsc/content/2230/serving_default/predict", body = body, encode = "json")

jsonlite::fromJSON(content(r))$predictions[, , 1]

[1] 0.5589350 0.2727856 0.5589350 0.5589350

LS0tDQp0aXRsZTogIlRlbnNvcmZsb3cgd2l0aCBSIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyMgSW5zdGFsbCBuZWNlc3NhcnkgcGFja2FnZXMNCg0KYGBge3IsIGV2YWwgPSBGQUxTRX0NCnBrZ3MgPC0gYygia2VyYXMiLCAibGltZSIsICJyc2FtcGxlIiwgInJlY2lwZXMiLCAieWFyZHN0aWNrIiwgImNvcnJyIikNCmluc3RhbGwucGFja2FnZXMocGtncykNCmBgYA0KDQpgYGB7ciwgaW5jbHVkZSA9IEZBTFNFfQ0KbGlicmFyeShrZXJhcykNCmxpYnJhcnkobGltZSkNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShyc2FtcGxlKQ0KbGlicmFyeShyZWNpcGVzKQ0KbGlicmFyeSh5YXJkc3RpY2spDQpsaWJyYXJ5KGNvcnJyKQ0KbGlicmFyeSh0ZW5zb3JmbG93KQ0KYGBgDQoNCiMjIHRpZHl2ZXJzZQ0KDQpodHRwOi8vdGlkeXZlcnNlLm9yZy8NCg0KVGhlIGB0aWR5dmVyc2VgIHBhY2thZ2VzIHByb3ZpZGUgYW4gZWFzeSB3YXkgdG8gKippbXBvcnQqKiwgKip0aWR5KiosICoqdHJhbnNmb3JtKiogYW5kICoqdmlzdWFsaXplKiogdGhlIGRhdGEuICBTb21lIG9mIGl0J3MgY29tcG9uZW50IFIgcGFja2FnZXMgYXJlOg0KDQotIGBkcGx5cmANCi0gYHRpZHlyYA0KLSBgcmVhZHJgDQotIGBnZ3Bsb3QyYA0KDQoNCmBgYHtyLCBlY2hvID0gRkFMU0V9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCg0KaWYoIWZpbGUuZXhpc3RzKCJjdXN0b21lcl9jaHVybi5jc3YiKSl7DQogIGRvd25sb2FkLmZpbGUoDQogICAgImh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9yc3R1ZGlvL2tlcmFzLWN1c3RvbWVyLWNodXJuL21hc3Rlci9kYXRhL1dBX0ZuLVVzZUNfLVRlbGNvLUN1c3RvbWVyLUNodXJuLmNzdiIsDQogICAgImN1c3RvbWVyX2NodXJuLmNzdiINCiAgKSANCn0NCg0KY2h1cm5fZGF0YV9yYXcgPC0gcmVhZF9jc3YoImN1c3RvbWVyX2NodXJuLmNzdiIpDQpgYGANCg0KYGBge3J9DQpnbGltcHNlKGNodXJuX2RhdGFfcmF3KQ0KYGBgDQoNCg0KIyMgcnNhbXBsZQ0KDQpodHRwczovL3RpZHltb2RlbHMuZ2l0aHViLmlvL3JzYW1wbGUvDQoNCmByc2FtcGxlYCBjb250YWlucyBhIHNldCBvZiBmdW5jdGlvbnMgdGhhdCBjYW4gY3JlYXRlIGRpZmZlcmVudCB0eXBlcyBvZiByZXNhbXBsZXMgYW5kIGNvcnJlc3BvbmRpbmcgY2xhc3NlcyBmb3IgdGhlaXIgYW5hbHlzaXMuIFRoZSBnb2FsIGlzIHRvIGhhdmUgYSBtb2R1bGFyIHNldCBvZiBtZXRob2RzIHRoYXQgY2FuIGJlIHVzZWQgYWNyb3NzIGRpZmZlcmVudCBSIHBhY2thZ2VzIGZvcjoNCg0KdHJhZGl0aW9uYWwgcmVzYW1wbGluZyB0ZWNobmlxdWVzIGZvciBlc3RpbWF0aW5nIHRoZSBzYW1wbGluZyBkaXN0cmlidXRpb24gb2YgYSBzdGF0aXN0aWMgYW5kDQplc3RpbWF0aW5nIG1vZGVsIHBlcmZvcm1hbmNlIHVzaW5nIGEgaG9sZG91dCBzZXQNCg0KYGBge3J9DQpsaWJyYXJ5KHJzYW1wbGUpDQoNCnNldC5zZWVkKDEwMCkNCg0KdHJhaW5fdGVzdF9zcGxpdCA8LSBpbml0aWFsX3NwbGl0KA0KICBjaHVybl9kYXRhX3JhdywgDQogIHByb3AgPSAwLjMpDQoNCnRyYWluX3RibCA8LSB0cmFpbmluZyh0cmFpbl90ZXN0X3NwbGl0KQ0KdGVzdF90YmwgIDwtIHRlc3RpbmcodHJhaW5fdGVzdF9zcGxpdCkNCmBgYA0KDQojIyByZWNpcGVzDQoNCmh0dHBzOi8vdGlkeW1vZGVscy5naXRodWIuaW8vcmVjaXBlcy8NCg0KVGhlIGByZWNpcGVzYCBwYWNrYWdlIGlzIGFuIGFsdGVybmF0aXZlIG1ldGhvZCBmb3IgY3JlYXRpbmcgYW5kIHByZXByb2Nlc3NpbmcgZGVzaWduIG1hdHJpY2VzIHRoYXQgY2FuIGJlIHVzZWQgZm9yIG1vZGVsaW5nIG9yIHZpc3VhbGl6YXRpb24uIA0KDQpgYGB7cn0NCmxpYnJhcnkocmVjaXBlcykNCg0KcmVjX29iaiA8LSB0cmFpbl90YmwgJT4lDQogIHJlY2lwZShDaHVybiB+IC4pICU+JQ0KICBzdGVwX3JtKGN1c3RvbWVySUQpICU+JQ0KICBzdGVwX25hb21pdChhbGxfb3V0Y29tZXMoKSwgYWxsX3ByZWRpY3RvcnMoKSkgJT4lDQogIHN0ZXBfZGlzY3JldGl6ZSh0ZW51cmUsIG9wdGlvbnMgPSBsaXN0KGN1dHMgPSA2KSkgJT4lDQogIHN0ZXBfbG9nKFRvdGFsQ2hhcmdlcykgJT4lDQogIHN0ZXBfbXV0YXRlKENodXJuID0gaWZlbHNlKENodXJuID09ICJZZXMiLCAxLCAwKSkgJT4lDQogIHN0ZXBfZHVtbXkoYWxsX25vbWluYWwoKSwgLWFsbF9vdXRjb21lcygpKSAlPiUNCiAgc3RlcF9jZW50ZXIoYWxsX3ByZWRpY3RvcnMoKSwgLWFsbF9vdXRjb21lcygpKSAlPiUNCiAgc3RlcF9zY2FsZShhbGxfcHJlZGljdG9ycygpLCAtYWxsX291dGNvbWVzKCkpICU+JQ0KICBwcmVwKCkNCg0Kc3VtbWFyeShyZWNfb2JqKQ0KYGBgDQoNClNhdmUgdGhlIHJlY2lwZSBmaWxlIGludG8gdGhlIFNoaW55IGZvbGRlciBmb3IgbGF0ZXIgdXNlDQpgYGB7cn0NCnNhdmUocmVjX29iaiwgZmlsZSA9ICIuLi9zaGlueS1hcHAvcmVjX29iai5SRGF0YSIpDQpgYGANCg0KVXNlIGBqdWljZSgpYCB0byBleHRhcmN0IHRoZSByZXN1bHRzIGZyb20gdGhlIG1vZGVsIHByZXBhcmF0aW9uLiBUaGUgcHJlZGljdG9yIGFuZCBvdXRjb21lIGRhdGEgYXJlIHByb2Nlc3NlZCBzZXBhcmF0ZWx5LiAgVGhpcyBpcyBiZWNhdXNlIGhvdyBLZXJhcyBleHBlY3RzIHRoZXNlIGFyZ3VtZW50cyB0byBiZSB1c2VkIHdoZW4gZml0dGluZyBhIG1vZGVsLg0KDQpgYGB7cn0NCnhfdHJhaW5fdGJsIDwtIGp1aWNlKHJlY19vYmosIGFsbF9wcmVkaWN0b3JzKCksIGNvbXBvc2l0aW9uID0gIm1hdHJpeCIpIA0KeV90cmFpbl92ZWMgPC0ganVpY2UocmVjX29iaiwgYWxsX291dGNvbWVzKCkpICU+JSBwdWxsKCkNCmBgYA0KDQpUaGUgc2FtZSBpcyBkb25lIHdpdGggdGhlIHRlc3RpbmcgZGF0YSBzbyB0aGF0IHRoZSB0d28gY2FuIGJlIGNvbXBhcmVkLg0KDQpgYGB7cn0NCmJha2VkX3Rlc3QgPC0gYmFrZShyZWNfb2JqLCB0ZXN0X3RibCkNCg0KeF90ZXN0X3RibCA8LSBiYWtlZF90ZXN0ICU+JQ0KICBzZWxlY3QoLUNodXJuKSAlPiUNCiAgYXMubWF0cml4KCkNCg0KeV90ZXN0X3ZlYyA8LSBiYWtlZF90ZXN0ICU+JQ0KICBzZWxlY3QoQ2h1cm4pICU+JQ0KICBwdWxsKCkNCmBgYA0KDQoNCiMjIEluc3RhbGwgVGVuc29yZmxvdyAmIEtlcmFzDQoNCmh0dHBzOi8vdGVuc29yZmxvdy5yc3R1ZGlvLmNvbS90ZW5zb3JmbG93L2FydGljbGVzL2luc3RhbGxhdGlvbi5odG1sDQoNCmh0dHBzOi8vdGVuc29yZmxvdy5yc3R1ZGlvLmNvbS9rZXJhcy8jaW5zdGFsbGF0aW9uDQoNCmBgYHtyLCBldmFsID0gRkFMU0UgfQ0KbGlicmFyeSh0ZW5zb3JmbG93KQ0KbGlicmFyeShrZXJhcykNCg0KI2luc3RhbGxfdGVuc29yZmxvdygpDQojaW5zdGFsbF9rZXJhcygpDQpgYGANCg0KDQojIyMgQ3JlYXRlIE5ldXJhbCBOZXR3b3JrDQoNCmBgYHtyfQ0KbW9kZWxfa2VyYXMgPC0ga2VyYXNfbW9kZWxfc2VxdWVudGlhbCgpICU+JQ0KICBsYXllcl9kZW5zZSgNCiAgICB1bml0cyA9IDE2LCANCiAgICBrZXJuZWxfaW5pdGlhbGl6ZXIgPSAidW5pZm9ybSIsIA0KICAgIGFjdGl2YXRpb24gPSAicmVsdSIsIA0KICAgIGlucHV0X3NoYXBlID0gbmNvbCh4X3RyYWluX3RibCkpICU+JSANCiAgbGF5ZXJfZHJvcG91dChyYXRlID0gMC4xKSAlPiUNCiAgbGF5ZXJfZGVuc2UoDQogICAgdW5pdHMgPSAxNiwgDQogICAga2VybmVsX2luaXRpYWxpemVyID0gInVuaWZvcm0iLCANCiAgICBhY3RpdmF0aW9uID0gInJlbHUiKSAlPiUgDQogIGxheWVyX2Ryb3BvdXQocmF0ZSA9IDAuMSkgJT4lDQogIGxheWVyX2RlbnNlKA0KICAgIHVuaXRzID0gMSwgDQogICAga2VybmVsX2luaXRpYWxpemVyID0gInVuaWZvcm0iLCANCiAgICBhY3RpdmF0aW9uID0gInNpZ21vaWQiKSAlPiUgDQogIGNvbXBpbGUoDQogICAgb3B0aW1pemVyID0gJ2FkYW0nLA0KICAgIGxvc3MgPSAnYmluYXJ5X2Nyb3NzZW50cm9weScsDQogICAgbWV0cmljcyA9IGMoJ2FjY3VyYWN5JykNCiAgKQ0KDQptb2RlbF9rZXJhcw0KYGBgDQoNCiMjIyBGaXQgbW9kZWwNCg0KYGBge3J9DQojIEZpdCB0aGUga2VyYXMgbW9kZWwgdG8gdGhlIHRyYWluaW5nIGRhdGENCmhpc3RvcnkgPC0gZml0KA0KICBvYmplY3QgPSBtb2RlbF9rZXJhcywgDQogIHggPSB4X3RyYWluX3RibCwgDQogIHkgPSB5X3RyYWluX3ZlYywNCiAgYmF0Y2hfc2l6ZSA9IDUwLCANCiAgZXBvY2hzID0gMzUsDQogIHZhbGlkYXRpb25fc3BsaXQgPSAwLjMwLA0KICB2ZXJib3NlID0gMA0KKQ0KDQpwcmludChoaXN0b3J5KQ0KYGBgDQoNCiMjIyBQcmV2aWV3IHJlc3VsdHMNCg0KYGBge3J9DQp0aGVtZV9zZXQodGhlbWVfYncoKSkNCg0KIyBQbG90IHRoZSB0cmFpbmluZy92YWxpZGF0aW9uIGhpc3Rvcnkgb2Ygb3VyIEtlcmFzIG1vZGVsDQpwbG90KGhpc3RvcnkpIA0KYGBgDQoNCmBgYHtyfQ0KIyBQcmVkaWN0ZWQgQ2xhc3MNCnloYXRfa2VyYXNfY2xhc3NfdmVjIDwtIG1vZGVsX2tlcmFzICU+JQ0KICBwcmVkaWN0X2NsYXNzZXMoeF90ZXN0X3RibCkgJT4lDQogIGFzLmZhY3RvcigpICU+JQ0KICBmY3RfcmVjb2RlKHllcyA9ICIxIiwgbm8gPSAiMCIpDQoNCiMgUHJlZGljdGVkIENsYXNzIFByb2JhYmlsaXR5DQp5aGF0X2tlcmFzX3Byb2JfdmVjICA8LSBtb2RlbF9rZXJhcyAlPiUNCiAgcHJlZGljdF9wcm9iYSh4X3Rlc3RfdGJsKSAlPiUNCiAgYXMudmVjdG9yKCkNCg0KdGVzdF90cnV0aCA8LSB5X3Rlc3RfdmVjICU+JSANCiAgYXMuZmFjdG9yKCkgJT4lIA0KICBmY3RfcmVjb2RlKHllcyA9ICIxIiwgbm8gPSAiMCIpDQoNCiMgRm9ybWF0IHRlc3QgZGF0YSBhbmQgcHJlZGljdGlvbnMgZm9yIHlhcmRzdGljayBtZXRyaWNzDQplc3RpbWF0ZXNfa2VyYXNfdGJsIDwtIHRpYmJsZSgNCiAgdHJ1dGggICAgICA9IHRlc3RfdHJ1dGgsDQogIGVzdGltYXRlICAgPSB5aGF0X2tlcmFzX2NsYXNzX3ZlYywNCiAgY2xhc3NfcHJvYiA9IHloYXRfa2VyYXNfcHJvYl92ZWMNCikNCg0KZXN0aW1hdGVzX2tlcmFzX3RibA0KYGBgDQoNCg0KIyMgeWFyZHN0aWNrDQoNCmh0dHBzOi8vdGlkeW1vZGVscy5naXRodWIuaW8veWFyZHN0aWNrLw0KDQpgeWFyZHN0aWNrYCBpcyBhIHBhY2thZ2UgdG8gZXN0aW1hdGUgaG93IHdlbGwgbW9kZWxzIGFyZSB3b3JraW5nIHVzaW5nIHRpZHkgZGF0YSBwcmluY2lwYWxzLg0KDQpgYGB7cn0NCmxpYnJhcnkoeWFyZHN0aWNrKQ0KDQpvcHRpb25zKHlhcmRzdGljay5ldmVudF9maXJzdCA9IEZBTFNFKQ0KDQojIENvbmZ1c2lvbiBUYWJsZQ0KZXN0aW1hdGVzX2tlcmFzX3RibCAlPiUgDQogIGNvbmZfbWF0KHRydXRoLCBlc3RpbWF0ZSkNCg0KIyBBY2N1cmFjeQ0KZXN0aW1hdGVzX2tlcmFzX3RibCAlPiUgDQogIG1ldHJpY3ModHJ1dGgsIGVzdGltYXRlKQ0KDQojIEFVQw0KZXN0aW1hdGVzX2tlcmFzX3RibCAlPiUgDQogIHJvY19hdWModHJ1dGgsIGNsYXNzX3Byb2IpDQoNCiMgUHJlY2lzaW9uDQplc3RpbWF0ZXNfa2VyYXNfdGJsICU+JQ0KICBwcmVjaXNpb24odHJ1dGgsIGVzdGltYXRlKSAlPiUNCiAgYmluZF9yb3dzKA0KICAgIGVzdGltYXRlc19rZXJhc190YmwgJT4lIA0KICAgICAgcmVjYWxsKHRydXRoLCBlc3RpbWF0ZSkgDQogICkgDQoNCiMgRjEtU3RhdGlzdGljDQplc3RpbWF0ZXNfa2VyYXNfdGJsICU+JSANCiAgZl9tZWFzKHRydXRoLCBlc3RpbWF0ZSwgYmV0YSA9IDEpDQpgYGANCg0KIyMgbGltZQ0KDQpodHRwczovL2dpdGh1Yi5jb20vdGhvbWFzcDg1L2xpbWUNCg0KVGhlIHB1cnBvc2Ugb2YgYGxpbWVgIGlzIHRvIGV4cGxhaW4gdGhlIHByZWRpY3Rpb25zIG9mIGJsYWNrIGJveCBjbGFzc2lmaWVycy4gV2hhdCB0aGlzIG1lYW5zIGlzIHRoYXQgZm9yIGFueSBnaXZlbiBwcmVkaWN0aW9uIGFuZCBhbnkgZ2l2ZW4gY2xhc3NpZmllciBpdCBpcyBhYmxlIHRvIGRldGVybWluZSBhIHNtYWxsIHNldCBvZiBmZWF0dXJlcyBpbiB0aGUgb3JpZ2luYWwgZGF0YSB0aGF0IGhhcyBkcml2ZW4gdGhlIG91dGNvbWUgb2YgdGhlIHByZWRpY3Rpb24uIA0KDQpgYGB7cn0NCmxpYnJhcnkobGltZSkNCg0KbW9kZWxfdHlwZS5rZXJhcy5lbmdpbmUuc2VxdWVudGlhbC5TZXF1ZW50aWFsIDwtIGZ1bmN0aW9uKHgsIC4uLikgew0KICAiY2xhc3NpZmljYXRpb24iDQp9DQojIFNldHVwIGxpbWU6OnByZWRpY3RfbW9kZWwoKSBmdW5jdGlvbiBmb3Iga2VyYXMNCnByZWRpY3RfbW9kZWwua2VyYXMuZW5naW5lLnNlcXVlbnRpYWwuU2VxdWVudGlhbCA8LSBmdW5jdGlvbih4LCBuZXdkYXRhLCB0eXBlLCAuLi4pIHsNCiAgcHJlZCA8LSBwcmVkaWN0X3Byb2JhKG9iamVjdCA9IHgsIHggPSBhcy5tYXRyaXgobmV3ZGF0YSkpDQogIGRhdGEuZnJhbWUoWWVzID0gcHJlZCwgTm8gPSAxIC0gcHJlZCkNCn0NCmBgYA0KDQoNCmBgYHtyfQ0KIyBUZXN0IG91ciBwcmVkaWN0X21vZGVsKCkgZnVuY3Rpb24NCm1vZGVsX2tlcmFzICU+JQ0KICBwcmVkaWN0X21vZGVsKHhfdGVzdF90YmwsICJyYXciKSAlPiUNCiAgYXNfdGliYmxlKCkNCmBgYA0KDQoNCmBgYHtyfQ0KbGlicmFyeShsaW1lKQ0KDQojIFJ1biBsaW1lKCkgb24gdHJhaW5pbmcgc2V0DQpleHBsYWluZXIgPC0geF90cmFpbl90YmwgJT4lDQogIGFzX3RpYmJsZSgpICU+JSANCiAgbGltZShtb2RlbF9rZXJhcywgDQogICAgICAgYmluX2NvbnRpbnVvdXMgPSBGQUxTRSkNCiAgDQojIFJ1biBleHBsYWluKCkgb24gZXhwbGFpbmVyDQpleHBsYW5hdGlvbiA8LSAgeF90cmFpbl90YmwgJT4lDQogIGFzLmRhdGEuZnJhbWUoKSAlPiUNCiAgaGVhZCg0MCkgJT4lDQogIGxpbWU6OmV4cGxhaW4oDQogICAgZXhwbGFpbmVyICAgID0gZXhwbGFpbmVyLCANCiAgICBuX2xhYmVscyAgICAgPSAxLCANCiAgICBuX2ZlYXR1cmVzICAgPSA0LA0KICAgIGtlcm5lbF93aWR0aCA9IDAuNQ0KICAgICkNCmBgYA0KDQoNCmBgYHtyLCBmaWcud2lkdGggPSAxMH0NCnBsb3RfZXhwbGFuYXRpb25zKGV4cGxhbmF0aW9uKSArDQogIGxhYnModGl0bGUgPSAiTElNRSBGZWF0dXJlIEltcG9ydGFuY2UgSGVhdG1hcCIsDQogICAgICAgc3VidGl0bGUgPSAiSG9sZCBPdXQgKFRlc3QpIFNldCwgRmlyc3QgNDAgQ2FzZXMgU2hvd24iKQ0KYGBgDQoNCg0KIyMgY29ycnINCg0KaHR0cHM6Ly9naXRodWIuY29tL2Ryc2ltb25qL2NvcnJyDQoNCmBjb3JycmAgaXMgYSBwYWNrYWdlIGZvciBleHBsb3JpbmcgY29ycmVsYXRpb25zIGluIFIuIEl0IGZvY3VzZXMgb24gY3JlYXRpbmcgYW5kIHdvcmtpbmcgd2l0aCBkYXRhIGZyYW1lcyBvZiBjb3JyZWxhdGlvbnMgKGluc3RlYWQgb2YgbWF0cmljZXMpIHRoYXQgY2FuIGJlIGVhc2lseSBleHBsb3JlZCB2aWEgY29ycnIgZnVuY3Rpb25zIG9yIGJ5IGxldmVyYWdpbmcgdG9vbHMgbGlrZSB0aG9zZSBpbiB0aGUgYHRpZHl2ZXJzZS5gIA0KDQpgYGB7cn0NCmxpYnJhcnkoY29ycnIpDQoNCmNvcnJyX2FuYWx5c2lzIDwtIHhfdHJhaW5fdGJsICU+JQ0KICBhc190aWJibGUoKSAlPiUNCiAgbXV0YXRlKENodXJuID0geV90cmFpbl92ZWMpICU+JQ0KICBjb3JyZWxhdGUoKSAlPiUNCiAgZm9jdXMoQ2h1cm4pICU+JQ0KICByZW5hbWUoZmVhdHVyZSA9IHJvd25hbWUpICU+JQ0KICBhcnJhbmdlKGFicyhDaHVybikpICU+JQ0KICBtdXRhdGUoZmVhdHVyZSA9IGFzX2ZhY3RvcihmZWF0dXJlKSkgDQoNCmNvcnJyX2FuYWx5c2lzDQpgYGANCg0KYGBge3IsIGZpZy5oZWlnaHQgPSA3LCBmaWcud2lkdGggPSA3fQ0Kb3ZlciA8LSBjb3Jycl9hbmFseXNpcyAlPiUNCiAgZmlsdGVyKENodXJuID4gMCkNCg0KdW5kZXIgPC0gY29ycnJfYW5hbHlzaXMgJT4lDQogIGZpbHRlcihDaHVybiA8IDApDQoNCmNvcnJyX2FuYWx5c2lzICU+JQ0KICBnZ3Bsb3QoYWVzKHggPSBDaHVybiwgeSA9IGZjdF9yZW9yZGVyKGZlYXR1cmUsIGRlc2MoQ2h1cm4pKSkpICsNCiAgICBnZW9tX3BvaW50KCkgKw0KICAgIGdlb21fc2VnbWVudChhZXMoeGVuZCA9IDAsIHllbmQgPSBmZWF0dXJlKSwgZGF0YSA9IHVuZGVyLCBjb2xvciA9ICJvcmFuZ2UiKSArDQogICAgZ2VvbV9wb2ludChkYXRhID0gdW5kZXIsIGNvbG9yID0gIm9yYW5nZSIpICsNCiAgICBnZW9tX3NlZ21lbnQoYWVzKHhlbmQgPSAwLCB5ZW5kID0gZmVhdHVyZSksIGRhdGEgPSBvdmVyLCBjb2xvciA9ICJibHVlIikgKw0KICAgIGdlb21fcG9pbnQoZGF0YSA9IG92ZXIsIGNvbG9yID0gImJsdWUiKSArDQogIGxhYnModGl0bGUgPSAiQ2h1cm4gY29ycmVsYXRpb25zIiwgeSA9ICIiKQ0KICANCmBgYA0KDQoNCiMjIFNvbWUgbW9yZSBleHBsb3JhdGlvbg0KDQpgYGB7cn0NCmNodXJuX2RhdGFfcmF3ICU+JQ0KICBncm91cF9ieShDb250cmFjdCwgQ2h1cm4pICU+JQ0KICB0YWxseSgpICU+JQ0KICBzcHJlYWQoQ2h1cm4sIG4pDQpgYGANCg0KDQpgYGB7cn0NCmNodXJuX2RhdGFfcmF3ICU+JQ0KICBncm91cF9ieShJbnRlcm5ldFNlcnZpY2UsIENodXJuKSAlPiUNCiAgdGFsbHkoKSAlPiUNCiAgc3ByZWFkKENodXJuLCBuKQ0KYGBgDQoNCiMjIERlcGxveWluZyB0aGUgbW9kZWwNCg0KIyMjIFNhdmUgdGhlIEtlcmFzIG1vZGVsDQoNCmBgYHtyLCBldmFsID0gRkFMU0V9DQpleHBvcnRfc2F2ZWRtb2RlbChtb2RlbF9rZXJhcywgInRmbW9kZWwiKQ0KYGBgDQoNCiMjIERlcGxveSB0byBSU3R1ZGlvIENvbm5lY3QNCg0KYGBge3IsZXZhbCA9IEZBTFNFfQ0KbGlicmFyeShyc2Nvbm5lY3QpDQpkZXBsb3lURk1vZGVsKA0KICAidGZtb2RlbCIsIA0KICBzZXJ2ZXIgPSAiY29sb3JhZG8ucnN0dWRpby5jb20iLCANCiAgYWNjb3VudCA9IHJzdHVkaW9hcGk6OmFza0ZvclBhc3N3b3JkKCJFbnRlciBDb25uZWN0IFVzZXJuYW1lOiIpDQogICkNCmBgYA0KDQojIyMgVGVzdCB0aGUgZGVwbG95ZWQgbW9kZWwNCg0KYGBge3J9DQpsaWJyYXJ5KGh0dHIpDQoNCmJha2VkX251bWVyaWMgPC0geF90ZXN0X3RibCAlPiUNCiAgYXNfdGliYmxlKCkgJT4lDQogIGhlYWQoNCkgJT4lDQogIHRyYW5zcG9zZSgpICU+JQ0KICBtYXAoYXMubnVtZXJpYykNCg0KYm9keSA8LSBsaXN0KGluc3RhbmNlcyA9IGxpc3QoYmFrZWRfbnVtZXJpYykpDQoNCnIgPC0gUE9TVCgiaHR0cHM6Ly9jb2xvcmFkby5yc3R1ZGlvLmNvbS9yc2MvY29udGVudC8yMjMwL3NlcnZpbmdfZGVmYXVsdC9wcmVkaWN0IiwgYm9keSA9IGJvZHksIGVuY29kZSA9ICJqc29uIikNCg0KanNvbmxpdGU6OmZyb21KU09OKGNvbnRlbnQocikpJHByZWRpY3Rpb25zWywgLCAxXQ0KYGBgDQo=