The managers of Capital Bikeshare have found that the system works smoothly until more than 500 bikes are rented in any one hour. At that point, it becomes necessary to insert extra bikes into the system and move them across stations to balance loads.

library(knitr)
library(glmnet)
#code pset #1:
library(data.table)
biketab <- fread("bikeshare.csv")
# tell R which are factors
biketab[, c("dteday", "mnth","season","weekday","hr","weathersit") := list(
  factor(dteday), factor(mnth), factor(season), 
  factor(weekday), factor(hr), factor(weathersit))]
####### Q1: outliers and FDR
## the next command calculates total cnt by day, 
# also keeping track of the corresponding yr and mnth id.
daytots <- biketab[, list(total=sum(cnt)), by=c("dteday","yr","mnth")]
row.names(daytots) <- daytots$dteday
# simple regression
daylm <- glm(total ~ yr*mnth, data=daytots)
#### Q2: lasso regression
library(gamlr)
source("naref.R")
mmbike <- sparse.model.matrix(
    cnt ~ . + yr*mnth + hr*notbizday, 
    data=naref(biketab))[,-1]
y <- log(biketab$cnt)
## note, I need lambda.min.ratio=1e-4 because otherwise we don't get a path
## out to complex enough models (i.e. cv err is still decreasing at termination)
fitlin <- cv.gamlr( mmbike, y, lmr=1e-4, verb=F )

library(caret)
library(ROCR)
library(tidyverse)
library(gamlr)
library(knitr)
library(stringr)
library(janitor)

3.1
Define the binary outcome variable overload that is one if cnt > 500, zero otherwise.

#define overload as any day where cnt is greater than 500
biketab$overload = ifelse(biketab$cnt > 500,1,0)

Fit and plot the lasso path for regression of overload onto the same model matrix used in Question 2 (no need for cross validation).

#create sparse matrix for test data set
overload.matrix = sparse.model.matrix(
  overload ~ .+ yr*mnth + hr*notbizday,
  data = naref(biketab))[,-1]
overload.y =as.factor(biketab$overload)
overload.reg = gamlr(overload.matrix,
                     overload.y,
                     family = "binomial")

Plot of Lambda and Coefficients:

plot(overload.reg, xvar = "lambda")

Plot of Lambda and Coefficients using glmnet

overload.reg.glmnet = glmnet(overload.matrix, overload.y, family = "binomial")
plot(overload.reg.glmnet, xvar = "lambda")

3.2
Summarize how hour-of-day effects the probability of an overload during business days. Consider a single hour with a strong effect and compare this to its effect in the regression of Q2.

Extracting the effects of hr on probability of overload

#extract the coefficients generated by regression to indiciate effect sizes
#since lambda argument is not specified, it is using the min lambda
coef.df = coef(overload.reg) %>% as.matrix() %>% as.data.frame()
coef.df$var.names = rownames(coef.df)
colnames(coef.df)[1]= "Beta.Val"
#create data frame with just the hrs variables - excluding not busuziness day hours
hrs.df = filter(coef.df, str_detect(rownames(coef.df), regex("hr[0-9]{1,2}$")))
#arrange hrs.df by absolute valuate
hrs.df = arrange(hrs.df, desc(abs(hrs.df$Beta.Val)))
kable(head(hrs.df, 2), caption = "Odds Ratio of Likelihood of Overload for hrs",
      col.names = c("Beta Value", "Hour"))
Beta Value Hour
0.0876101 hr17
0.0428949 hr18

Extracting the effecits of hr from fitlin regression

#extract the coefficients generated by regression to indiciate effect sizes
#since lambda argument is not specified, it is using the min lambda
coef.df.fitlin = coef(fitlin) %>% as.matrix() %>% as.data.frame()
coef.df.fitlin$var.names = rownames(coef.df.fitlin)
colnames(coef.df.fitlin)[1]= "Beta.Val"
#create data frame with just the hrs variables - excluding not busuziness day hours
hrs.df.fitlin = filter(coef.df.fitlin, str_detect(rownames(coef.df.fitlin), regex("hr[0-9]{1,2}$")))
#arrange hrs.df by absolute valuate
hrs.df.fitlin = arrange(hrs.df.fitlin, desc(abs(hrs.df.fitlin$Beta.Val)))
kable(head(hrs.df.fitlin, 10), caption = "Odds Ratio of Likelihood of Overload for hrs in fitlin",
      col.names = c("Beta Value", "Hour"))
Beta Value Hour
-3.5575318 hr3
-3.4407608 hr4
-3.0278172 hr2
-2.3535056 hr1
-1.8732525 hr5
-1.5466945 hr0
1.0855031 hr8
0.9857572 hr17
0.9350662 hr18
-0.6705973 hr23

We can see that by order both the fitlin and the logistic regrssion of overload that we get different hours having impacts on the outcome. for fitlin we can see that hrs3 and hrs4 have the largest impact on the log(cnt) of bikes rented. It is evident that it is not until hr8 we see that a positive relationship occurrs. The cofficients are essentially telling us that in the very late evening and very early morning, the (log) number of bikes rented goes down.

As for the logistic regression of overload, only hr7 seems to have a positive impact. However, since this is a logistic regression the coefficient represents the odds ratio. Since the coefficeint is less than 1 we can say that there hr7 has approximately is 87% less likely to be overloaded, holding all else equal.


3.3
Suppose that it costs you $200/hr in overtime pay if you have an overload (cnt > 500) with your usual number of staff. Staffing an extra driver to move the bikes costs only $100/hr and means you don’t have to pay any overtime. At what probability for overload > 0 will you want to staff an extra driver?

df = data.frame(Regular.Staff = c(-200,0),
                Extra.Employee = c(-100,-100))
rownames(df) = c("Overload", "Don't Overload")
kable(df, col.names = c("Regular Staff", "Extra Employee"))
Regular Staff Extra Employee
Overload -200 -100
Don’t Overload 0 -100

Using expected probability we can see that our \(p\) threshold is:

\[ 200(1 - p) - 100p > 0\] \[ 200 - 200p - 100p > 0\] \[ 200 - 300p > 0\] \[ 200 > 300p\] \[ \frac{200}{300} > p\] \[ p < .67\]

3.4
Plot and describe the ROC curve for your AICc-optimal regression from 3.1. What is the sensitivity and specificity of your rule from 3.3 if applied with this regression?

source("roc.R")
#using mmbike matrix
test = gamlr(mmbike, overload.y, family = "binomial")
p = predict(test, 
            mmbike, 
            type = "response")
roc(p=p, y = overload.y)

p = predict(overload.reg, 
            overload.matrix, 
            type = "response")
roc(p=p, y = overload.y)

prediction.df = data.frame(prediction = p,
                           reality = overload.y)
prediction.df$threshold.pred = ifelse(prediction.df$seg100 > .67, 1,0)
prediction.df$correct.prediction  = ifelse(prediction.df$threshold.pred == prediction.df$reality, 1, 0)
confusion.matrix = caret::confusionMatrix(prediction.df$reality, prediction.df$threshold.pred)
x = as.table(confusion.matrix, what = "xtabs")
x <- cbind(x, Total = rowSums(x))
x <- rbind(x, Total = colSums(x))
x
          0    1 Total
0     16100    0 16100
1       139 1140  1279
Total 16239 1140 17379



row.names(x) = c("Predicted Not Overloaded", "Predicted Overloaded", "Total")
colnames(x) = c("Predicted Not Overloaded", "Predicted Overloaded", "Total")
x = as.data.frame(x)
kable(x, caption = "Confusion Matrix for Full Data Frame p > .67")

\[Sensativity = \frac{\# \ Correct \ Overloaded}{\# \ Overloaded}\]

\[Specificity = \frac{\# \ Incorrectly \ Not \ Overloaded}{\# \ Not \ Overloaded}\]

specificity = 1140 / 1140
print(paste0("Sensativity: ",specificity *100,"%"))
[1] "Sensativity: 100%"
sensativity = 139/16329
print(paste0("Specificity: ",(1 - sensativity),"%"))
[1] "Specificity: 0.991487537509952%"

From confusion matrix:

confusion.matrix$byClass[1]
Sensitivity 
  0.9914404 
confusion.matrix$byClass[2]
Specificity 
          1 

3.5  

Now, take the test sample and

• fit the regression path excluding this sample (e.g., on mmbike[-test,]).

#create test and training split
trainIndex = createDataPartition(biketab$overload, times = 1, p = .8, list = F)
#create training data frame and training outcome variable
train.df = biketab[trainIndex,]
train.y = train.df$overload
#create test data frame and test outcome
test.df = biketab[-(trainIndex),]
test.y = train.df$overload
train.matrix <- sparse.model.matrix(
  overload ~ . + yr*mnth + hr*notbizday, 
    data=naref(train.df))[,-1]
train.reg = gamlr(train.matrix, train.y, family = "binomial")
plot(train.reg, xvar = "lambda")

• use the AICc-optimal model from this path to predict for the test set.

test.matrix <- sparse.model.matrix(
  overload ~ . + yr*mnth + hr*notbizday, 
    data=naref(test.df))[,-1]

test.y = test.df$overload
pred = predict(train.reg, test.matrix, type = "response")

• plot the ‘out-of-sample’ ROC curve for these predictions.

Compare this curve to your ROC curve from 3.4 and describe what they imply about the quality of AICc selection for this regression.

LS0tCnRpdGxlOiAnTWFjaGluZSBMZWFybmluZyBQcm9ibGVtIFNldCAjMicKYXV0aG9yOiAiVG9tIEN1cnJhbiIKZGF0ZTogIkFwcmlsIDI0LCAyMDE4IgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazogZGVmYXVsdAogIHBkZl9kb2N1bWVudDogZGVmYXVsdAotLS0KClRoZSBtYW5hZ2VycyBvZiBDYXBpdGFsIEJpa2VzaGFyZSBoYXZlIGZvdW5kIHRoYXQgdGhlIHN5c3RlbSB3b3JrcyBzbW9vdGhseSB1bnRpbCBtb3JlIHRoYW4gNTAwIGJpa2VzIGFyZSByZW50ZWQgaW4gYW55IG9uZSBob3VyLiBBdCB0aGF0IHBvaW50LCBpdCBiZWNvbWVzIG5lY2Vzc2FyeSB0byBpbnNlcnQgZXh0cmEgYmlrZXMgaW50byB0aGUgc3lzdGVtIGFuZCBtb3ZlIHRoZW0gYWNyb3NzIHN0YXRpb25zIHRvIGJhbGFuY2UgbG9hZHMuCgoKYGBge3IgcHNldF8xLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KGtuaXRyKQpsaWJyYXJ5KGdsbW5ldCkKI2NvZGUgcHNldCAjMToKbGlicmFyeShkYXRhLnRhYmxlKQpiaWtldGFiIDwtIGZyZWFkKCJiaWtlc2hhcmUuY3N2IikKIyB0ZWxsIFIgd2hpY2ggYXJlIGZhY3RvcnMKYmlrZXRhYlssIGMoImR0ZWRheSIsICJtbnRoIiwic2Vhc29uIiwid2Vla2RheSIsImhyIiwid2VhdGhlcnNpdCIpIDo9IGxpc3QoCiAgZmFjdG9yKGR0ZWRheSksIGZhY3RvcihtbnRoKSwgZmFjdG9yKHNlYXNvbiksIAogIGZhY3Rvcih3ZWVrZGF5KSwgZmFjdG9yKGhyKSwgZmFjdG9yKHdlYXRoZXJzaXQpKV0KCiMjIyMjIyMgUTE6IG91dGxpZXJzIGFuZCBGRFIKIyMgdGhlIG5leHQgY29tbWFuZCBjYWxjdWxhdGVzIHRvdGFsIGNudCBieSBkYXksIAojIGFsc28ga2VlcGluZyB0cmFjayBvZiB0aGUgY29ycmVzcG9uZGluZyB5ciBhbmQgbW50aCBpZC4KZGF5dG90cyA8LSBiaWtldGFiWywgbGlzdCh0b3RhbD1zdW0oY250KSksIGJ5PWMoImR0ZWRheSIsInlyIiwibW50aCIpXQpyb3cubmFtZXMoZGF5dG90cykgPC0gZGF5dG90cyRkdGVkYXkKIyBzaW1wbGUgcmVncmVzc2lvbgpkYXlsbSA8LSBnbG0odG90YWwgfiB5ciptbnRoLCBkYXRhPWRheXRvdHMpCgojIyMjIFEyOiBsYXNzbyByZWdyZXNzaW9uCmxpYnJhcnkoZ2FtbHIpCnNvdXJjZSgibmFyZWYuUiIpCm1tYmlrZSA8LSBzcGFyc2UubW9kZWwubWF0cml4KAoJY250IH4gLiArIHlyKm1udGggKyBocipub3RiaXpkYXksIAoJZGF0YT1uYXJlZihiaWtldGFiKSlbLC0xXQp5IDwtIGxvZyhiaWtldGFiJGNudCkKIyMgbm90ZSwgSSBuZWVkIGxhbWJkYS5taW4ucmF0aW89MWUtNCBiZWNhdXNlIG90aGVyd2lzZSB3ZSBkb24ndCBnZXQgYSBwYXRoCiMjIG91dCB0byBjb21wbGV4IGVub3VnaCBtb2RlbHMgKGkuZS4gY3YgZXJyIGlzIHN0aWxsIGRlY3JlYXNpbmcgYXQgdGVybWluYXRpb24pCmZpdGxpbiA8LSBjdi5nYW1sciggbW1iaWtlLCB5LCBsbXI9MWUtNCwgdmVyYj1GICkKCmBgYAoKKioqCgpgYGB7ciBsaWJyYXJpZXMsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkoY2FyZXQpCmxpYnJhcnkoUk9DUikKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoZ2FtbHIpCmxpYnJhcnkoa25pdHIpCmxpYnJhcnkoc3RyaW5ncikKbGlicmFyeShqYW5pdG9yKQpgYGAKCioqMy4xKipcCioqRGVmaW5lIHRoZSBiaW5hcnkgb3V0Y29tZSB2YXJpYWJsZSBvdmVybG9hZCB0aGF0IGlzIG9uZSBpZiBjbnQgPiA1MDAsIHplcm8gb3RoZXJ3aXNlLioqCmBgYHtyIHRyYWluLnRlc3Quc3BsaXQsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CgojZGVmaW5lIG92ZXJsb2FkIGFzIGFueSBkYXkgd2hlcmUgY250IGlzIGdyZWF0ZXIgdGhhbiA1MDAKYmlrZXRhYiRvdmVybG9hZCA9IGlmZWxzZShiaWtldGFiJGNudCA+IDUwMCwxLDApCgoKYGBgCgoqKkZpdCBhbmQgcGxvdCB0aGUgbGFzc28gcGF0aCBmb3IgcmVncmVzc2lvbiBvZiBvdmVybG9hZCBvbnRvIHRoZSBzYW1lIG1vZGVsIG1hdHJpeCB1c2VkIGluIFF1ZXN0aW9uIDIgKG5vIG5lZWQgZm9yIGNyb3NzIHZhbGlkYXRpb24pLioqCmBgYHtyIG92ZXJsb2FkLnJlZywgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KI2NyZWF0ZSBzcGFyc2UgbWF0cml4IGZvciB0ZXN0IGRhdGEgc2V0Cm92ZXJsb2FkLm1hdHJpeCA9IHNwYXJzZS5tb2RlbC5tYXRyaXgoCiAgb3ZlcmxvYWQgfiAuKyB5ciptbnRoICsgaHIqbm90Yml6ZGF5LAogIGRhdGEgPSBuYXJlZihiaWtldGFiKSlbLC0xXQoKb3ZlcmxvYWQueSA9YXMuZmFjdG9yKGJpa2V0YWIkb3ZlcmxvYWQpCgpvdmVybG9hZC5yZWcgPSBnYW1scihvdmVybG9hZC5tYXRyaXgsCiAgICAgICAgICAgICAgICAgICAgIG92ZXJsb2FkLnksCiAgICAgICAgICAgICAgICAgICAgIGZhbWlseSA9ICJiaW5vbWlhbCIpCgpgYGAKCiMjIyMgUGxvdCBvZiBMYW1iZGEgYW5kIENvZWZmaWNpZW50czoKCmBgYHtyIGxhbWJkYS5wbG90LCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpwbG90KG92ZXJsb2FkLnJlZywgeHZhciA9ICJsYW1iZGEiKQpgYGAKCiMjIyMgUGxvdCBvZiBMYW1iZGEgYW5kIENvZWZmaWNpZW50cyB1c2luZyBnbG1uZXQKCmBgYHtyIGxhbWJkYWdyYXBoLmdsbW5ldCwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0Kb3ZlcmxvYWQucmVnLmdsbW5ldCA9IGdsbW5ldChvdmVybG9hZC5tYXRyaXgsIG92ZXJsb2FkLnksIGZhbWlseSA9ICJiaW5vbWlhbCIpCgpwbG90KG92ZXJsb2FkLnJlZy5nbG1uZXQsIHh2YXIgPSAibGFtYmRhIikKYGBgCgoqKjMuMioqXAoqKlN1bW1hcml6ZSBob3cgaG91ci1vZi1kYXkgZWZmZWN0cyB0aGUgcHJvYmFiaWxpdHkgb2YgYW4gb3ZlcmxvYWQgZHVyaW5nIGJ1c2luZXNzIGRheXMuIENvbnNpZGVyIGEgc2luZ2xlIGhvdXIgd2l0aCBhIHN0cm9uZyBlZmZlY3QgYW5kIGNvbXBhcmUgdGhpcyB0byBpdHMgZWZmZWN0IGluIHRoZSByZWdyZXNzaW9uIG9mIFEyLioqCgpFeHRyYWN0aW5nIHRoZSBlZmZlY3RzIG9mIGBocmAgb24gcHJvYmFiaWxpdHkgb2YgYG92ZXJsb2FkYAoKYGBge3J9CiNleHRyYWN0IHRoZSBjb2VmZmljaWVudHMgZ2VuZXJhdGVkIGJ5IHJlZ3Jlc3Npb24gdG8gaW5kaWNpYXRlIGVmZmVjdCBzaXplcwojc2luY2UgbGFtYmRhIGFyZ3VtZW50IGlzIG5vdCBzcGVjaWZpZWQsIGl0IGlzIHVzaW5nIHRoZSBtaW4gbGFtYmRhCmNvZWYuZGYgPSBjb2VmKG92ZXJsb2FkLnJlZykgJT4lIGFzLm1hdHJpeCgpICU+JSBhcy5kYXRhLmZyYW1lKCkKY29lZi5kZiR2YXIubmFtZXMgPSByb3duYW1lcyhjb2VmLmRmKQpjb2xuYW1lcyhjb2VmLmRmKVsxXT0gIkJldGEuVmFsIgoKI2NyZWF0ZSBkYXRhIGZyYW1lIHdpdGgganVzdCB0aGUgaHJzIHZhcmlhYmxlcyAtIGV4Y2x1ZGluZyBub3QgYnVzdXppbmVzcyBkYXkgaG91cnMKaHJzLmRmID0gZmlsdGVyKGNvZWYuZGYsIHN0cl9kZXRlY3Qocm93bmFtZXMoY29lZi5kZiksIHJlZ2V4KCJoclswLTldezEsMn0kIikpKQojYXJyYW5nZSBocnMuZGYgYnkgYWJzb2x1dGUgdmFsdWF0ZQpocnMuZGYgPSBhcnJhbmdlKGhycy5kZiwgZGVzYyhhYnMoaHJzLmRmJEJldGEuVmFsKSkpCgprYWJsZShoZWFkKGhycy5kZiwgMiksIGNhcHRpb24gPSAiT2RkcyBSYXRpbyBvZiBMaWtlbGlob29kIG9mIE92ZXJsb2FkIGZvciBocnMiLAogICAgICBjb2wubmFtZXMgPSBjKCJCZXRhIFZhbHVlIiwgIkhvdXIiKSkKCmBgYAoKRXh0cmFjdGluZyB0aGUgZWZmZWNpdHMgb2YgYGhyYCBmcm9tIGBmaXRsaW5gIHJlZ3Jlc3Npb24KCmBgYHtyfQojZXh0cmFjdCB0aGUgY29lZmZpY2llbnRzIGdlbmVyYXRlZCBieSByZWdyZXNzaW9uIHRvIGluZGljaWF0ZSBlZmZlY3Qgc2l6ZXMKI3NpbmNlIGxhbWJkYSBhcmd1bWVudCBpcyBub3Qgc3BlY2lmaWVkLCBpdCBpcyB1c2luZyB0aGUgbWluIGxhbWJkYQpjb2VmLmRmLmZpdGxpbiA9IGNvZWYoZml0bGluKSAlPiUgYXMubWF0cml4KCkgJT4lIGFzLmRhdGEuZnJhbWUoKQpjb2VmLmRmLmZpdGxpbiR2YXIubmFtZXMgPSByb3duYW1lcyhjb2VmLmRmLmZpdGxpbikKY29sbmFtZXMoY29lZi5kZi5maXRsaW4pWzFdPSAiQmV0YS5WYWwiCgojY3JlYXRlIGRhdGEgZnJhbWUgd2l0aCBqdXN0IHRoZSBocnMgdmFyaWFibGVzIC0gZXhjbHVkaW5nIG5vdCBidXN1emluZXNzIGRheSBob3VycwpocnMuZGYuZml0bGluID0gZmlsdGVyKGNvZWYuZGYuZml0bGluLCBzdHJfZGV0ZWN0KHJvd25hbWVzKGNvZWYuZGYuZml0bGluKSwgcmVnZXgoImhyWzAtOV17MSwyfSQiKSkpCiNhcnJhbmdlIGhycy5kZiBieSBhYnNvbHV0ZSB2YWx1YXRlCmhycy5kZi5maXRsaW4gPSBhcnJhbmdlKGhycy5kZi5maXRsaW4sIGRlc2MoYWJzKGhycy5kZi5maXRsaW4kQmV0YS5WYWwpKSkKCmthYmxlKGhlYWQoaHJzLmRmLmZpdGxpbiwgMTApLCBjYXB0aW9uID0gIk9kZHMgUmF0aW8gb2YgTGlrZWxpaG9vZCBvZiBPdmVybG9hZCBmb3IgaHJzIGluIGZpdGxpbiIsCiAgICAgIGNvbC5uYW1lcyA9IGMoIkJldGEgVmFsdWUiLCAiSG91ciIpKQoKYGBgCgoKV2UgY2FuIHNlZSB0aGF0IGJ5IG9yZGVyIGJvdGggdGhlIGZpdGxpbiBhbmQgdGhlIGxvZ2lzdGljIHJlZ3Jzc2lvbiBvZiBvdmVybG9hZCB0aGF0IHdlIGdldCBkaWZmZXJlbnQgaG91cnMgaGF2aW5nIGltcGFjdHMgb24gdGhlIG91dGNvbWUuIGZvciBgZml0bGluYCB3ZSBjYW4gc2VlIHRoYXQgYGhyczNgIGFuZCBgaHJzNGAgaGF2ZSB0aGUgbGFyZ2VzdCBpbXBhY3Qgb24gdGhlIGBsb2coY250KWAgb2YgYmlrZXMgcmVudGVkLiBJdCBpcyBldmlkZW50IHRoYXQgaXQgaXMgbm90IHVudGlsIGBocjhgIHdlIHNlZSB0aGF0IGEgcG9zaXRpdmUgcmVsYXRpb25zaGlwIG9jY3VycnMuIFRoZSBjb2ZmaWNpZW50cyBhcmUgZXNzZW50aWFsbHkgdGVsbGluZyB1cyB0aGF0IGluIHRoZSB2ZXJ5IGxhdGUgZXZlbmluZyBhbmQgdmVyeSBlYXJseSBtb3JuaW5nLCB0aGUgKGxvZykgbnVtYmVyIG9mIGJpa2VzIHJlbnRlZCBnb2VzIGRvd24uIAoKQXMgZm9yIHRoZSBsb2dpc3RpYyByZWdyZXNzaW9uIG9mIGBvdmVybG9hZGAsIG9ubHkgYGhyN2Agc2VlbXMgdG8gaGF2ZSBhIHBvc2l0aXZlIGltcGFjdC4gSG93ZXZlciwgc2luY2UgdGhpcyBpcyBhIGxvZ2lzdGljIHJlZ3Jlc3Npb24gdGhlIGNvZWZmaWNpZW50IHJlcHJlc2VudHMgdGhlIG9kZHMgcmF0aW8uIFNpbmNlIHRoZSBjb2VmZmljZWludCBpcyBsZXNzIHRoYW4gMSB3ZSBjYW4gc2F5IHRoYXQgdGhlcmUgYGhyN2AgaGFzIGFwcHJveGltYXRlbHkgaXMgODclIGxlc3MgbGlrZWx5IHRvIGJlIG92ZXJsb2FkZWQsIGhvbGRpbmcgYWxsIGVsc2UgZXF1YWwuIAoKKioqCgoqKjMuMyoqXAoqKlN1cHBvc2UgdGhhdCBpdCBjb3N0cyB5b3UgXCQyMDAvaHIgaW4gb3ZlcnRpbWUgcGF5IGlmIHlvdSBoYXZlIGFuIG92ZXJsb2FkIChjbnQgPiA1MDApIHdpdGggeW91ciB1c3VhbCBudW1iZXIgb2Ygc3RhZmYuIFN0YWZmaW5nIGFuIGV4dHJhIGRyaXZlciB0byBtb3ZlIHRoZSBiaWtlcyBjb3N0cyBvbmx5IFwkMTAwL2hyIGFuZCBtZWFucyB5b3UgZG9u4oCZdCBoYXZlIHRvIHBheSBhbnkgb3ZlcnRpbWUuIEF0IHdoYXQgcHJvYmFiaWxpdHkgZm9yIG92ZXJsb2FkID4gMCB3aWxsIHlvdSB3YW50IHRvIHN0YWZmIGFuIGV4dHJhIGRyaXZlcj8qKgoKYGBge3J9CmRmID0gZGF0YS5mcmFtZShSZWd1bGFyLlN0YWZmID0gYygtMjAwLDApLAogICAgICAgICAgICAgICAgRXh0cmEuRW1wbG95ZWUgPSBjKC0xMDAsLTEwMCkpCgpyb3duYW1lcyhkZikgPSBjKCJPdmVybG9hZCIsICJEb24ndCBPdmVybG9hZCIpCgprYWJsZShkZiwgY29sLm5hbWVzID0gYygiUmVndWxhciBTdGFmZiIsICJFeHRyYSBFbXBsb3llZSIpKQpgYGAKClVzaW5nIGV4cGVjdGVkIHByb2JhYmlsaXR5IHdlIGNhbiBzZWUgdGhhdCBvdXIgJHAkIHRocmVzaG9sZCBpczoKCiQkIDIwMCgxIC0gcCkgLSAxMDBwID4gMCQkCiQkIDIwMCAtIDIwMHAgLSAxMDBwID4gMCQkCiQkIDIwMCAtIDMwMHAgPiAwJCQKJCQgMjAwID4gMzAwcCQkCiQkIFxmcmFjezIwMH17MzAwfSA+IHAkJAokJCBwIDwgLjY3JCQKCioqMy40KipcCioqUGxvdCBhbmQgZGVzY3JpYmUgdGhlIFJPQyBjdXJ2ZSBmb3IgeW91ciBBSUNjLW9wdGltYWwgcmVncmVzc2lvbiBmcm9tIDMuMS4gV2hhdCBpcyB0aGUgc2Vuc2l0aXZpdHkgYW5kIHNwZWNpZmljaXR5IG9mIHlvdXIgcnVsZSBmcm9tIDMuMyBpZiBhcHBsaWVkIHdpdGggdGhpcyByZWdyZXNzaW9uPyoqCgpgYGB7cn0Kc291cmNlKCJyb2MuUiIpCgojdXNpbmcgbW1iaWtlIG1hdHJpeAp0ZXN0ID0gZ2FtbHIobW1iaWtlLCBvdmVybG9hZC55LCBmYW1pbHkgPSAiYmlub21pYWwiKQoKcCA9IHByZWRpY3QodGVzdCwgCiAgICAgICAgICAgIG1tYmlrZSwgCiAgICAgICAgICAgIHR5cGUgPSAicmVzcG9uc2UiKQoKcm9jKHA9cCwgeSA9IG92ZXJsb2FkLnkpCgoKCmBgYApgYGB7cn0KcCA9IHByZWRpY3Qob3ZlcmxvYWQucmVnLCAKICAgICAgICAgICAgb3ZlcmxvYWQubWF0cml4LCAKICAgICAgICAgICAgdHlwZSA9ICJyZXNwb25zZSIpCgpyb2MocD1wLCB5ID0gb3ZlcmxvYWQueSkKCgpwcmVkaWN0aW9uLmRmID0gZGF0YS5mcmFtZShwcmVkaWN0aW9uID0gcCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgcmVhbGl0eSA9IG92ZXJsb2FkLnkpCmBgYAoKYGBge3J9CnByZWRpY3Rpb24uZGYkdGhyZXNob2xkLnByZWQgPSBpZmVsc2UocHJlZGljdGlvbi5kZiRzZWcxMDAgPiAuNjcsIDEsMCkKCnByZWRpY3Rpb24uZGYkY29ycmVjdC5wcmVkaWN0aW9uICA9IGlmZWxzZShwcmVkaWN0aW9uLmRmJHRocmVzaG9sZC5wcmVkID09IHByZWRpY3Rpb24uZGYkcmVhbGl0eSwgMSwgMCkKCmNvbmZ1c2lvbi5tYXRyaXggPSBjYXJldDo6Y29uZnVzaW9uTWF0cml4KHByZWRpY3Rpb24uZGYkcmVhbGl0eSwgcHJlZGljdGlvbi5kZiR0aHJlc2hvbGQucHJlZCkKCnggPSBhcy50YWJsZShjb25mdXNpb24ubWF0cml4LCB3aGF0ID0gInh0YWJzIikKCnggPC0gY2JpbmQoeCwgVG90YWwgPSByb3dTdW1zKHgpKQp4IDwtIHJiaW5kKHgsIFRvdGFsID0gY29sU3Vtcyh4KSkKeApgYGAKCmBgYHtyfQoKCgpyb3cubmFtZXMoeCkgPSBjKCJQcmVkaWN0ZWQgTm90IE92ZXJsb2FkZWQiLCAiUHJlZGljdGVkIE92ZXJsb2FkZWQiLCAiVG90YWwiKQpjb2xuYW1lcyh4KSA9IGMoIlByZWRpY3RlZCBOb3QgT3ZlcmxvYWRlZCIsICJQcmVkaWN0ZWQgT3ZlcmxvYWRlZCIsICJUb3RhbCIpCnggPSBhcy5kYXRhLmZyYW1lKHgpCmthYmxlKHgsIGNhcHRpb24gPSAiQ29uZnVzaW9uIE1hdHJpeCBmb3IgRnVsbCBEYXRhIEZyYW1lIHAgPiAuNjciKQpgYGAKCgokJFNlbnNhdGl2aXR5ID0gXGZyYWN7XCMgXCBDb3JyZWN0IFwgT3ZlcmxvYWRlZH17XCMgXCBPdmVybG9hZGVkfSQkCgokJFNwZWNpZmljaXR5ID0gXGZyYWN7XCMgXCBJbmNvcnJlY3RseSBcIE5vdCBcIE92ZXJsb2FkZWR9e1wjIFwgTm90IFwgT3ZlcmxvYWRlZH0kJAoKCmBgYHtyfQpzcGVjaWZpY2l0eSA9IDExNDAgLyAxMTQwCnByaW50KHBhc3RlMCgiU2Vuc2F0aXZpdHk6ICIsc3BlY2lmaWNpdHkgKjEwMCwiJSIpKQpzZW5zYXRpdml0eSA9IDEzOS8xNjMyOQpwcmludChwYXN0ZTAoIlNwZWNpZmljaXR5OiAiLCgxIC0gc2Vuc2F0aXZpdHkpLCIlIikpCmBgYAoKRnJvbSBjb25mdXNpb24gbWF0cml4OgoKYGBge3J9Cgpjb25mdXNpb24ubWF0cml4JGJ5Q2xhc3NbMV0KCmNvbmZ1c2lvbi5tYXRyaXgkYnlDbGFzc1syXQpgYGAKCioqKgoqKjMuNSoqIFwgCgoqKk5vdywgdGFrZSB0aGUgdGVzdCBzYW1wbGUgYW5kKioKCuKAoiBmaXQgdGhlIHJlZ3Jlc3Npb24gcGF0aCBleGNsdWRpbmcgdGhpcyBzYW1wbGUgKGUuZy4sIG9uIG1tYmlrZVstdGVzdCxdKS4gCgpgYGB7ciwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KI2NyZWF0ZSB0ZXN0IGFuZCB0cmFpbmluZyBzcGxpdAp0cmFpbkluZGV4ID0gY3JlYXRlRGF0YVBhcnRpdGlvbihiaWtldGFiJG92ZXJsb2FkLCB0aW1lcyA9IDEsIHAgPSAuOCwgbGlzdCA9IEYpCgojY3JlYXRlIHRyYWluaW5nIGRhdGEgZnJhbWUgYW5kIHRyYWluaW5nIG91dGNvbWUgdmFyaWFibGUKdHJhaW4uZGYgPSBiaWtldGFiW3RyYWluSW5kZXgsXQoKdHJhaW4ueSA9IHRyYWluLmRmJG92ZXJsb2FkCgojY3JlYXRlIHRlc3QgZGF0YSBmcmFtZSBhbmQgdGVzdCBvdXRjb21lCnRlc3QuZGYgPSBiaWtldGFiWy0odHJhaW5JbmRleCksXQp0ZXN0LnkgPSB0cmFpbi5kZiRvdmVybG9hZAoKdHJhaW4ubWF0cml4IDwtIHNwYXJzZS5tb2RlbC5tYXRyaXgoCiAgb3ZlcmxvYWQgfiAuICsgeXIqbW50aCArIGhyKm5vdGJpemRheSwgCglkYXRhPW5hcmVmKHRyYWluLmRmKSlbLC0xXQoKdHJhaW4ucmVnID0gZ2FtbHIodHJhaW4ubWF0cml4LCB0cmFpbi55LCBmYW1pbHkgPSAiYmlub21pYWwiKQpwbG90KHRyYWluLnJlZywgeHZhciA9ICJsYW1iZGEiKQpgYGAKCuKAoiB1c2UgdGhlIEFJQ2Mtb3B0aW1hbCBtb2RlbCBmcm9tIHRoaXMgcGF0aCB0byBwcmVkaWN0IGZvciB0aGUgdGVzdCBzZXQuCmBgYHtyfQp0ZXN0Lm1hdHJpeCA8LSBzcGFyc2UubW9kZWwubWF0cml4KAogIG92ZXJsb2FkIH4gLiArIHlyKm1udGggKyBocipub3RiaXpkYXksIAoJZGF0YT1uYXJlZih0ZXN0LmRmKSlbLC0xXQoKdGVzdC55ID0gdGVzdC5kZiRvdmVybG9hZApwcmVkID0gcHJlZGljdCh0cmFpbi5yZWcsIHRlc3QubWF0cml4LCB0eXBlID0gInJlc3BvbnNlIikKCgpgYGAKCuKAoiBwbG90IHRoZSDigJhvdXQtb2Ytc2FtcGxl4oCZIFJPQyBjdXJ2ZSBmb3IgdGhlc2UgcHJlZGljdGlvbnMuCmBgYHtyfQpgYGAKCkNvbXBhcmUgdGhpcyBjdXJ2ZSB0byB5b3VyIFJPQyBjdXJ2ZSBmcm9tIDMuNCBhbmQgZGVzY3JpYmUgd2hhdCB0aGV5IGltcGx5IGFib3V0IHRoZSBxdWFsaXR5IG9mIEFJQ2Mgc2VsZWN0aW9uIGZvciB0aGlzIHJlZ3Jlc3Npb24u