Load packages & Prestige data

The car and effects packages are the main workhorses here.

library("car")
library("effects")  # effect plots
library("arm")      # coefplots
data(Prestige, package="carData")

Reorder levels of type factor

Here it is useful to recognize that “bc” < “wc” < “prof”. Do so by making Prestige$type an ordered factor. Note that the occupation names are the row.names in the data.frame, not a separate variable.

Prestige$type <- ordered(Prestige$type, levels=c("bc", "wc", "prof")) # reorder levels
some(Prestige, 6)
##                     education income women prestige census type
## librarians              14.15   6112 77.10     58.1   2351 prof
## university.teachers     15.97  12480 19.59     84.6   2711 prof
## veterinarians           15.94  14558  4.32     66.7   3115 prof
## travel.clerks           11.43   6259 39.17     35.7   4193   wc
## bartenders               8.50   3930 15.51     20.2   6123   bc
## taxi.drivers             7.93   4224  3.59     25.1   9173   bc

scatterplotMatrix

Let’s get a visual overview of the data in a scatterplot matrix. I use options to specify a linear regression line (regLine=), a loess smoothed curve (smooth=) and a 68% (~ \(\bar{y} \pm 1 sd\)) data ellipse (ellipse=) in each panel.

scatterplotMatrix(~ prestige + education + income + women ,
                  data=Prestige,
                  regLine = list(method=lm, lty=1, lwd=2, col="black"),
                  smooth=list(smoother=loessLine, spread=FALSE,
                              lty.smooth=1, lwd.smooth=3, col.smooth="red"),
                  ellipse=list(levels=0.68, fill.alpha=0.1))

Fancy scatterplots

car::scatterplot has many options to add informative annotations, label unusual points, etc. This plot shows clearly that income is positively skewed and the relation with prestige is non-linear. The id = argument allows to identify unusual observations with their labels

scatterplot(prestige ~ income, data=Prestige,
            pch = 16,
            regLine = list(col = "red", lwd=3),
            smooth = list(smoother=loessLine,
                          lty.smooth = 1, col.smooth = "black", lwd.smooth=3,
                          col.var = "darkgreen"),
            ellipse = list(levels = 0.68),
            id = list(n=4, col="black", cex=1.2))

## general.managers          lawyers        ministers       physicians 
##                2               17               20               24

What would log(income) look like?

Rather than actually transforming income, the argument log = "x" says to plot income on a log scale

scatterplot(prestige ~ income, data=Prestige, 
            log = "x",
            pch = 16,
            regLine = list(col = "red", lwd=3),
            smooth = list(smoother=loessLine,
                          lty.smooth = 1, col.smooth = "black", lwd.smooth=3,
                          col.var = "darkgreen"),
            ellipse = list(levels = 0.68), 
            id = list(n=4, col="black", cex=1.2))

## general.managers        ministers         newsboys      babysitters 
##                2               20               53               63

Stratify by type

The formula notation ~ income | type says to do plot annotations conditional on occupation type. Oh, now that has a very different interpretation!

scatterplot(prestige ~ income | type, data=Prestige,
            col = c("blue", "red", "darkgreen"),
            pch = 15:17,
            legend = list(coords="bottomright"),
            smooth=list(smoother=loessLine, 
                        var=FALSE, span=1, lwd=4))

Fit the basic all-main-effects model

data(Prestige)
mod0 <- lm(prestige ~ education + income + women + type,
           data=Prestige)
summary(mod0)
## 
## Call:
## lm(formula = prestige ~ education + income + women + type, data = Prestige)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -14.748  -4.482   0.312   5.248  18.498 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.813903   5.331156   -0.15  0.87899    
## education    3.662356   0.645830    5.67  1.6e-07 ***
## income       0.001043   0.000262    3.98  0.00014 ***
## women        0.006443   0.030378    0.21  0.83249    
## typeprof     5.905197   3.937700    1.50  0.13713    
## typewc      -2.917072   2.665396   -1.09  0.27663    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.13 on 92 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.835,  Adjusted R-squared:  0.826 
## F-statistic: 93.1 on 5 and 92 DF,  p-value: <2e-16

Add more complex terms

Here we model income as log(income)`` and allow an interaction with occupationtype`.

mod1 <- lm(prestige ~ education + women +
                     log(income)*type, data=Prestige)
summary(mod1)
## 
## Call:
## lm(formula = prestige ~ education + women + log(income) * type, 
##     data = Prestige)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -13.814  -4.685   0.656   3.966  16.569 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -152.2059    23.2499   -6.55  3.5e-09 ***
## education               2.9282     0.5883    4.98  3.1e-06 ***
## women                   0.0883     0.0323    2.73   0.0076 ** 
## log(income)            18.9819     2.8285    6.71  1.7e-09 ***
## typeprof               85.2642    30.4582    2.80   0.0063 ** 
## typewc                 29.4133    36.5075    0.81   0.4226    
## log(income):typeprof   -9.0124     3.4102   -2.64   0.0097 ** 
## log(income):typewc     -3.8334     4.2603   -0.90   0.3706    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.27 on 90 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.875,  Adjusted R-squared:  0.865 
## F-statistic: 90.1 on 7 and 90 DF,  p-value: <2e-16

Plot coefficients

Plots of coefficients with CI often more informative that tables of coefficients. These intervals are shown for \(\pm 1, \pm 2\) standard errors.

However, this plots the raw coefficients, which are on different scales, so the small coefficients for income do not appear to be significant. It would be better if there was an option to plot standardized (\(\beta\)) coefficients.

arm::coefplot(mod0, col.pts="red", cex.pts=1.5)
arm::coefplot(mod1, add=TRUE, col.pts="blue", cex.pts=1.5)

Compare model fits

This anova call tests whether mod1 is a significant improvement over the baseline mod0

anova(mod0, mod1)
## Analysis of Variance Table
## 
## Model 1: prestige ~ education + income + women + type
## Model 2: prestige ~ education + women + log(income) * type
##   Res.Df  RSS Df Sum of Sq    F  Pr(>F)    
## 1     92 4679                              
## 2     90 3541  2      1138 14.5 3.6e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Effect plots

Effect of education averaged over others

mod1.e1 <- predictorEffect("education", mod1)
plot(mod1.e1)

Effect of education, but showing partial residuals. In some cases, this will help spot influential cases in the partial relation of a predictor to the response.

mod1.e1a <- predictorEffect("education", mod1, residuals=TRUE)
plot(mod1.e1a, 
     residuals.pch=16, id=list(n=4, col="black"))

Effect of women averaged over others. The blue curve shows the fitted quadratic relation in the model. The red curve shows a non-parametric smoooth.

mod1.e2 <- predictorEffect("women", mod1, residuals=TRUE)
plot(mod1.e2, ylim=c(40, 65), lwd=4,
     residuals.pch=16)

Effect of income (by type) averaged over others

plot(predictorEffect("income", mod1),
     lines=list(multiline=TRUE, lwd=3),
     key.args = list(x=.7, y=.35),
    )

Diagnostic plots

In base graphics, plot() for an lm object gives the “regression quartet” of diagnostic plots.

op <- par(mfrow=c(2,2))
plot(mod1, lwd=2, cex.lab=1.4)

better QQ plots from car::qqPlot

Overall plot of residuals for mod1

qqPlot(mod1, pch=16)

## medical.technicians  electronic.workers 
##                  31                  82

QQ plots for individual variables and/or subsets

qqPlot(~ income, data=Prestige, subset = type == "prof")

## general.managers       physicians 
##                2               24
qqPlot(income ~ type, data=Prestige, layout=c(1, 3))

influence plot

car::influencePlot(mod1, id=list(n=2, cex=1.2), cex.lab=1.4)

##                     StudRes     Hat    CookD
## general.managers    -0.2834 0.28128 0.003969
## ministers            2.2992 0.19369 0.151516
## medical.technicians  2.8757 0.08799 0.092273
## farm.workers         0.9930 0.25501 0.042201
## electronic.workers   2.3233 0.08454 0.059407
IycgLS0tDQojJyB0aXRsZTogIkxpbmVhciBtb2RlbHMgZXhhbXBsZTogT2NjdXBhdGlvbmFsIFByZXN0aWdlIGRhdGEiDQojJyBhdXRob3I6ICJNaWNoYWVsIEZyaWVuZGx5Ig0KIycgZGF0ZTogIjE1IE5vdiAyMDIxIg0KIycgb3V0cHV0Og0KIycgICBodG1sX2RvY3VtZW50Og0KIycgICAgIHRoZW1lOiByZWFkYWJsZQ0KIycgICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCiMnIC0tLQ0KDQojKyBlY2hvPUZBTFNFDQprbml0cjo6b3B0c19jaHVuayRzZXQod2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRSwgUi5vcHRpb25zPWxpc3QoZGlnaXRzPTQpKQ0KDQojJyAjIyBMb2FkIHBhY2thZ2VzICYgUHJlc3RpZ2UgZGF0YQ0KIycgDQojJyBUaGUgYGNhcmAgYW5kIGBlZmZlY3RzYCBwYWNrYWdlcyBhcmUgdGhlIG1haW4gd29ya2hvcnNlcyBoZXJlLg0KDQpsaWJyYXJ5KCJjYXIiKQ0KbGlicmFyeSgiZWZmZWN0cyIpICAjIGVmZmVjdCBwbG90cw0KbGlicmFyeSgiYXJtIikgICAgICAjIGNvZWZwbG90cw0KZGF0YShQcmVzdGlnZSwgcGFja2FnZT0iY2FyRGF0YSIpDQoNCiMnICMjIFJlb3JkZXIgbGV2ZWxzIG9mIGB0eXBlYCBmYWN0b3INCiMnIA0KIycgSGVyZSBpdCBpcyB1c2VmdWwgdG8gcmVjb2duaXplIHRoYXQgImJjIiA8ICJ3YyIgPCAicHJvZiIuIERvIHNvIGJ5IG1ha2luZyBgUHJlc3RpZ2UkdHlwZWAgYW4gb3JkZXJlZCBmYWN0b3IuDQojJyBOb3RlIHRoYXQgdGhlIG9jY3VwYXRpb24gbmFtZXMgYXJlIHRoZSBgcm93Lm5hbWVzYCBpbiB0aGUgZGF0YS5mcmFtZSwgbm90IGEgc2VwYXJhdGUgdmFyaWFibGUuDQoNClByZXN0aWdlJHR5cGUgPC0gb3JkZXJlZChQcmVzdGlnZSR0eXBlLCBsZXZlbHM9YygiYmMiLCAid2MiLCAicHJvZiIpKSAjIHJlb3JkZXIgbGV2ZWxzDQpzb21lKFByZXN0aWdlLCA2KQ0KDQoNCg0KIycgIyMgc2NhdHRlcnBsb3RNYXRyaXgNCiMnIA0KIycgTGV0J3MgZ2V0IGEgdmlzdWFsIG92ZXJ2aWV3IG9mIHRoZSBkYXRhIGluIGEgc2NhdHRlcnBsb3QgbWF0cml4LiBJIHVzZSBvcHRpb25zIHRvIHNwZWNpZnkgYQ0KIycgbGluZWFyIHJlZ3Jlc3Npb24gbGluZSAoYHJlZ0xpbmU9YCksIGEgbG9lc3Mgc21vb3RoZWQgY3VydmUgKGBzbW9vdGg9YCkgYW5kIA0KIycgYSA2OCUgKH4gJFxiYXJ7eX0gXHBtIDEgc2QkKSBkYXRhIGVsbGlwc2UgKGBlbGxpcHNlPWApIGluIGVhY2ggcGFuZWwuDQoNCiMrIGZpZy53aWR0aD03LCBmaWcuaGVpZ2h0PTcNCnNjYXR0ZXJwbG90TWF0cml4KH4gcHJlc3RpZ2UgKyBlZHVjYXRpb24gKyBpbmNvbWUgKyB3b21lbiAsDQogICAgICAgICAgICAgICAgICBkYXRhPVByZXN0aWdlLA0KICAgICAgICAgICAgICAgICAgcmVnTGluZSA9IGxpc3QobWV0aG9kPWxtLCBsdHk9MSwgbHdkPTIsIGNvbD0iYmxhY2siKSwNCiAgICAgICAgICAgICAgICAgIHNtb290aD1saXN0KHNtb290aGVyPWxvZXNzTGluZSwgc3ByZWFkPUZBTFNFLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbHR5LnNtb290aD0xLCBsd2Quc21vb3RoPTMsIGNvbC5zbW9vdGg9InJlZCIpLA0KICAgICAgICAgICAgICAgICAgZWxsaXBzZT1saXN0KGxldmVscz0wLjY4LCBmaWxsLmFscGhhPTAuMSkpDQoNCg0KIycgIyMgRmFuY3kgc2NhdHRlcnBsb3RzDQoNCiMnIGBjYXI6OnNjYXR0ZXJwbG90YCBoYXMgbWFueSBvcHRpb25zIHRvIGFkZCBpbmZvcm1hdGl2ZSBhbm5vdGF0aW9ucywgbGFiZWwgdW51c3VhbCBwb2ludHMsIGV0Yy4NCiMnIFRoaXMgcGxvdCBzaG93cyBjbGVhcmx5IHRoYXQgaW5jb21lIGlzIHBvc2l0aXZlbHkgc2tld2VkIGFuZCB0aGUgcmVsYXRpb24gd2l0aCBgcHJlc3RpZ2VgIGlzIG5vbi1saW5lYXIuDQojJyBUaGUgYGlkID1gIGFyZ3VtZW50IGFsbG93cyB0byBpZGVudGlmeSB1bnVzdWFsIG9ic2VydmF0aW9ucyB3aXRoIHRoZWlyIGxhYmVscw0KDQpzY2F0dGVycGxvdChwcmVzdGlnZSB+IGluY29tZSwgZGF0YT1QcmVzdGlnZSwNCiAgICAgICAgICAgIHBjaCA9IDE2LA0KICAgICAgICAgICAgcmVnTGluZSA9IGxpc3QoY29sID0gInJlZCIsIGx3ZD0zKSwNCiAgICAgICAgICAgIHNtb290aCA9IGxpc3Qoc21vb3RoZXI9bG9lc3NMaW5lLA0KICAgICAgICAgICAgICAgICAgICAgICAgICBsdHkuc21vb3RoID0gMSwgY29sLnNtb290aCA9ICJibGFjayIsIGx3ZC5zbW9vdGg9MywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgY29sLnZhciA9ICJkYXJrZ3JlZW4iKSwNCiAgICAgICAgICAgIGVsbGlwc2UgPSBsaXN0KGxldmVscyA9IDAuNjgpLA0KICAgICAgICAgICAgaWQgPSBsaXN0KG49NCwgY29sPSJibGFjayIsIGNleD0xLjIpKQ0KDQojJyAjIyMgV2hhdCB3b3VsZCBsb2coaW5jb21lKSBsb29rIGxpa2U/DQojJyANCiMnIFJhdGhlciB0aGFuIGFjdHVhbGx5IHRyYW5zZm9ybWluZyBgaW5jb21lYCwgdGhlIGFyZ3VtZW50IGBsb2cgPSAieCJgIHNheXMgdG8gDQojJyBwbG90IGBpbmNvbWVgIG9uIGEgbG9nIHNjYWxlDQpzY2F0dGVycGxvdChwcmVzdGlnZSB+IGluY29tZSwgZGF0YT1QcmVzdGlnZSwgDQogICAgICAgICAgICBsb2cgPSAieCIsDQogICAgICAgICAgICBwY2ggPSAxNiwNCiAgICAgICAgICAgIHJlZ0xpbmUgPSBsaXN0KGNvbCA9ICJyZWQiLCBsd2Q9MyksDQogICAgICAgICAgICBzbW9vdGggPSBsaXN0KHNtb290aGVyPWxvZXNzTGluZSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgbHR5LnNtb290aCA9IDEsIGNvbC5zbW9vdGggPSAiYmxhY2siLCBsd2Quc21vb3RoPTMsDQogICAgICAgICAgICAgICAgICAgICAgICAgIGNvbC52YXIgPSAiZGFya2dyZWVuIiksDQogICAgICAgICAgICBlbGxpcHNlID0gbGlzdChsZXZlbHMgPSAwLjY4KSwgDQogICAgICAgICAgICBpZCA9IGxpc3Qobj00LCBjb2w9ImJsYWNrIiwgY2V4PTEuMikpDQoNCg0KIycgIyMjIFN0cmF0aWZ5IGJ5IHR5cGUNCiMnIA0KIycgVGhlIGZvcm11bGEgbm90YXRpb24gYH4gaW5jb21lIHwgdHlwZWAgc2F5cyB0byBkbyBwbG90IGFubm90YXRpb25zIGNvbmRpdGlvbmFsIG9uIG9jY3VwYXRpb24gdHlwZS4NCiMnIE9oLCBub3cgdGhhdCBoYXMgYSB2ZXJ5IGRpZmZlcmVudCBpbnRlcnByZXRhdGlvbiENCnNjYXR0ZXJwbG90KHByZXN0aWdlIH4gaW5jb21lIHwgdHlwZSwgZGF0YT1QcmVzdGlnZSwNCiAgICAgICAgICAgIGNvbCA9IGMoImJsdWUiLCAicmVkIiwgImRhcmtncmVlbiIpLA0KICAgICAgICAgICAgcGNoID0gMTU6MTcsDQogICAgICAgICAgICBsZWdlbmQgPSBsaXN0KGNvb3Jkcz0iYm90dG9tcmlnaHQiKSwNCiAgICAgICAgICAgIHNtb290aD1saXN0KHNtb290aGVyPWxvZXNzTGluZSwgDQogICAgICAgICAgICAgICAgICAgICAgICB2YXI9RkFMU0UsIHNwYW49MSwgbHdkPTQpKQ0KDQoNCg0KIycgIyMgRml0IHRoZSBiYXNpYyBhbGwtbWFpbi1lZmZlY3RzIG1vZGVsDQpkYXRhKFByZXN0aWdlKQ0KbW9kMCA8LSBsbShwcmVzdGlnZSB+IGVkdWNhdGlvbiArIGluY29tZSArIHdvbWVuICsgdHlwZSwNCiAgICAgICAgICAgZGF0YT1QcmVzdGlnZSkNCnN1bW1hcnkobW9kMCkNCg0KDQojJyAjIyBBZGQgbW9yZSBjb21wbGV4IHRlcm1zDQojJyANCiMnIEhlcmUgd2UgbW9kZWwgaW5jb21lIGFzIGBsb2coaW5jb21lKWBgDQojJyBhbmQgYWxsb3cgYW4gaW50ZXJhY3Rpb24NCiMnIHdpdGggb2NjdXBhdGlvbiBgdHlwZWAuDQptb2QxIDwtIGxtKHByZXN0aWdlIH4gZWR1Y2F0aW9uICsgd29tZW4gKw0KICAgICAgICAgICAgICAgICAgICAgbG9nKGluY29tZSkqdHlwZSwgZGF0YT1QcmVzdGlnZSkNCnN1bW1hcnkobW9kMSkNCg0KIycgIyMgUGxvdCBjb2VmZmljaWVudHMNCiMnIA0KIycgUGxvdHMgb2YgY29lZmZpY2llbnRzIHdpdGggQ0kgb2Z0ZW4gbW9yZSBpbmZvcm1hdGl2ZSB0aGF0IHRhYmxlcyBvZiBjb2VmZmljaWVudHMuIA0KIycgVGhlc2UgaW50ZXJ2YWxzIGFyZSBzaG93biBmb3IgJFxwbSAxLCBccG0gMiQgc3RhbmRhcmQgZXJyb3JzLg0KIycgDQojJyBIb3dldmVyLA0KIycgdGhpcyBwbG90cyB0aGUgX3JhdyBjb2VmZmljaWVudHNfLCB3aGljaCBhcmUgb24gZGlmZmVyZW50IHNjYWxlcywgc28gdGhlIHNtYWxsIGNvZWZmaWNpZW50cw0KIycgZm9yIGBpbmNvbWVgIGRvIG5vdCBhcHBlYXIgdG8gYmUgc2lnbmlmaWNhbnQuICBJdCB3b3VsZCBiZSBiZXR0ZXIgaWYgdGhlcmUgd2FzIGFuIG9wdGlvbg0KIycgdG8gcGxvdCBzdGFuZGFyZGl6ZWQgKCRcYmV0YSQpIGNvZWZmaWNpZW50cy4NCmFybTo6Y29lZnBsb3QobW9kMCwgY29sLnB0cz0icmVkIiwgY2V4LnB0cz0xLjUpDQphcm06OmNvZWZwbG90KG1vZDEsIGFkZD1UUlVFLCBjb2wucHRzPSJibHVlIiwgY2V4LnB0cz0xLjUpDQoNCiMnICMjIENvbXBhcmUgbW9kZWwgZml0cw0KIycgDQojJyBUaGlzIGBhbm92YWAgY2FsbCB0ZXN0cyB3aGV0aGVyIGBtb2QxYCBpcyBhIHNpZ25pZmljYW50IGltcHJvdmVtZW50IG92ZXIgdGhlIGJhc2VsaW5lIGBtb2QwYA0KYW5vdmEobW9kMCwgbW9kMSkNCg0KIycgIyMgRWZmZWN0IHBsb3RzDQogICAgICAgICAgICAgDQojJyBFZmZlY3Qgb2YgYGVkdWNhdGlvbmAgYXZlcmFnZWQgb3ZlciBvdGhlcnMNCm1vZDEuZTEgPC0gcHJlZGljdG9yRWZmZWN0KCJlZHVjYXRpb24iLCBtb2QxKQ0KcGxvdChtb2QxLmUxKQ0KDQojJyBFZmZlY3Qgb2YgYGVkdWNhdGlvbmAsIGJ1dCBzaG93aW5nIHBhcnRpYWwgcmVzaWR1YWxzLiBJbiBzb21lIGNhc2VzLCB0aGlzIHdpbGwgaGVscCBzcG90IGluZmx1ZW50aWFsIGNhc2VzDQojJyBpbiB0aGUgcGFydGlhbCByZWxhdGlvbiBvZiBhIHByZWRpY3RvciB0byB0aGUgcmVzcG9uc2UuDQoNCm1vZDEuZTFhIDwtIHByZWRpY3RvckVmZmVjdCgiZWR1Y2F0aW9uIiwgbW9kMSwgcmVzaWR1YWxzPVRSVUUpDQpwbG90KG1vZDEuZTFhLCANCiAgICAgcmVzaWR1YWxzLnBjaD0xNiwgaWQ9bGlzdChuPTQsIGNvbD0iYmxhY2siKSkNCg0KIycgRWZmZWN0IG9mIGB3b21lbmAgYXZlcmFnZWQgb3ZlciBvdGhlcnMuIFRoZSBibHVlIGN1cnZlIHNob3dzIHRoZSBmaXR0ZWQgcXVhZHJhdGljIHJlbGF0aW9uIGluIHRoZSBtb2RlbC4NCiMnIFRoZSByZWQgY3VydmUgc2hvd3MgYSBub24tcGFyYW1ldHJpYyBzbW9vb3RoLg0KDQptb2QxLmUyIDwtIHByZWRpY3RvckVmZmVjdCgid29tZW4iLCBtb2QxLCByZXNpZHVhbHM9VFJVRSkNCnBsb3QobW9kMS5lMiwgeWxpbT1jKDQwLCA2NSksIGx3ZD00LA0KICAgICByZXNpZHVhbHMucGNoPTE2KQ0KDQoNCiMnIEVmZmVjdCBvZiBgaW5jb21lYCAoYnkgYHR5cGVgKSBhdmVyYWdlZCBvdmVyIG90aGVycw0KDQpwbG90KHByZWRpY3RvckVmZmVjdCgiaW5jb21lIiwgbW9kMSksDQogICAgIGxpbmVzPWxpc3QobXVsdGlsaW5lPVRSVUUsIGx3ZD0zKSwNCiAgICAga2V5LmFyZ3MgPSBsaXN0KHg9LjcsIHk9LjM1KSwNCiAgICApDQoNCg0KIycgIyMgRGlhZ25vc3RpYyBwbG90cw0KIycgDQojJyBJbiBiYXNlIGdyYXBoaWNzLCBgcGxvdCgpYCBmb3IgYW4gYGxtYCBvYmplY3QgZ2l2ZXMgdGhlICJyZWdyZXNzaW9uIHF1YXJ0ZXQiIG9mIGRpYWdub3N0aWMgcGxvdHMuDQoNCiMrIGZpZy53aWR0aD03LCBmaWcuaGVpZ2h0PTcNCm9wIDwtIHBhcihtZnJvdz1jKDIsMikpDQpwbG90KG1vZDEsIGx3ZD0yLCBjZXgubGFiPTEuNCkNCg0KDQoNCiMnICMjIGJldHRlciBRUSBwbG90cyBmcm9tIGBjYXI6OnFxUGxvdGANCg0KIycgT3ZlcmFsbCBwbG90IG9mIHJlc2lkdWFscyBmb3IgYG1vZDFgDQojJyANCnFxUGxvdChtb2QxLCBwY2g9MTYpDQoNCiMnIFFRIHBsb3RzIGZvciBpbmRpdmlkdWFsIHZhcmlhYmxlcyBhbmQvb3Igc3Vic2V0cw0KIycgDQpxcVBsb3QofiBpbmNvbWUsIGRhdGE9UHJlc3RpZ2UsIHN1YnNldCA9IHR5cGUgPT0gInByb2YiKQ0KcXFQbG90KGluY29tZSB+IHR5cGUsIGRhdGE9UHJlc3RpZ2UsIGxheW91dD1jKDEsIDMpKQ0KDQoNCiMnICMjIGluZmx1ZW5jZSBwbG90DQojJw0KIysgZmlnLmhlaWdodD02LCBmaWcud2lkdGg9Nw0KY2FyOjppbmZsdWVuY2VQbG90KG1vZDEsIGlkPWxpc3Qobj0yLCBjZXg9MS4yKSwgY2V4LmxhYj0xLjQpDQoNCg0KDQoNCg==