Teoría

La regresion logistica es una metodo de aprendizaje automatico que sirve para predecir la probabilidad de que ocurra un evento categorico, con dos resultados posibles: Si (1) o No (0).

Contexto

Una empresa de servicios por suscripcion ha observado un incremento en la perdida de clientes, fenomeno conocido como Customer Churn. Se busca un modelo para estimar la probabilidad de que un cliente abandone el servicio.

Instalar paquetes y librerías

#install.packages("caret") # Modelos de aprendizaje automatico
library(caret)

#install.packages("tidyverse") # Manipulacion de datos
library(tidyverse)

#install.packages("pROC") # Calculo del area bajo la curva
library(pROC)

Crear la base de datos

#file.choose()
df <- read.csv("/Users/danaraesparzamacias/Desktop/Concentracion AI /customer_churn.csv") 

Entender los datos

df <- na.omit(df)
df$CustomerID <- NULL
df$Gender <- as.factor(df$Gender)
df$Subscription.Type <- as.factor(df$Subscription.Type)
df$Contract.Length <- as.factor(df$Contract.Length)
df$Churn <- as.factor(df$Churn)
summary(df)
##       Age           Gender           Tenure      Usage.Frequency
##  Min.   :18.00   Female:190580   Min.   : 1.00   Min.   : 1.00  
##  1st Qu.:29.00   Male  :250252   1st Qu.:16.00   1st Qu.: 9.00  
##  Median :39.00                   Median :32.00   Median :16.00  
##  Mean   :39.37                   Mean   :31.26   Mean   :15.81  
##  3rd Qu.:48.00                   3rd Qu.:46.00   3rd Qu.:23.00  
##  Max.   :65.00                   Max.   :60.00   Max.   :30.00  
##  Support.Calls    Payment.Delay   Subscription.Type  Contract.Length  
##  Min.   : 0.000   Min.   : 0.00   Basic   :143026   Annual   :177198  
##  1st Qu.: 1.000   1st Qu.: 6.00   Premium :148678   Monthly  : 87104  
##  Median : 3.000   Median :12.00   Standard:149128   Quarterly:176530  
##  Mean   : 3.604   Mean   :12.97                                       
##  3rd Qu.: 6.000   3rd Qu.:19.00                                       
##  Max.   :10.000   Max.   :30.00                                       
##   Total.Spend     Last.Interaction Churn     
##  Min.   : 100.0   Min.   : 1.00    0:190833  
##  1st Qu.: 480.0   1st Qu.: 7.00    1:249999  
##  Median : 661.0   Median :14.00              
##  Mean   : 631.6   Mean   :14.48              
##  3rd Qu.: 830.0   3rd Qu.:22.00              
##  Max.   :1000.0   Max.   :30.00
str(df)
## 'data.frame':    440832 obs. of  11 variables:
##  $ Age              : int  30 65 55 58 23 51 58 55 39 64 ...
##  $ Gender           : Factor w/ 2 levels "Female","Male": 1 1 1 2 2 2 1 1 2 1 ...
##  $ Tenure           : int  39 49 14 38 32 33 49 37 12 3 ...
##  $ Usage.Frequency  : int  14 1 4 21 20 25 12 8 5 25 ...
##  $ Support.Calls    : int  5 10 6 7 5 9 3 4 7 2 ...
##  $ Payment.Delay    : int  18 8 18 7 8 26 16 15 4 11 ...
##  $ Subscription.Type: Factor w/ 3 levels "Basic","Premium",..: 3 1 1 3 1 2 3 2 3 3 ...
##  $ Contract.Length  : Factor w/ 3 levels "Annual","Monthly",..: 1 2 3 2 2 1 3 1 3 3 ...
##  $ Total.Spend      : num  932 557 185 396 617 129 821 445 969 415 ...
##  $ Last.Interaction : int  17 6 3 29 20 8 24 30 13 29 ...
##  $ Churn            : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
##  - attr(*, "na.action")= 'omit' Named int 199296
##   ..- attr(*, "names")= chr "199296"

Partir la base de datos

set.seed(123)
renglones_entrenamiento <- createDataPartition(df$Churn, p=0.7, list=FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]

Modelo de regresión logistica

modelo <- glm(Churn ~., data=entrenamiento, family=binomial)
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(modelo)
## 
## Call:
## glm(formula = Churn ~ ., family = binomial, data = entrenamiento)
## 
## Coefficients:
##                             Estimate Std. Error  z value Pr(>|z|)    
## (Intercept)               -7.811e-01  4.126e-02  -18.932  < 2e-16 ***
## Age                        3.566e-02  5.896e-04   60.489  < 2e-16 ***
## GenderMale                -1.156e+00  1.410e-02  -81.997  < 2e-16 ***
## Tenure                    -7.916e-03  3.801e-04  -20.828  < 2e-16 ***
## Usage.Frequency           -1.475e-02  7.657e-04  -19.265  < 2e-16 ***
## Support.Calls              7.423e-01  3.642e-03  203.852  < 2e-16 ***
## Payment.Delay              1.115e-01  9.302e-04  119.835  < 2e-16 ***
## Subscription.TypePremium  -1.265e-01  1.606e-02   -7.877 3.35e-15 ***
## Subscription.TypeStandard -1.112e-01  1.605e-02   -6.928 4.27e-12 ***
## Contract.LengthMonthly     2.020e+01  3.174e+01    0.637    0.524    
## Contract.LengthQuarterly   8.920e-04  1.305e-02    0.068    0.946    
## Total.Spend               -6.017e-03  3.648e-05 -164.949  < 2e-16 ***
## Last.Interaction           6.120e-02  8.162e-04   74.990  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 422213  on 308583  degrees of freedom
## Residual deviance: 151251  on 308571  degrees of freedom
## AIC: 151277
## 
## Number of Fisher Scoring iterations: 18
exp(coef(modelo))
##               (Intercept)                       Age                GenderMale 
##              4.579154e-01              1.036308e+00              3.146693e-01 
##                    Tenure           Usage.Frequency             Support.Calls 
##              9.921152e-01              9.853576e-01              2.100844e+00 
##             Payment.Delay  Subscription.TypePremium Subscription.TypeStandard 
##              1.117928e+00              8.811827e-01              8.947526e-01 
##    Contract.LengthMonthly  Contract.LengthQuarterly               Total.Spend 
##              5.941648e+08              1.000892e+00              9.940013e-01 
##          Last.Interaction 
##              1.063116e+00
# Interpretacion: Por cada año de edad, la probabilidad de abandono crece 3.9%. 

resultado_entrenamiento <- predict(modelo, entrenamiento)
resultado_prueba <- predict(modelo,prueba)

Predicción

nuevo_cliente <- data.frame(
  Age=58,
  Gender="Male",
  Tenure=38,
  Usage.Frequency=21,
  Support.Calls=7,
  Payment.Delay=7,
  Subscription.Type="Standard",
  Contract.Length="Monthly",
  Total.Spend=396,
  Last.Interaction=29
)

predict(modelo, newdata=nuevo_cliente, type="response")
## 1 
## 1

Customer Churn Risk Score

Calcular el riesgo de abandono

resultado_riesgo <- predict(
  modelo,
  newdata = df,
  type = "response"
)

# Crear el Customer Churn Risk Score
# Convertimos la probabilidad a una escala de 0 a 100 para que sea más fácil de interpretar.
df_riesgo <- df %>%
  mutate(
    churn_risk_score = resultado_riesgo * 100
  )

Asignar nivel de riesgo

df_riesgo <- df_riesgo %>%
  mutate(
    nivel_riesgo = case_when(
      churn_risk_score >= 80 ~ "Riesgo Muy Alto",
      churn_risk_score >= 60 ~ "Riesgo Alto",
      churn_risk_score >= 40 ~ "Riesgo Medio",
      churn_risk_score >= 20 ~ "Riesgo Bajo",
      TRUE ~ "Riesgo Muy Bajo"
    )
  )

head(df_riesgo)
##   Age Gender Tenure Usage.Frequency Support.Calls Payment.Delay
## 1  30 Female     39              14             5            18
## 2  65 Female     49               1            10             8
## 3  55 Female     14               4             6            18
## 4  58   Male     38              21             7             7
## 5  23   Male     32              20             5             8
## 6  51   Male     33              25             9            26
##   Subscription.Type Contract.Length Total.Spend Last.Interaction Churn
## 1          Standard          Annual         932               17     1
## 2             Basic         Monthly         557                6     1
## 3             Basic       Quarterly         185                3     1
## 4          Standard         Monthly         396               29     1
## 5             Basic         Monthly         617               20     1
## 6           Premium          Annual         129                8     1
##   churn_risk_score    nivel_riesgo
## 1         69.28683     Riesgo Alto
## 2        100.00000 Riesgo Muy Alto
## 3         99.85614 Riesgo Muy Alto
## 4        100.00000 Riesgo Muy Alto
## 5        100.00000 Riesgo Muy Alto
## 6         99.97792 Riesgo Muy Alto

Cantidad de clientes por nivel de riesgo

df_riesgo %>%
  count(nivel_riesgo)
##      nivel_riesgo      n
## 1     Riesgo Alto  25938
## 2     Riesgo Bajo  41757
## 3    Riesgo Medio  26968
## 4 Riesgo Muy Alto 201234
## 5 Riesgo Muy Bajo 144935
# Porcentaje de clientes por nivel de riesgo
df_riesgo %>%
  count(nivel_riesgo) %>%
  mutate(
    porcentaje = n / sum(n) * 100
  )
##      nivel_riesgo      n porcentaje
## 1     Riesgo Alto  25938   5.883874
## 2     Riesgo Bajo  41757   9.472316
## 3    Riesgo Medio  26968   6.117523
## 4 Riesgo Muy Alto 201234  45.648682
## 5 Riesgo Muy Bajo 144935  32.877604

Identificar a los clientes con mayor riesgo

clientes_muy_alto_riesgo <- df_riesgo %>%
  filter(nivel_riesgo == "Riesgo Muy Alto") %>%
  arrange(desc(churn_risk_score))

head(clientes_muy_alto_riesgo)
##   Age Gender Tenure Usage.Frequency Support.Calls Payment.Delay
## 1  65   Male     14              12             9            30
## 2  56 Female     40              26            10            24
## 3  65 Female     16              29             8            27
## 4  59 Female     29               4            10            25
## 5  45 Female      5              11             8            29
## 6  45 Female      7              14             9            23
##   Subscription.Type Contract.Length Total.Spend Last.Interaction Churn
## 1           Premium         Monthly         158               18     1
## 2             Basic         Monthly         184                5     1
## 3             Basic         Monthly         295               27     1
## 4          Standard         Monthly         212                7     1
## 5           Premium         Monthly         262               28     1
## 6          Standard         Monthly         176               26     1
##   churn_risk_score    nivel_riesgo
## 1              100 Riesgo Muy Alto
## 2              100 Riesgo Muy Alto
## 3              100 Riesgo Muy Alto
## 4              100 Riesgo Muy Alto
## 5              100 Riesgo Muy Alto
## 6              100 Riesgo Muy Alto

Perfil con base en el nivel de riesgo

df_riesgo %>%
  group_by(nivel_riesgo) %>%
  summarise(
    clientes = n(),
    edad_promedio = mean(Age),
    antiguedad_promedio = mean(Tenure),
    frecuencia_uso = mean(Usage.Frequency),
    llamadas_soporte = mean(Support.Calls),
    retrasos_pago = mean(Payment.Delay),
    gasto_promedio = mean(Total.Spend),
    interaccion_promedio = mean(Last.Interaction),
    score_promedio = mean(churn_risk_score)
  )
## # A tibble: 5 × 10
##   nivel_riesgo    clientes edad_promedio antiguedad_promedio frecuencia_uso
##   <chr>              <int>         <dbl>               <dbl>          <dbl>
## 1 Riesgo Alto        25938          41.5                30.6           15.5
## 2 Riesgo Bajo        41757          39.2                31.3           15.9
## 3 Riesgo Medio       26968          40.7                30.9           15.5
## 4 Riesgo Muy Alto   201234          42.2                30.3           15.4
## 5 Riesgo Muy Bajo   144935          34.8                32.8           16.5
## # ℹ 5 more variables: llamadas_soporte <dbl>, retrasos_pago <dbl>,
## #   gasto_promedio <dbl>, interaccion_promedio <dbl>, score_promedio <dbl>

Asignar una estrategia a cada grupo

df_riesgo <- df_riesgo %>%
  mutate(
    estrategia = case_when(
      nivel_riesgo == "Riesgo Muy Alto" ~ 
        "Contacto inmediato y oferta de retención",
      
      nivel_riesgo == "Riesgo Alto" ~ 
        "Descuento o beneficio personalizado",
      
      nivel_riesgo == "Riesgo Medio" ~ 
        "Incentivar uso y ofrecer beneficios",
      
      nivel_riesgo == "Riesgo Bajo" ~ 
        "Mantener comunicación y engagement",
      
      nivel_riesgo == "Riesgo Muy Bajo" ~ 
        "Mantener relación y monitorear"
    )
  )

Resultado del análisis

head(df_riesgo)
##   Age Gender Tenure Usage.Frequency Support.Calls Payment.Delay
## 1  30 Female     39              14             5            18
## 2  65 Female     49               1            10             8
## 3  55 Female     14               4             6            18
## 4  58   Male     38              21             7             7
## 5  23   Male     32              20             5             8
## 6  51   Male     33              25             9            26
##   Subscription.Type Contract.Length Total.Spend Last.Interaction Churn
## 1          Standard          Annual         932               17     1
## 2             Basic         Monthly         557                6     1
## 3             Basic       Quarterly         185                3     1
## 4          Standard         Monthly         396               29     1
## 5             Basic         Monthly         617               20     1
## 6           Premium          Annual         129                8     1
##   churn_risk_score    nivel_riesgo                               estrategia
## 1         69.28683     Riesgo Alto      Descuento o beneficio personalizado
## 2        100.00000 Riesgo Muy Alto Contacto inmediato y oferta de retención
## 3         99.85614 Riesgo Muy Alto Contacto inmediato y oferta de retención
## 4        100.00000 Riesgo Muy Alto Contacto inmediato y oferta de retención
## 5        100.00000 Riesgo Muy Alto Contacto inmediato y oferta de retención
## 6         99.97792 Riesgo Muy Alto Contacto inmediato y oferta de retención

Estrategias para cada grupo de cliente

df_riesgo %>%
  select(nivel_riesgo, estrategia) %>%
  distinct()
##      nivel_riesgo                               estrategia
## 1     Riesgo Alto      Descuento o beneficio personalizado
## 2 Riesgo Muy Alto Contacto inmediato y oferta de retención
## 3    Riesgo Medio      Incentivar uso y ofrecer beneficios
## 4 Riesgo Muy Bajo           Mantener relación y monitorear
## 5     Riesgo Bajo       Mantener comunicación y engagement
LS0tCnRpdGxlOiAiQ3VzdG9tZXIgQW5hbHlzaXMiCmF1dGhvcjogIkRhbmFyYSBFc3BhcnphIEEwMDg0MDYwMiIKZGF0ZTogIjIwMjYtMDgtMjciCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogeWV0aQotLS0KCiFbXShodHRwczovL2xlbmR6YS5jb20vaW1hZ2VzL2hlbHBlcnMvaW1hZ2VzL2N1c3RvbWVyJTIwYWNxdWlzaXRpb24lMjAyJTI4MSUyOS5qcGcpIAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IFRlb3LDrWEgPC9zcGFuPgpMYSAqcmVncmVzaW9uIGxvZ2lzdGljYSogZXMgdW5hIG1ldG9kbyBkZSBhcHJlbmRpemFqZSBhdXRvbWF0aWNvIHF1ZSBzaXJ2ZSBwYXJhIHByZWRlY2lyIGxhIHByb2JhYmlsaWRhZCBkZSBxdWUgb2N1cnJhIHVuIGV2ZW50byBjYXRlZ29yaWNvLCBjb24gZG9zIHJlc3VsdGFkb3MgcG9zaWJsZXM6IFNpICgxKSBvIE5vICgwKS4gIAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IENvbnRleHRvIDwvc3Bhbj4KVW5hIGVtcHJlc2EgZGUgc2VydmljaW9zIHBvciBzdXNjcmlwY2lvbiBoYSBvYnNlcnZhZG8gdW4gaW5jcmVtZW50byBlbiBsYSBwZXJkaWRhIGRlIGNsaWVudGVzLCBmZW5vbWVubyBjb25vY2lkbyBjb21vICpDdXN0b21lciBDaHVybiouIFNlIGJ1c2NhIHVuIG1vZGVsbyBwYXJhIGVzdGltYXIgbGEgcHJvYmFiaWxpZGFkIGRlIHF1ZSB1biBjbGllbnRlIGFiYW5kb25lIGVsIHNlcnZpY2lvLgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEluc3RhbGFyIHBhcXVldGVzIHkgbGlicmVyw61hcyA8L3NwYW4+CmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CiNpbnN0YWxsLnBhY2thZ2VzKCJjYXJldCIpICMgTW9kZWxvcyBkZSBhcHJlbmRpemFqZSBhdXRvbWF0aWNvCmxpYnJhcnkoY2FyZXQpCgojaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikgIyBNYW5pcHVsYWNpb24gZGUgZGF0b3MKbGlicmFyeSh0aWR5dmVyc2UpCgojaW5zdGFsbC5wYWNrYWdlcygicFJPQyIpICMgQ2FsY3VsbyBkZWwgYXJlYSBiYWpvIGxhIGN1cnZhCmxpYnJhcnkocFJPQykKYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IENyZWFyIGxhIGJhc2UgZGUgZGF0b3MgPC9zcGFuPgpgYGB7cn0KI2ZpbGUuY2hvb3NlKCkKZGYgPC0gcmVhZC5jc3YoIi9Vc2Vycy9kYW5hcmFlc3BhcnphbWFjaWFzL0Rlc2t0b3AvQ29uY2VudHJhY2lvbiBBSSAvY3VzdG9tZXJfY2h1cm4uY3N2IikgCgpgYGAKCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gRW50ZW5kZXIgbG9zIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmRmIDwtIG5hLm9taXQoZGYpCmRmJEN1c3RvbWVySUQgPC0gTlVMTApkZiRHZW5kZXIgPC0gYXMuZmFjdG9yKGRmJEdlbmRlcikKZGYkU3Vic2NyaXB0aW9uLlR5cGUgPC0gYXMuZmFjdG9yKGRmJFN1YnNjcmlwdGlvbi5UeXBlKQpkZiRDb250cmFjdC5MZW5ndGggPC0gYXMuZmFjdG9yKGRmJENvbnRyYWN0Lkxlbmd0aCkKZGYkQ2h1cm4gPC0gYXMuZmFjdG9yKGRmJENodXJuKQpzdW1tYXJ5KGRmKQpzdHIoZGYpCmBgYAoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPiBQYXJ0aXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCnJlbmdsb25lc19lbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oZGYkQ2h1cm4sIHA9MC43LCBsaXN0PUZBTFNFKQplbnRyZW5hbWllbnRvIDwtIGRmW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdCnBydWViYSA8LSBkZlstcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0KYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IE1vZGVsbyBkZSByZWdyZXNpw7NuIGxvZ2lzdGljYSA8L3NwYW4+CmBgYHtyfQptb2RlbG8gPC0gZ2xtKENodXJuIH4uLCBkYXRhPWVudHJlbmFtaWVudG8sIGZhbWlseT1iaW5vbWlhbCkKc3VtbWFyeShtb2RlbG8pCmV4cChjb2VmKG1vZGVsbykpCiMgSW50ZXJwcmV0YWNpb246IFBvciBjYWRhIGHDsW8gZGUgZWRhZCwgbGEgcHJvYmFiaWxpZGFkIGRlIGFiYW5kb25vIGNyZWNlIDMuOSUuIAoKcmVzdWx0YWRvX2VudHJlbmFtaWVudG8gPC0gcHJlZGljdChtb2RlbG8sIGVudHJlbmFtaWVudG8pCnJlc3VsdGFkb19wcnVlYmEgPC0gcHJlZGljdChtb2RlbG8scHJ1ZWJhKQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gUHJlZGljY2nDs24gPC9zcGFuPgpgYGB7cn0KbnVldm9fY2xpZW50ZSA8LSBkYXRhLmZyYW1lKAogIEFnZT01OCwKICBHZW5kZXI9Ik1hbGUiLAogIFRlbnVyZT0zOCwKICBVc2FnZS5GcmVxdWVuY3k9MjEsCiAgU3VwcG9ydC5DYWxscz03LAogIFBheW1lbnQuRGVsYXk9NywKICBTdWJzY3JpcHRpb24uVHlwZT0iU3RhbmRhcmQiLAogIENvbnRyYWN0Lkxlbmd0aD0iTW9udGhseSIsCiAgVG90YWwuU3BlbmQ9Mzk2LAogIExhc3QuSW50ZXJhY3Rpb249MjkKKQoKcHJlZGljdChtb2RlbG8sIG5ld2RhdGE9bnVldm9fY2xpZW50ZSwgdHlwZT0icmVzcG9uc2UiKQoKYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEN1c3RvbWVyIENodXJuIFJpc2sgU2NvcmUgPC9zcGFuPgoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gQ2FsY3VsYXIgZWwgcmllc2dvIGRlIGFiYW5kb25vIDwvc3Bhbj4KYGBge3J9CnJlc3VsdGFkb19yaWVzZ28gPC0gcHJlZGljdCgKICBtb2RlbG8sCiAgbmV3ZGF0YSA9IGRmLAogIHR5cGUgPSAicmVzcG9uc2UiCikKCiMgQ3JlYXIgZWwgQ3VzdG9tZXIgQ2h1cm4gUmlzayBTY29yZQojIENvbnZlcnRpbW9zIGxhIHByb2JhYmlsaWRhZCBhIHVuYSBlc2NhbGEgZGUgMCBhIDEwMCBwYXJhIHF1ZSBzZWEgbcOhcyBmw6FjaWwgZGUgaW50ZXJwcmV0YXIuCmRmX3JpZXNnbyA8LSBkZiAlPiUKICBtdXRhdGUoCiAgICBjaHVybl9yaXNrX3Njb3JlID0gcmVzdWx0YWRvX3JpZXNnbyAqIDEwMAogICkKCmBgYAoKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEFzaWduYXIgbml2ZWwgZGUgcmllc2dvIDwvc3Bhbj4KYGBge3J9CmRmX3JpZXNnbyA8LSBkZl9yaWVzZ28gJT4lCiAgbXV0YXRlKAogICAgbml2ZWxfcmllc2dvID0gY2FzZV93aGVuKAogICAgICBjaHVybl9yaXNrX3Njb3JlID49IDgwIH4gIlJpZXNnbyBNdXkgQWx0byIsCiAgICAgIGNodXJuX3Jpc2tfc2NvcmUgPj0gNjAgfiAiUmllc2dvIEFsdG8iLAogICAgICBjaHVybl9yaXNrX3Njb3JlID49IDQwIH4gIlJpZXNnbyBNZWRpbyIsCiAgICAgIGNodXJuX3Jpc2tfc2NvcmUgPj0gMjAgfiAiUmllc2dvIEJham8iLAogICAgICBUUlVFIH4gIlJpZXNnbyBNdXkgQmFqbyIKICAgICkKICApCgpoZWFkKGRmX3JpZXNnbykKCmBgYAoKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IENhbnRpZGFkIGRlIGNsaWVudGVzIHBvciBuaXZlbCBkZSByaWVzZ28gPC9zcGFuPgpgYGB7cn0KZGZfcmllc2dvICU+JQogIGNvdW50KG5pdmVsX3JpZXNnbykKCiMgUG9yY2VudGFqZSBkZSBjbGllbnRlcyBwb3Igbml2ZWwgZGUgcmllc2dvCmRmX3JpZXNnbyAlPiUKICBjb3VudChuaXZlbF9yaWVzZ28pICU+JQogIG11dGF0ZSgKICAgIHBvcmNlbnRhamUgPSBuIC8gc3VtKG4pICogMTAwCiAgKQoKYGBgCgoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gSWRlbnRpZmljYXIgYSBsb3MgY2xpZW50ZXMgY29uIG1heW9yIHJpZXNnbyA8L3NwYW4+CmBgYHtyfQpjbGllbnRlc19tdXlfYWx0b19yaWVzZ28gPC0gZGZfcmllc2dvICU+JQogIGZpbHRlcihuaXZlbF9yaWVzZ28gPT0gIlJpZXNnbyBNdXkgQWx0byIpICU+JQogIGFycmFuZ2UoZGVzYyhjaHVybl9yaXNrX3Njb3JlKSkKCmhlYWQoY2xpZW50ZXNfbXV5X2FsdG9fcmllc2dvKQoKYGBgCgoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gUGVyZmlsIGNvbiBiYXNlIGVuIGVsIG5pdmVsIGRlIHJpZXNnbyA8L3NwYW4+CmBgYHtyfQpkZl9yaWVzZ28gJT4lCiAgZ3JvdXBfYnkobml2ZWxfcmllc2dvKSAlPiUKICBzdW1tYXJpc2UoCiAgICBjbGllbnRlcyA9IG4oKSwKICAgIGVkYWRfcHJvbWVkaW8gPSBtZWFuKEFnZSksCiAgICBhbnRpZ3VlZGFkX3Byb21lZGlvID0gbWVhbihUZW51cmUpLAogICAgZnJlY3VlbmNpYV91c28gPSBtZWFuKFVzYWdlLkZyZXF1ZW5jeSksCiAgICBsbGFtYWRhc19zb3BvcnRlID0gbWVhbihTdXBwb3J0LkNhbGxzKSwKICAgIHJldHJhc29zX3BhZ28gPSBtZWFuKFBheW1lbnQuRGVsYXkpLAogICAgZ2FzdG9fcHJvbWVkaW8gPSBtZWFuKFRvdGFsLlNwZW5kKSwKICAgIGludGVyYWNjaW9uX3Byb21lZGlvID0gbWVhbihMYXN0LkludGVyYWN0aW9uKSwKICAgIHNjb3JlX3Byb21lZGlvID0gbWVhbihjaHVybl9yaXNrX3Njb3JlKQogICkKYGBgCgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPiBBc2lnbmFyIHVuYSBlc3RyYXRlZ2lhIGEgY2FkYSBncnVwbyA8L3NwYW4+CmBgYHtyfQpkZl9yaWVzZ28gPC0gZGZfcmllc2dvICU+JQogIG11dGF0ZSgKICAgIGVzdHJhdGVnaWEgPSBjYXNlX3doZW4oCiAgICAgIG5pdmVsX3JpZXNnbyA9PSAiUmllc2dvIE11eSBBbHRvIiB+IAogICAgICAgICJDb250YWN0byBpbm1lZGlhdG8geSBvZmVydGEgZGUgcmV0ZW5jacOzbiIsCiAgICAgIAogICAgICBuaXZlbF9yaWVzZ28gPT0gIlJpZXNnbyBBbHRvIiB+IAogICAgICAgICJEZXNjdWVudG8gbyBiZW5lZmljaW8gcGVyc29uYWxpemFkbyIsCiAgICAgIAogICAgICBuaXZlbF9yaWVzZ28gPT0gIlJpZXNnbyBNZWRpbyIgfiAKICAgICAgICAiSW5jZW50aXZhciB1c28geSBvZnJlY2VyIGJlbmVmaWNpb3MiLAogICAgICAKICAgICAgbml2ZWxfcmllc2dvID09ICJSaWVzZ28gQmFqbyIgfiAKICAgICAgICAiTWFudGVuZXIgY29tdW5pY2FjacOzbiB5IGVuZ2FnZW1lbnQiLAogICAgICAKICAgICAgbml2ZWxfcmllc2dvID09ICJSaWVzZ28gTXV5IEJham8iIH4gCiAgICAgICAgIk1hbnRlbmVyIHJlbGFjacOzbiB5IG1vbml0b3JlYXIiCiAgICApCiAgKQpgYGAKCgojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPiBSZXN1bHRhZG8gZGVsIGFuw6FsaXNpcyA8L3NwYW4+CmBgYHtyfQpoZWFkKGRmX3JpZXNnbykKYGBgCgoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gRXN0cmF0ZWdpYXMgcGFyYSBjYWRhIGdydXBvIGRlIGNsaWVudGUgPC9zcGFuPgpgYGB7cn0KZGZfcmllc2dvICU+JQogIHNlbGVjdChuaXZlbF9yaWVzZ28sIGVzdHJhdGVnaWEpICU+JQogIGRpc3RpbmN0KCkKYGBgCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoK