The data consists of 24 cars measured on the following six variables:

  1. Cylinders Number of cylinders (cm3)
  2. Horsepower Horsepower (hp)
  3. Speed Maximum speed (km/h)
  4. Weight weight of the car (kg)
  5. Length length of the car (mm)
  6. Width width of the car (mm)
library(readxl)
cars2004 <- read_excel("cars2004.xls")
cars2004 <- as.data.frame(cars2004)
# nomear as linhas
nomes <- c(cars2004[1:24,1])
rownames(cars2004) <- nomes
# excluir coluna 1
cars2004 <- cars2004[,-1]
head(cars2004)

descriptive statistics

cars_stats = data.frame(
Minimum = apply(cars2004, 2, min),
Maximum = apply(cars2004, 2, max),
Mean = apply(cars2004, 2, mean),
Std_Dev = apply(cars2004, 2, sd))
print(cars_stats, print.gap = 3)

Before performing a PCA (or any other multivariate method) we should start with some preliminary explorations

  1. Descriptive statistics
  2. Basic graphical displays
  3. Distribution of variables
  4. Pair-wise correlations among variables
  5. Perhaps transforming some variables
# Stars plot
#Since we have a small number of observations (24 cars), we can use
#the function stars() to get an idea of the (dis)similarities between the cars:
# star plot
stars(cars2004, labels = abbreviate(rownames(cars2004), 6),
nrow = 4, key.loc = c(8, 11.2))
abbreviate used with non-ASCII chars
abline(h = 9.85, col = "gray90")

Look at the pair-wise scatterplot:

  1. What kind of patterns do you see?
  2. What variables seem to be correlated with each other?
  3. Are there any points (objects) that stand out?
  4. Is there anything in particular that calls your attention?
# scatterplot to inspect pair-wise relations
pairs(cars2004)

We can also examine the correlations among variables: all variables are positively correlated

# show lower triangular part of matrix of correlations
as.dist(round(cor(cars2004), 3))
           Cylinders Horsepower Speed Weight Width
Horsepower     0.954                              
Speed          0.885      0.934                   
Weight         0.692      0.529 0.466             
Width          0.706      0.730 0.619  0.477      
Length         0.664      0.527 0.578  0.795 0.591
?as.dist

PCA functions in R

Function Package Author

  1. prcomp() stats R Core Team
  2. princomp() stats R Core Team
  3. PCA() FactoMineR Husson, Josse, Le, Mazet
  4. dudi.pca() ade4 Chessel, Dufour, Dray
  5. acp() amap Lucas
  6. nipals() plsdepot Sanchez
  7. rda() vegan Oksanen et al
  8. pca() pcaMethods * Stacklies, Redestig, Wright

The minimal output from any PCA should contain 3 things:

  1. Eigenvalues provide information about the amount of variability captured by each principal component
  2. Scores or PCs that provide coordinates to graphically represent objects in a lower dimensional space
  3. Loadings provide information to determine what variables characterize each principal component

PCA with prcomp() - one of the default PCA functions in R is prcomp():

# PCA with prcomp()
cars_prcomp = prcomp(cars2004, scale. = TRUE)
# what does prcomp() provide?
names(cars_prcomp)
[1] "sdev"     "rotation" "center"   "scale"    "x"       
# eigenvalues
cars_prcomp$sdev^2
[1] 4.41126759 0.85340979 0.43566395 0.23587059 0.05143668 0.01235140
# scores
round(head(cars_prcomp$x, 5), 2)
                      PC1   PC2   PC3   PC4   PC5   PC6
Citroën C2 1.1 Base -2.54 -0.50 -0.18  0.16 -0.20  0.03
Smart Fortwo Coupé  -4.06 -1.63  0.27 -0.90 -0.03 -0.03
Mini 1.6 170        -1.35 -0.80  0.36 -0.05  0.45  0.05
Nissan Micra 1.2 65 -2.46 -0.40 -0.17  0.12 -0.28  0.05
Renault Clio 3.0 V6  0.00 -0.90  0.38 -0.27  0.28 -0.13
# loadings
round(head(cars_prcomp$rotation, 5), 2)
            PC1   PC2   PC3   PC4   PC5   PC6
Cylinders  0.46 -0.14  0.21 -0.23 -0.65 -0.50
Horsepower 0.44 -0.38  0.14 -0.17 -0.09  0.78
Speed      0.42 -0.37  0.31  0.41  0.57 -0.31
Weight     0.36  0.62  0.22 -0.53  0.39 -0.01
Width      0.38 -0.12 -0.88 -0.14  0.15 -0.13

PCA with princomp() - The other default PCA function is princomp()

# PCA with princomp()
cars_princomp = princomp(cars2004, cor = TRUE)
# what does princomp() provide?
names(cars_princomp)
[1] "sdev"     "loadings" "center"   "scale"    "n.obs"    "scores"   "call"    
cars_princomp$sdev^2
    Comp.1     Comp.2     Comp.3     Comp.4     Comp.5     Comp.6 
4.41126759 0.85340979 0.43566395 0.23587059 0.05143668 0.01235140 
# scores
round(head(cars_princomp$scores, 5), 3)
                    Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
Citroën C2 1.1 Base  2.596  0.510  0.179  0.166  0.207  0.032
Smart Fortwo Coupé   4.150  1.666 -0.274 -0.924  0.029 -0.034
Mini 1.6 170         1.382  0.816 -0.372 -0.051 -0.464  0.051
Nissan Micra 1.2 65  2.513  0.404  0.174  0.124  0.289  0.051
Renault Clio 3.0 V6  0.003  0.916 -0.385 -0.274 -0.286 -0.134
# loadings
round(head(unclass(cars_princomp$loadings), 5), 3)
           Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
Cylinders  -0.458  0.137 -0.214 -0.232  0.652 -0.496
Horsepower -0.440  0.382 -0.137 -0.173  0.094  0.777
Speed      -0.422  0.367 -0.313  0.410 -0.569 -0.314
Weight     -0.360 -0.623 -0.223 -0.529 -0.389 -0.008
Width      -0.381  0.120  0.883 -0.140 -0.153 -0.132

PCA() with FactoMineR

#load FactoMineR
library(FactoMineR)
# nice PCA
cars_pca = PCA(cars2004, graph = FALSE)
# what does PCA provide?
cars_pca
**Results for the Principal Component Analysis (PCA)**
The analysis was performed on 24 individuals, described by 6 variables
*The results are available in the following objects:

   name               description                          
1  "$eig"             "eigenvalues"                        
2  "$var"             "results for the variables"          
3  "$var$coord"       "coord. for the variables"           
4  "$var$cor"         "correlations variables - dimensions"
5  "$var$cos2"        "cos2 for the variables"             
6  "$var$contrib"     "contributions of the variables"     
7  "$ind"             "results for the individuals"        
8  "$ind$coord"       "coord. for the individuals"         
9  "$ind$cos2"        "cos2 for the individuals"           
10 "$ind$contrib"     "contributions of the individuals"   
11 "$call"            "summary statistics"                 
12 "$call$centre"     "mean of the variables"              
13 "$call$ecart.type" "standard error of the variables"    
14 "$call$row.w"      "weights for the individuals"        
15 "$call$col.w"      "weights for the variables"          

Extensive output: As you can tell, there is an extensive list of results provided in the output of PCA() —by FactoMineR

Reading results: We’ll discuss how to interpret the main results from PCA() and what things we should pay attention to

Graphical Examination: With the obtained scores and loadings we can get several graphical displays

Some graphics

  1. correlations between scores and variables
  2. relationships among variables
  3. positions of objects on the score plots
  4. (dis)siminalirities among objects
  5. relationships between objects and variables

Some questions to keep in mind

  1. How many PCs should be retained?
  2. How good (or bad) is the data approximation with the reatined PCs?
  3. What variables characterize each PC?
  4. Which variables are influential, and how are they correlated?
  5. Which variables are responsible for the patterns among objects?
  6. Are there any outlier objects?

How many PCs to retain? There is no universal criterion to determine the number of PCs to retain. But we must look at the eigenvalues and see what’s the percentage of variance captured by each dimension:

# table of eigenvalues
cars_pca$eig
# screeplot of eigenvalues
barplot(cars_pca$eig[,"eigenvalue"], border = NA, col = "gray80", names.arg = rownames(cars_pca$eig))

What variables characterize each PC?

To see how each PC is characterized, we either check the loadings or the correlations between the variables and the PCs:

# correlations between variables and PCs
round(cars_pca$var$coord[,1:2], 4)
            Dim.1   Dim.2
Cylinders  0.9624 -0.1269
Horsepower 0.9233 -0.3527
Speed      0.8861 -0.3387
Weight     0.7569  0.5757
Width      0.8012 -0.1110
Length     0.7953  0.5044

Circle of Correlations

  1. We can read this plot as a radar.
  2. The closer an arrow is to the circumference of the circle, the better its representation on the given axes.
  3. Also note how the variables are grouped.
# plot circle of correlations
plot(cars_pca, choix = "var")

Influence of variables on each PC?

We can also examine the contributions of the variables

If all variables were to contribute uniformly, they would have a contribution of 1/6 or 16.67%.

# Contribution of variables
print(rbind(cars_pca$var$contrib, TOTAL = colSums(cars_pca$var$contrib)), print.gap = 3)
                 Dim.1        Dim.2         Dim.3        Dim.4         Dim.5
Cylinders     20.99685     1.888053     4.5963914     5.385321    42.5754114
Horsepower    19.32581    14.572896     1.8738150     2.986455     0.8920753
Speed         17.79960    13.445643     9.7721157    16.807651    32.3352042
Weight        12.98761    38.836725     4.9895558    28.029702    15.1507636
Width         14.55312     1.444225    77.9635912     1.958483     2.3414907
Length        14.33701    29.812457     0.8045309    44.832387     6.7050548
TOTAL        100.00000   100.000000   100.0000000   100.000000   100.0000000

To inspect what variables are above and below 16.67 we can create a barplot of variable contributions in the following form:

library(RColorBrewer)
# color palette
colpal = brewer.pal(n = 5, name = "Blues")[5:1]
# Contribution of variables
barplot(t(cars_pca$var$contrib), beside = TRUE,
border = NA, ylim = c(0, 90), col = colpal,
legend.text = colnames(cars_pca$var$contrib),
args.legend = list(x = "top", ncol = 5, bty = 'n'))
abline(h = 16, col = "#ff572255", lwd = 2)

PC scores: We can use the scores as coordinates to plot the objects in a scatterplot

# PC scores (first 2 dimesions)
print(round(cars_pca$ind$coord[,1:2], 3),
print.gap = 3)
                                 Dim.1    Dim.2
Citroën C2 1.1 Base             -2.596   -0.510
Smart Fortwo Coupé              -4.150   -1.666
Mini 1.6 170                    -1.382   -0.816
Nissan Micra 1.2 65             -2.513   -0.404
Renault Clio 3.0 V6             -0.003   -0.916
Audi A3 1.9 TDI                 -1.121    0.169
Peugeot 307 1.4 HDI 70          -1.725    0.300
Peugeot 407 3.0 V6 BVA           0.553    0.523
Mercedes Classe C 270 CDI        0.078    0.482
BMW 530d                         0.838    0.460
Jaguar S-Type 2.7 V6 Bi-Turbo    0.721    0.898
BMW  745i                        2.126    0.610
Mercedes Classe S 400 CDI        2.167    0.810
Citroën C3 Pluriel 1.6i         -1.623   -0.218
BMW Z4 2.5i                     -0.399   -0.596
Audi TT 1.8T 180                -0.751   -0.459
Aston Martin Vanquish            3.155   -0.639
Bentley Continental GT           4.161    0.064
Ferrari Enzo                     4.946   -2.580
Renault Scenic 1.9 dCi 120      -0.842    0.380
Volkswagen Touran 1.9 TDI 105   -0.805    0.713
Land Rover Defender Td5         -1.072    0.751
Land Rover Discovery Td5         0.851    1.920
Nissan X-Trail 2.2 dCi          -0.614    0.722

Default plot of objects in FactoMineR

# plot of scores
plot(cars_pca, choix = "ind")

Alternative plot of objects with ggplot2

# load ggplot2
library(ggplot2)
# data frame with observations from PCA results
cars_pca_obs = data.frame(cars_pca$ind$coord[,1:3])
# PCA plots of observations
ggplot(cars_pca_obs, aes(x = Dim.1, y = Dim.2, label = rownames(cars2004))) +
geom_hline(yintercept = 0, color = "gray70") +
geom_vline(xintercept = 0, color = "gray70") +
geom_point(color = "#55555544", size = 5) +
geom_text(alpha = 0.55, size = 4) +
xlab("PC1") +
ylab("PC2") +
xlim(-5, 6) +
ggtitle("PCA plot of observations")

Contributions of objects to PCs

The contributions (in percentage) reflect the influence that each object has on the formation of the PCs. If all objects had the same contribution on each PC, they would contribute with a value of 4.16 = 100/24

# Contributions on PCs (first 2 dimesions)
print(round(cars_pca$ind$contrib[,1:2], 3),
print.gap = 3)
                                 Dim.1    Dim.2
Citroën C2 1.1 Base              6.365    1.270
Smart Fortwo Coupé              16.269   13.550
Mini 1.6 170                     1.804    3.249
Nissan Micra 1.2 65              5.967    0.795
Renault Clio 3.0 V6              0.000    4.092
Audi A3 1.9 TDI                  1.186    0.139
Peugeot 307 1.4 HDI 70           2.812    0.441
Peugeot 407 3.0 V6 BVA           0.288    1.336
Mercedes Classe C 270 CDI        0.006    1.133
BMW 530d                         0.663    1.033
Jaguar S-Type 2.7 V6 Bi-Turbo    0.492    3.935
BMW  745i                        4.271    1.816
Mercedes Classe S 400 CDI        4.434    3.201
Citroën C3 Pluriel 1.6i          2.487    0.231
BMW Z4 2.5i                      0.150    1.734
Audi TT 1.8T 180                 0.533    1.030
Aston Martin Vanquish            9.404    1.997
Bentley Continental GT          16.352    0.020
Ferrari Enzo                    23.110   32.503
Renault Scenic 1.9 dCi 120       0.669    0.706
Volkswagen Touran 1.9 TDI 105    0.612    2.481
Land Rover Defender Td5          1.085    2.757
Land Rover Discovery Td5         0.683   18.004
Nissan X-Trail 2.2 dCi           0.357    2.547

Barplots of object contributions to PCs

op = par(mfrow = c(2,1))
# barplot of object contributions for PC1
barplot(cars_pca$ind$contrib[,1], border = NA, las = 2,
names.arg = abbreviate(rownames(cars2004), 8), cex.names = 0.8)
abbreviate used with non-ASCII chars
title("Object Contributions on PC1", cex.main = 0.9)
abline(h = 4.16, col = "gray50")
# barplot of object contributions for PC2
barplot(cars_pca$ind$contrib[,2], border = NA, las = 2,
names.arg = abbreviate(rownames(cars2004), 8), cex.names = 0.8)
abbreviate used with non-ASCII chars
title("Object Contributions on PC2", cex.main = 0.9)
abline(h = 4.16, col = "gray50")
par(op)

PCA with Clustering

We can gain some insight by combining PCA and Clustering

  1. Is there a typology of objects?
  2. How could they be clustered?

One option is to apply a hierarchical clustering to the obtained scores, and then add the clustered groups to the Scores scatterplot

Hierarchical Clustering

# clustering
cars_clustering = hclust(dist(cars_pca$ind$coord), method = "ward")
The "ward" method has been renamed to "ward.D"; note new "ward.D2"
plot(cars_clustering, xlab = "", sub = "")

PC plot with clustering partition

# get 3 cluster
cars_clusters = cutree(cars_clustering, k = 3)
# add cluster to data frame of scores
cars_pca_obs$cluster = as.factor(cars_clusters)
# ggplot
ggplot(cars_pca_obs, aes(x=Dim.1, y=Dim.2, label=rownames(cars2004))) +
geom_hline(yintercept = 0, color = "gray70") +
geom_vline(xintercept = 0, color = "gray70") +
geom_point(aes(color = cluster), alpha = 0.55, size = 3) +
geom_text(aes(color = cluster), alpha = 0.55, size = 4) +
xlab("PC1") +
ylab("PC2") +
xlim(-5, 6) +
ggtitle("PCA plot of observations")

library(ggrepel)
# vamos arrumar o gráfico anterior.
# geom_text_repel
# get 3 cluster
cars_clusters = cutree(cars_clustering, k = 3)
# add cluster to data frame of scores
cars_pca_obs$cluster = as.factor(cars_clusters)
# ggplot
ggplot(cars_pca_obs, aes(x=Dim.1, y=Dim.2, label=rownames(cars2004))) +
geom_hline(yintercept = 0, color = "gray70") +
geom_vline(xintercept = 0, color = "gray70") +
geom_point(aes(color = cluster), alpha = 0.55, size = 3) +
geom_text_repel(aes(color = cluster), alpha = 0.55, size = 4) +
xlab("PC1") +
ylab("PC2") +
xlim(-5, 6) +
ggtitle("PCA plot of observations")

LS0tDQp0aXRsZTogIkNhcnMgMjAwNCAtIFBDQSBhbmQgQ2x1c3RlcnMiDQphdXRob3I6ICJMZW9uaSwgUi4gQy4gUHJvZmVzc29yIERyLiINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoqKioNCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IEYpDQpgYGANCg0KDQo+IFRoZSBkYXRhIGNvbnNpc3RzIG9mIDI0IGNhcnMgbWVhc3VyZWQgb24gdGhlIGZvbGxvd2luZyBzaXggdmFyaWFibGVzOg0KDQoxLiBDeWxpbmRlcnMgTnVtYmVyIG9mIGN5bGluZGVycyAoY20zKQ0KMi4gSG9yc2Vwb3dlciBIb3JzZXBvd2VyIChocCkNCjMuIFNwZWVkIE1heGltdW0gc3BlZWQgKGttL2gpDQo0LiBXZWlnaHQgd2VpZ2h0IG9mIHRoZSBjYXIgKGtnKQ0KNS4gTGVuZ3RoIGxlbmd0aCBvZiB0aGUgY2FyIChtbSkNCjYuIFdpZHRoIHdpZHRoIG9mIHRoZSBjYXIgKG1tKQ0KDQpgYGB7cn0NCmxpYnJhcnkocmVhZHhsKQ0KY2FyczIwMDQgPC0gcmVhZF9leGNlbCgiY2FyczIwMDQueGxzIikNCg0KY2FyczIwMDQgPC0gYXMuZGF0YS5mcmFtZShjYXJzMjAwNCkNCg0KIyBub21lYXIgYXMgbGluaGFzDQpub21lcyA8LSBjKGNhcnMyMDA0WzE6MjQsMV0pDQpyb3duYW1lcyhjYXJzMjAwNCkgPC0gbm9tZXMNCg0KIyBleGNsdWlyIGNvbHVuYSAxDQpjYXJzMjAwNCA8LSBjYXJzMjAwNFssLTFdDQoNCmhlYWQoY2FyczIwMDQpDQoNCmBgYA0KDQoNCj4gZGVzY3JpcHRpdmUgc3RhdGlzdGljcw0KDQpgYGB7cn0NCmNhcnNfc3RhdHMgPSBkYXRhLmZyYW1lKA0KTWluaW11bSA9IGFwcGx5KGNhcnMyMDA0LCAyLCBtaW4pLA0KTWF4aW11bSA9IGFwcGx5KGNhcnMyMDA0LCAyLCBtYXgpLA0KTWVhbiA9IGFwcGx5KGNhcnMyMDA0LCAyLCBtZWFuKSwNClN0ZF9EZXYgPSBhcHBseShjYXJzMjAwNCwgMiwgc2QpKQ0KcHJpbnQoY2Fyc19zdGF0cywgcHJpbnQuZ2FwID0gMykNCmBgYA0KDQo+IEJlZm9yZSBwZXJmb3JtaW5nIGEgUENBIChvciBhbnkgb3RoZXIgbXVsdGl2YXJpYXRlIG1ldGhvZCkgd2Ugc2hvdWxkIHN0YXJ0IHdpdGggc29tZSBwcmVsaW1pbmFyeSBleHBsb3JhdGlvbnMNCg0KMS4gRGVzY3JpcHRpdmUgc3RhdGlzdGljcw0KMi4gQmFzaWMgZ3JhcGhpY2FsIGRpc3BsYXlzDQozLiBEaXN0cmlidXRpb24gb2YgdmFyaWFibGVzDQo0LiBQYWlyLXdpc2UgY29ycmVsYXRpb25zIGFtb25nIHZhcmlhYmxlcw0KNS4gUGVyaGFwcyB0cmFuc2Zvcm1pbmcgc29tZSB2YXJpYWJsZXMNCg0KYGBge3IsIGZpZy5oZWlnaHQ9OCwgZmlnLndpZHRoPTksIG1lc3NhZ2U9Rn0NCiMgU3RhcnMgcGxvdA0KI1NpbmNlIHdlIGhhdmUgYSBzbWFsbCBudW1iZXIgb2Ygb2JzZXJ2YXRpb25zICgyNCBjYXJzKSwgd2UgY2FuIHVzZQ0KI3RoZSBmdW5jdGlvbiBzdGFycygpIHRvIGdldCBhbiBpZGVhIG9mIHRoZSAoZGlzKXNpbWlsYXJpdGllcyBiZXR3ZWVuIHRoZSBjYXJzOg0KIyBzdGFyIHBsb3QNCnN0YXJzKGNhcnMyMDA0LCBsYWJlbHMgPSBhYmJyZXZpYXRlKHJvd25hbWVzKGNhcnMyMDA0KSwgNiksDQpucm93ID0gNCwga2V5LmxvYyA9IGMoOCwgMTEuMikpDQphYmxpbmUoaCA9IDkuODUsIGNvbCA9ICJncmF5OTAiKQ0KDQpgYGANCg0KPiBMb29rIGF0IHRoZSBwYWlyLXdpc2Ugc2NhdHRlcnBsb3Q6DQoNCjEuIFdoYXQga2luZCBvZiBwYXR0ZXJucyBkbyB5b3Ugc2VlPw0KMi4gV2hhdCB2YXJpYWJsZXMgc2VlbSB0byBiZSBjb3JyZWxhdGVkIHdpdGggZWFjaCBvdGhlcj8NCjMuIEFyZSB0aGVyZSBhbnkgcG9pbnRzIChvYmplY3RzKSB0aGF0IHN0YW5kIG91dD8NCjQuIElzIHRoZXJlIGFueXRoaW5nIGluIHBhcnRpY3VsYXIgdGhhdCBjYWxscyB5b3VyIGF0dGVudGlvbj8NCg0KYGBge3J9DQojIHNjYXR0ZXJwbG90IHRvIGluc3BlY3QgcGFpci13aXNlIHJlbGF0aW9ucw0KcGFpcnMoY2FyczIwMDQpDQpgYGANCg0KPiBXZSBjYW4gYWxzbyBleGFtaW5lIHRoZSBjb3JyZWxhdGlvbnMgYW1vbmcgdmFyaWFibGVzOiBhbGwgdmFyaWFibGVzIGFyZSBwb3NpdGl2ZWx5IGNvcnJlbGF0ZWQNCg0KYGBge3J9DQojIHNob3cgbG93ZXIgdHJpYW5ndWxhciBwYXJ0IG9mIG1hdHJpeCBvZiBjb3JyZWxhdGlvbnMNCmFzLmRpc3Qocm91bmQoY29yKGNhcnMyMDA0KSwgMykpDQoNCj9hcy5kaXN0DQpgYGANCg0KPiBQQ0EgZnVuY3Rpb25zIGluIFINCg0KPiBGdW5jdGlvbiBQYWNrYWdlIEF1dGhvcg0KDQoxLiBwcmNvbXAoKSBzdGF0cyBSIENvcmUgVGVhbQ0KMi4gcHJpbmNvbXAoKSBzdGF0cyBSIENvcmUgVGVhbQ0KMy4gUENBKCkgRmFjdG9NaW5lUiBIdXNzb24sIEpvc3NlLCBMZSwgTWF6ZXQNCjQuIGR1ZGkucGNhKCkgYWRlNCBDaGVzc2VsLCBEdWZvdXIsIERyYXkNCjUuIGFjcCgpIGFtYXAgTHVjYXMNCjYuIG5pcGFscygpIHBsc2RlcG90IFNhbmNoZXoNCjcuIHJkYSgpIHZlZ2FuIE9rc2FuZW4gZXQgYWwNCjguIHBjYSgpIHBjYU1ldGhvZHMgKiBTdGFja2xpZXMsIFJlZGVzdGlnLCBXcmlnaHQNCg0KDQo+IFRoZSBtaW5pbWFsIG91dHB1dCBmcm9tIGFueSBQQ0Egc2hvdWxkIGNvbnRhaW4gMyB0aGluZ3M6DQoNCjEuIEVpZ2VudmFsdWVzIHByb3ZpZGUgaW5mb3JtYXRpb24gYWJvdXQgdGhlIGFtb3VudCBvZiB2YXJpYWJpbGl0eSBjYXB0dXJlZCBieSBlYWNoIHByaW5jaXBhbCBjb21wb25lbnQNCjIuIFNjb3JlcyBvciBQQ3MgdGhhdCBwcm92aWRlIGNvb3JkaW5hdGVzIHRvIGdyYXBoaWNhbGx5IHJlcHJlc2VudCBvYmplY3RzIGluIGEgbG93ZXIgZGltZW5zaW9uYWwgc3BhY2UNCjMuIExvYWRpbmdzIHByb3ZpZGUgaW5mb3JtYXRpb24gdG8gZGV0ZXJtaW5lIHdoYXQgdmFyaWFibGVzIGNoYXJhY3Rlcml6ZSBlYWNoIHByaW5jaXBhbCBjb21wb25lbnQgDQoNCj4gUENBIHdpdGggcHJjb21wKCkgLSBvbmUgb2YgdGhlIGRlZmF1bHQgUENBIGZ1bmN0aW9ucyBpbiBSIGlzIHByY29tcCgpOg0KDQpgYGB7cn0NCiMgUENBIHdpdGggcHJjb21wKCkNCmNhcnNfcHJjb21wID0gcHJjb21wKGNhcnMyMDA0LCBzY2FsZS4gPSBUUlVFKQ0KIyB3aGF0IGRvZXMgcHJjb21wKCkgcHJvdmlkZT8NCm5hbWVzKGNhcnNfcHJjb21wKQ0KIyBlaWdlbnZhbHVlcw0KY2Fyc19wcmNvbXAkc2Rldl4yDQojIHNjb3Jlcw0Kcm91bmQoaGVhZChjYXJzX3ByY29tcCR4LCA1KSwgMikNCiMgbG9hZGluZ3MNCnJvdW5kKGhlYWQoY2Fyc19wcmNvbXAkcm90YXRpb24sIDUpLCAyKQ0KDQpgYGANCg0KPiBQQ0Egd2l0aCBwcmluY29tcCgpIC0gVGhlIG90aGVyIGRlZmF1bHQgUENBIGZ1bmN0aW9uIGlzIHByaW5jb21wKCkNCg0KYGBge3J9DQojIFBDQSB3aXRoIHByaW5jb21wKCkNCmNhcnNfcHJpbmNvbXAgPSBwcmluY29tcChjYXJzMjAwNCwgY29yID0gVFJVRSkNCiMgd2hhdCBkb2VzIHByaW5jb21wKCkgcHJvdmlkZT8NCm5hbWVzKGNhcnNfcHJpbmNvbXApDQpjYXJzX3ByaW5jb21wJHNkZXZeMg0KIyBzY29yZXMNCnJvdW5kKGhlYWQoY2Fyc19wcmluY29tcCRzY29yZXMsIDUpLCAzKQ0KIyBsb2FkaW5ncw0Kcm91bmQoaGVhZCh1bmNsYXNzKGNhcnNfcHJpbmNvbXAkbG9hZGluZ3MpLCA1KSwgMykNCmBgYA0KDQo+IFBDQSgpIHdpdGggRmFjdG9NaW5lUg0KDQpgYGB7ciwgbWVzc2FnZT1GfQ0KI2xvYWQgRmFjdG9NaW5lUg0KbGlicmFyeShGYWN0b01pbmVSKQ0KIyBuaWNlIFBDQQ0KY2Fyc19wY2EgPSBQQ0EoY2FyczIwMDQsIGdyYXBoID0gRkFMU0UpDQojIHdoYXQgZG9lcyBQQ0EgcHJvdmlkZT8NCmNhcnNfcGNhDQoNCmBgYA0KPiBFeHRlbnNpdmUgb3V0cHV0OiBBcyB5b3UgY2FuIHRlbGwsIHRoZXJlIGlzIGFuIGV4dGVuc2l2ZSBsaXN0IG9mIHJlc3VsdHMgcHJvdmlkZWQgaW4gdGhlIG91dHB1dCBvZiBQQ0EoKSDigJRieSBGYWN0b01pbmVSDQoNCj4gUmVhZGluZyByZXN1bHRzOiBXZeKAmWxsIGRpc2N1c3MgaG93IHRvIGludGVycHJldCB0aGUgbWFpbiByZXN1bHRzIGZyb20gUENBKCkgYW5kIHdoYXQgdGhpbmdzIHdlIHNob3VsZCBwYXkgYXR0ZW50aW9uIHRvDQoNCj4gR3JhcGhpY2FsIEV4YW1pbmF0aW9uOiAgV2l0aCB0aGUgb2J0YWluZWQgc2NvcmVzIGFuZCBsb2FkaW5ncyB3ZSBjYW4gZ2V0IHNldmVyYWwgZ3JhcGhpY2FsIGRpc3BsYXlzDQoNCj4gU29tZSBncmFwaGljcw0KDQoxLiBjb3JyZWxhdGlvbnMgYmV0d2VlbiBzY29yZXMgYW5kIHZhcmlhYmxlcw0KMi4gcmVsYXRpb25zaGlwcyBhbW9uZyB2YXJpYWJsZXMNCjMuIHBvc2l0aW9ucyBvZiBvYmplY3RzIG9uIHRoZSBzY29yZSBwbG90cw0KNC4gKGRpcylzaW1pbmFsaXJpdGllcyBhbW9uZyBvYmplY3RzDQo1LiByZWxhdGlvbnNoaXBzIGJldHdlZW4gb2JqZWN0cyBhbmQgdmFyaWFibGVzDQoNCj4gU29tZSBxdWVzdGlvbnMgdG8ga2VlcCBpbiBtaW5kDQoNCjEuIEhvdyBtYW55IFBDcyBzaG91bGQgYmUgcmV0YWluZWQ/DQoyLiBIb3cgZ29vZCAob3IgYmFkKSBpcyB0aGUgZGF0YSBhcHByb3hpbWF0aW9uIHdpdGggdGhlIHJlYXRpbmVkIFBDcz8NCjMuIFdoYXQgdmFyaWFibGVzIGNoYXJhY3Rlcml6ZSBlYWNoIFBDPw0KNC4gV2hpY2ggdmFyaWFibGVzIGFyZSBpbmZsdWVudGlhbCwgYW5kIGhvdyBhcmUgdGhleSBjb3JyZWxhdGVkPw0KNS4gV2hpY2ggdmFyaWFibGVzIGFyZSByZXNwb25zaWJsZSBmb3IgdGhlIHBhdHRlcm5zIGFtb25nIG9iamVjdHM/DQo2LiBBcmUgdGhlcmUgYW55IG91dGxpZXIgb2JqZWN0cz8NCg0KPiBIb3cgbWFueSBQQ3MgdG8gcmV0YWluPyAgVGhlcmUgaXMgbm8gdW5pdmVyc2FsIGNyaXRlcmlvbiB0byBkZXRlcm1pbmUgdGhlIG51bWJlciBvZiBQQ3MgdG8gcmV0YWluLiBCdXQgd2UgbXVzdCBsb29rIGF0IHRoZSBlaWdlbnZhbHVlcyBhbmQgc2VlIHdoYXTigJlzIHRoZSBwZXJjZW50YWdlIG9mIHZhcmlhbmNlIGNhcHR1cmVkIGJ5IGVhY2ggZGltZW5zaW9uOg0KDQpgYGB7cn0NCiMgdGFibGUgb2YgZWlnZW52YWx1ZXMNCmNhcnNfcGNhJGVpZw0KIyBzY3JlZXBsb3Qgb2YgZWlnZW52YWx1ZXMNCmJhcnBsb3QoY2Fyc19wY2EkZWlnWywiZWlnZW52YWx1ZSJdLCBib3JkZXIgPSBOQSwgY29sID0gImdyYXk4MCIsIG5hbWVzLmFyZyA9IHJvd25hbWVzKGNhcnNfcGNhJGVpZykpDQoNCmBgYA0KDQo+IFdoYXQgdmFyaWFibGVzIGNoYXJhY3Rlcml6ZSBlYWNoIFBDPyANCg0KPiBUbyBzZWUgaG93IGVhY2ggUEMgaXMgY2hhcmFjdGVyaXplZCwgd2UgZWl0aGVyIGNoZWNrIHRoZSBsb2FkaW5ncyBvciB0aGUgY29ycmVsYXRpb25zIGJldHdlZW4gdGhlIHZhcmlhYmxlcyBhbmQgdGhlIFBDczoNCg0KYGBge3J9DQojIGNvcnJlbGF0aW9ucyBiZXR3ZWVuIHZhcmlhYmxlcyBhbmQgUENzDQpyb3VuZChjYXJzX3BjYSR2YXIkY29vcmRbLDE6Ml0sIDQpDQpgYGANCg0KPiBDaXJjbGUgb2YgQ29ycmVsYXRpb25zDQoNCjEuIFdlIGNhbiByZWFkIHRoaXMgcGxvdCBhcyBhIHJhZGFyLg0KMi4gVGhlIGNsb3NlciBhbiBhcnJvdyBpcyB0byB0aGUgY2lyY3VtZmVyZW5jZSBvZiB0aGUgY2lyY2xlLCB0aGUgYmV0dGVyIGl0cyByZXByZXNlbnRhdGlvbiBvbiB0aGUgZ2l2ZW4gYXhlcy4NCjMuIEFsc28gbm90ZSBob3cgdGhlIHZhcmlhYmxlcyBhcmUgZ3JvdXBlZC4NCg0KYGBge3J9DQojIHBsb3QgY2lyY2xlIG9mIGNvcnJlbGF0aW9ucw0KcGxvdChjYXJzX3BjYSwgY2hvaXggPSAidmFyIikNCmBgYA0KDQo+IEluZmx1ZW5jZSBvZiB2YXJpYWJsZXMgb24gZWFjaCBQQz8NCg0KPiBXZSBjYW4gYWxzbyBleGFtaW5lIHRoZSBjb250cmlidXRpb25zIG9mIHRoZSB2YXJpYWJsZXMNCg0KPiBJZiBhbGwgdmFyaWFibGVzIHdlcmUgdG8gY29udHJpYnV0ZSB1bmlmb3JtbHksIHRoZXkgd291bGQgaGF2ZSBhIGNvbnRyaWJ1dGlvbiBvZiAxLzYgb3IgMTYuNjclLg0KDQpgYGB7cn0NCiMgQ29udHJpYnV0aW9uIG9mIHZhcmlhYmxlcw0KcHJpbnQocmJpbmQoY2Fyc19wY2EkdmFyJGNvbnRyaWIsIFRPVEFMID0gY29sU3VtcyhjYXJzX3BjYSR2YXIkY29udHJpYikpLCBwcmludC5nYXAgPSAzKQ0KYGBgDQoNCg0KPiBUbyBpbnNwZWN0IHdoYXQgdmFyaWFibGVzIGFyZSBhYm92ZSBhbmQgYmVsb3cgMTYuNjcgd2UgY2FuIGNyZWF0ZSBhIGJhcnBsb3Qgb2YgdmFyaWFibGUgY29udHJpYnV0aW9ucyBpbiB0aGUgZm9sbG93aW5nIGZvcm06DQoNCmBgYHtyfQ0KbGlicmFyeShSQ29sb3JCcmV3ZXIpDQojIGNvbG9yIHBhbGV0dGUNCmNvbHBhbCA9IGJyZXdlci5wYWwobiA9IDUsIG5hbWUgPSAiQmx1ZXMiKVs1OjFdDQojIENvbnRyaWJ1dGlvbiBvZiB2YXJpYWJsZXMNCmJhcnBsb3QodChjYXJzX3BjYSR2YXIkY29udHJpYiksIGJlc2lkZSA9IFRSVUUsDQpib3JkZXIgPSBOQSwgeWxpbSA9IGMoMCwgOTApLCBjb2wgPSBjb2xwYWwsDQpsZWdlbmQudGV4dCA9IGNvbG5hbWVzKGNhcnNfcGNhJHZhciRjb250cmliKSwNCmFyZ3MubGVnZW5kID0gbGlzdCh4ID0gInRvcCIsIG5jb2wgPSA1LCBidHkgPSAnbicpKQ0KYWJsaW5lKGggPSAxNiwgY29sID0gIiNmZjU3MjI1NSIsIGx3ZCA9IDIpDQpgYGANCg0KDQoNCj4gIFBDIHNjb3JlczogV2UgY2FuIHVzZSB0aGUgc2NvcmVzIGFzIGNvb3JkaW5hdGVzIHRvIHBsb3QgdGhlIG9iamVjdHMgaW4gYSBzY2F0dGVycGxvdA0KDQpgYGB7cn0NCiMgUEMgc2NvcmVzIChmaXJzdCAyIGRpbWVzaW9ucykNCnByaW50KHJvdW5kKGNhcnNfcGNhJGluZCRjb29yZFssMToyXSwgMyksDQpwcmludC5nYXAgPSAzKQ0KYGBgDQoNCj4gRGVmYXVsdCBwbG90IG9mIG9iamVjdHMgaW4gRmFjdG9NaW5lUg0KDQpgYGB7cn0NCiMgcGxvdCBvZiBzY29yZXMNCnBsb3QoY2Fyc19wY2EsIGNob2l4ID0gImluZCIpDQpgYGANCg0KPiBBbHRlcm5hdGl2ZSBwbG90IG9mIG9iamVjdHMgd2l0aCBnZ3Bsb3QyDQoNCmBgYHtyLCBtZXNzYWdlPUZ9DQojIGxvYWQgZ2dwbG90Mg0KbGlicmFyeShnZ3Bsb3QyKQ0KIyBkYXRhIGZyYW1lIHdpdGggb2JzZXJ2YXRpb25zIGZyb20gUENBIHJlc3VsdHMNCmNhcnNfcGNhX29icyA9IGRhdGEuZnJhbWUoY2Fyc19wY2EkaW5kJGNvb3JkWywxOjNdKQ0KIyBQQ0EgcGxvdHMgb2Ygb2JzZXJ2YXRpb25zDQpnZ3Bsb3QoY2Fyc19wY2Ffb2JzLCBhZXMoeCA9IERpbS4xLCB5ID0gRGltLjIsIGxhYmVsID0gcm93bmFtZXMoY2FyczIwMDQpKSkgKw0KZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gMCwgY29sb3IgPSAiZ3JheTcwIikgKw0KZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgY29sb3IgPSAiZ3JheTcwIikgKw0KZ2VvbV9wb2ludChjb2xvciA9ICIjNTU1NTU1NDQiLCBzaXplID0gNSkgKw0KZ2VvbV90ZXh0KGFscGhhID0gMC41NSwgc2l6ZSA9IDQpICsNCnhsYWIoIlBDMSIpICsNCnlsYWIoIlBDMiIpICsNCnhsaW0oLTUsIDYpICsNCmdndGl0bGUoIlBDQSBwbG90IG9mIG9ic2VydmF0aW9ucyIpDQpgYGANCg0KPiBDb250cmlidXRpb25zIG9mIG9iamVjdHMgdG8gUENzDQoNCj4gVGhlIGNvbnRyaWJ1dGlvbnMgKGluIHBlcmNlbnRhZ2UpIHJlZmxlY3QgdGhlIGluZmx1ZW5jZSB0aGF0IGVhY2ggb2JqZWN0IGhhcyBvbiB0aGUgZm9ybWF0aW9uIG9mIHRoZQ0KUENzLiBJZiBhbGwgb2JqZWN0cyBoYWQgdGhlIHNhbWUgY29udHJpYnV0aW9uIG9uIGVhY2ggUEMsIHRoZXkgd291bGQgY29udHJpYnV0ZSB3aXRoIGEgdmFsdWUgb2YgNC4xNiA9IDEwMC8yNA0KDQpgYGB7cn0NCiMgQ29udHJpYnV0aW9ucyBvbiBQQ3MgKGZpcnN0IDIgZGltZXNpb25zKQ0KcHJpbnQocm91bmQoY2Fyc19wY2EkaW5kJGNvbnRyaWJbLDE6Ml0sIDMpLA0KcHJpbnQuZ2FwID0gMykNCmBgYA0KDQo+IEJhcnBsb3RzIG9mIG9iamVjdCBjb250cmlidXRpb25zIHRvIFBDcw0KDQpgYGB7ciwgbWVzc2FnZT1GfQ0Kb3AgPSBwYXIobWZyb3cgPSBjKDIsMSkpDQojIGJhcnBsb3Qgb2Ygb2JqZWN0IGNvbnRyaWJ1dGlvbnMgZm9yIFBDMQ0KYmFycGxvdChjYXJzX3BjYSRpbmQkY29udHJpYlssMV0sIGJvcmRlciA9IE5BLCBsYXMgPSAyLA0KbmFtZXMuYXJnID0gYWJicmV2aWF0ZShyb3duYW1lcyhjYXJzMjAwNCksIDgpLCBjZXgubmFtZXMgPSAwLjgpDQp0aXRsZSgiT2JqZWN0IENvbnRyaWJ1dGlvbnMgb24gUEMxIiwgY2V4Lm1haW4gPSAwLjkpDQphYmxpbmUoaCA9IDQuMTYsIGNvbCA9ICJncmF5NTAiKQ0KIyBiYXJwbG90IG9mIG9iamVjdCBjb250cmlidXRpb25zIGZvciBQQzINCmJhcnBsb3QoY2Fyc19wY2EkaW5kJGNvbnRyaWJbLDJdLCBib3JkZXIgPSBOQSwgbGFzID0gMiwNCm5hbWVzLmFyZyA9IGFiYnJldmlhdGUocm93bmFtZXMoY2FyczIwMDQpLCA4KSwgY2V4Lm5hbWVzID0gMC44KQ0KdGl0bGUoIk9iamVjdCBDb250cmlidXRpb25zIG9uIFBDMiIsIGNleC5tYWluID0gMC45KQ0KYWJsaW5lKGggPSA0LjE2LCBjb2wgPSAiZ3JheTUwIikNCnBhcihvcCkNCmBgYA0KDQoNCj4gUENBIHdpdGggQ2x1c3RlcmluZw0KDQo+IFdlIGNhbiBnYWluIHNvbWUgaW5zaWdodCBieSBjb21iaW5pbmcgUENBIGFuZCBDbHVzdGVyaW5nDQoNCjEuIElzIHRoZXJlIGEgdHlwb2xvZ3kgb2Ygb2JqZWN0cz8NCjIuIEhvdyBjb3VsZCB0aGV5IGJlIGNsdXN0ZXJlZD8NCg0KPiBPbmUgb3B0aW9uIGlzIHRvIGFwcGx5IGEgaGllcmFyY2hpY2FsIGNsdXN0ZXJpbmcgdG8gdGhlIG9idGFpbmVkIHNjb3JlcywgYW5kIHRoZW4gYWRkIHRoZSBjbHVzdGVyZWQgZ3JvdXBzIHRvIHRoZSBTY29yZXMgc2NhdHRlcnBsb3QNCg0KPiBIaWVyYXJjaGljYWwgQ2x1c3RlcmluZw0KDQoNCmBgYHtyLCBmaWcuaGVpZ2h0PTYsIGZpZy53aWR0aD02fQ0KIyBjbHVzdGVyaW5nDQpjYXJzX2NsdXN0ZXJpbmcgPSBoY2x1c3QoZGlzdChjYXJzX3BjYSRpbmQkY29vcmQpLCBtZXRob2QgPSAid2FyZC5EIikNCnBsb3QoY2Fyc19jbHVzdGVyaW5nLCB4bGFiID0gIiIsIHN1YiA9ICIiKQ0KYGBgDQoNCj4gUEMgcGxvdCB3aXRoIGNsdXN0ZXJpbmcgcGFydGl0aW9uDQoNCmBgYHtyLCBmaWcuaGVpZ2h0PTcsIGZpZy53aWR0aD05fQ0KIyBnZXQgMyBjbHVzdGVyDQpjYXJzX2NsdXN0ZXJzID0gY3V0cmVlKGNhcnNfY2x1c3RlcmluZywgayA9IDMpDQojIGFkZCBjbHVzdGVyIHRvIGRhdGEgZnJhbWUgb2Ygc2NvcmVzDQpjYXJzX3BjYV9vYnMkY2x1c3RlciA9IGFzLmZhY3RvcihjYXJzX2NsdXN0ZXJzKQ0KIyBnZ3Bsb3QNCmdncGxvdChjYXJzX3BjYV9vYnMsIGFlcyh4PURpbS4xLCB5PURpbS4yLCBsYWJlbD1yb3duYW1lcyhjYXJzMjAwNCkpKSArDQpnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBjb2xvciA9ICJncmF5NzAiKSArDQpnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBjb2xvciA9ICJncmF5NzAiKSArDQpnZW9tX3BvaW50KGFlcyhjb2xvciA9IGNsdXN0ZXIpLCBhbHBoYSA9IDAuNTUsIHNpemUgPSAzKSArDQpnZW9tX3RleHQoYWVzKGNvbG9yID0gY2x1c3RlciksIGFscGhhID0gMC41NSwgc2l6ZSA9IDQpICsNCnhsYWIoIlBDMSIpICsNCnlsYWIoIlBDMiIpICsNCnhsaW0oLTUsIDYpICsNCmdndGl0bGUoIlBDQSBwbG90IG9mIG9ic2VydmF0aW9ucyIpDQpgYGANCg0KDQpgYGB7ciwgZmlnLmhlaWdodD03LCBmaWcud2lkdGg9OX0NCmxpYnJhcnkoZ2dyZXBlbCkNCiMgdmFtb3MgYXJydW1hciBvIGdyw6FmaWNvIGFudGVyaW9yLg0KIyBnZW9tX3RleHRfcmVwZWwNCg0KIyBnZXQgMyBjbHVzdGVyDQpjYXJzX2NsdXN0ZXJzID0gY3V0cmVlKGNhcnNfY2x1c3RlcmluZywgayA9IDMpDQojIGFkZCBjbHVzdGVyIHRvIGRhdGEgZnJhbWUgb2Ygc2NvcmVzDQpjYXJzX3BjYV9vYnMkY2x1c3RlciA9IGFzLmZhY3RvcihjYXJzX2NsdXN0ZXJzKQ0KIyBnZ3Bsb3QNCmdncGxvdChjYXJzX3BjYV9vYnMsIGFlcyh4PURpbS4xLCB5PURpbS4yLCBsYWJlbD1yb3duYW1lcyhjYXJzMjAwNCkpKSArDQpnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBjb2xvciA9ICJncmF5NzAiKSArDQpnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBjb2xvciA9ICJncmF5NzAiKSArDQpnZW9tX3BvaW50KGFlcyhjb2xvciA9IGNsdXN0ZXIpLCBhbHBoYSA9IDAuNTUsIHNpemUgPSAzKSArDQpnZW9tX3RleHRfcmVwZWwoYWVzKGNvbG9yID0gY2x1c3RlciksIGFscGhhID0gMC41NSwgc2l6ZSA9IDQpICsNCnhsYWIoIlBDMSIpICsNCnlsYWIoIlBDMiIpICsNCnhsaW0oLTUsIDYpICsNCmdndGl0bGUoIlBDQSBwbG90IG9mIG9ic2VydmF0aW9ucyIpDQoNCmBgYA0KDQoNCg0K