Plotting in R using Lattice

Library

Install the package -

install.packages("lattice")

Load the package -

library(lattice)

Histogram

Let’s use the USCancerRates dataset from latticeExtra package -

data(USCancerRates, package = "latticeExtra")
str(USCancerRates)

'data.frame':   3041 obs. of  8 variables:
 $ rate.male   : num  364 346 341 336 330 ...
 $ LCL95.male  : num  311 274 304 289 293 ...
 $ UCL95.male  : num  423 431 381 389 371 ...
 $ rate.female : num  151 140 182 185 172 ...
 $ LCL95.female: num  124 103 161 157 151 ...
 $ UCL95.female: num  184 190 206 218 195 ...
 $ state       : Factor w/ 49 levels "Alabama","Alaska",..: 1 1 1 1 1 1 1 1 1 1 ...
 $ county      : 'AsIs' chr  "Pickens County" "Bullock County" "Russell County" "Barbour County" ...

Make a simple histogram -

histogram(x = ~ rate.male, data = USCancerRates)

Here, Y-axis by default shows relative bin frequency.

Using base R-

hist(USCancerRates$rate.male)

In the two outputs the following things are different -

Visual appearance (colors, etc.) is different
The y-axes represent different quantities
Bin boundaries are different

Adding title and axis labels -

histogram(x = ~ rate.male, data = USCancerRates,
          main = "Country wise deaths due to cancer (1999-2003)",
          xlab = "Rate among males (per 100,000)")

Specifying number of intervals -

histogram(x = ~ rate.male, data = USCancerRates,
          nint = 30)

In the case of histogram(), the optional argument type controls what is plotted on the y-axis. It can take three values:

“percent”, the default, gives percentage or relative frequency.(default)
“count” gives bin count, which is the default in hist().
“density” gives a density histogram.

histogram(x = ~ rate.male, data = USCancerRates,
          nint = 30, type = "density")

histogram(x = ~ rate.male, data = USCancerRates,
          nint = 30, type = "count")

Scatterplot

Make a simple scatterplot -

xyplot(rate.female ~ rate.male, data = USCancerRates)

To add axis labels -

xyplot(rate.female ~ rate.male, data = USCancerRates,
       xlab = "Rate among males (per 100,000)",
       ylab = "Rate among females (per 100,000)")

Adding grid and abline -

xyplot(rate.female ~ rate.male, data = USCancerRates,
       abline = c(0,1), grid = TRUE)

Adding linear regression line -

xyplot(rate.female ~ rate.male, data = USCancerRates,
       panel = function(x, y) {
         panel.xyplot(x, y)
         panel.abline(lm(y ~ x))
       })

Customizing legend -

xyplot(Ozone ~ Temp, data = airquality, groups = Month,
       # Complete the legend spec 
       auto.key = list(space = "right", 
                       title = "Month", 
                       text = month.name[5:9]))

Conditioned scatterplot -

# Create 'state.ordered' by reordering levels
library(dplyr)
USCancerRates <- 
  mutate(USCancerRates, 
         state.ordered = reorder(state, 
                                    rate.male + rate.female, 
                                    mean, na.rm = TRUE))

# Create conditioned scatter plot
xyplot(rate.female ~ rate.male | state.ordered,
       data = USCancerRates, 
       grid = TRUE, 
       panel = function(x, y) {
         panel.xyplot(x, y)
         panel.abline(lm(y ~ x))
       })

In a conditioned lattice plot, the panels are by default drawn starting from the bottom-left position, going right and then up. This is patterned on the Cartesian coordinate system where the x-axis increases to the right and the y-axis increases from bottom to top.

Often we want to change this so that the layout is similar to a matrix or table, where rows start at the top. The layout of any conditioned lattice plot can be changed to follow this scheme by adding the optional argument as.table = TRUE.

xyplot(rate.female ~ rate.male | state.ordered,
       data = USCancerRates, 
       grid = TRUE, 
       panel = function(x, y) {
         panel.xyplot(x, y)
         panel.abline(lm(y ~ x))
       },
       as.table = TRUE)

Density plot

Use the ‘airquality’ dataset

data(airquality)
str(airquality)

'data.frame':   153 obs. of  6 variables:
 $ Ozone  : int  41 36 12 18 NA 28 23 19 8 NA ...
 $ Solar.R: int  190 118 149 313 NA NA 299 99 19 194 ...
 $ Wind   : num  7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
 $ Temp   : int  67 72 74 62 56 66 65 59 61 69 ...
 $ Month  : int  5 5 5 5 5 5 5 5 5 5 ...
 $ Day    : int  1 2 3 4 5 6 7 8 9 10 ...

Create a density plot -

densityplot(~ Ozone, data = airquality)

A useful optional argument for densityplot() is plot.points, which can take values -

TRUE, the default, to plot the data points along the x-axis in addition to the density;
FALSE to suppress plotting the data points, and
“jitter”, to plot the points along the y-axis but with some random jittering in the y-direction so that overlapping points are easier to see.

densityplot(~ Ozone, data = airquality,
    plot.points = TRUE)

densityplot(~ Ozone, data = airquality,
    plot.points = FALSE)

Box and Whisker Plot

Creating a box and whisker plot -

bwplot(x = ~ rate.male, data = USCancerRates)

Creating box and whisker plots by some factor -

bwplot(state ~ rate.male, data = USCancerRates)

Reordering the states by their median rate -

bymedian <- with(USCancerRates, reorder(state, rate.male, median, na.rm = T))
bwplot(bymedian ~ rate.male, data = USCancerRates)

Changing labels -

# Create box-and-whisker plot
bwplot(state.ordered ~ rate.female + rate.male,
       data = USCancerRates, 
       outer = TRUE, 
       xlab = "Rate (per 100,000)", 
       # Add strip labels
       strip = strip.custom(factor.levels = c("Male", "Female")))

Using the plot as an object -

pl <- bwplot(state.ordered ~ rate.female + rate.male,
       data = USCancerRates, 
       outer = TRUE, 
       xlab = "Rate (per 100,000)")
pl

class(pl)

[1] "trellis"

summary(pl)


Call:
bwplot(state.ordered ~ rate.female + rate.male, data = USCancerRates, 
    outer = TRUE, xlab = "Rate (per 100,000)")

Number of observations:
rate.female   rate.male 
       3041        3041

dimnames(pl)

[[1]]
[1] "rate.female" "rate.male"

Updating trellis object -

update(pl, strip = strip.custom(factor.levels = c("Men","Women")))

Another way to change the labels -

dimnames(pl)[[1]] <- c("Male", "Female")

Subset the trellis object like matrix -

pl[1,]  # only males

Conditioning/Facetting

Conditioning scatterplot on Species -

str(iris)

'data.frame':   150 obs. of  5 variables:
 $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
 $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
 $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
 $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
 $ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...

xyplot(Sepal.Width ~ Sepal.Length | Species,   # facet by Species
       iris, grid = TRUE)

Conditioning histogram of weight on group -

str(PlantGrowth)

'data.frame':   30 obs. of  2 variables:
 $ weight: num  4.17 5.58 5.18 6.11 4.5 4.61 5.17 4.53 5.33 5.14 ...
 $ group : Factor w/ 3 levels "ctrl","trt1",..: 1 1 1 1 1 1 1 1 1 1 ...

densityplot( ~ weight | group, PlantGrowth)

Conditioning two different variables in one plot -

histogram( ~ rate.male + rate.female, USCancerRates,
           outer = TRUE)

Notice that rate.male and rate.female are two different variables in the dataset, which means that USCancerRates is not a tidy data frame. lattice, unlike ggplot2, allows you to have data in a wide format.

densityplot(~ rate.male + rate.female,
    data = USCancerRates, 
    plot.points = FALSE,    # Suppress data points
    )

With outer=TRUE -

densityplot(~ rate.male + rate.female,
    data = USCancerRates, 
    outer = TRUE,
    plot.points = FALSE,    # Suppress data points
    )

Changing layout -

densityplot( ~ rate.male + rate.female, USCancerRates,
             outer = TRUE, layout = c(1,2) # 1 column, 2 rows
           )

Doing some data manipulation to get summary statistics -

USCancerRates.state <- with(USCancerRates, {    
  rmale <- tapply(rate.male, state, median, na.rm= TRUE)    
  rfemale <- tapply(rate.female, state, median, na.rm= TRUE)  
  data.frame(
    Rate = c(rmale, rfemale),
    State = rep(names(rmale), 2),
    Gender = rep(c("Male", "Female"), each = length(rmale))
    )
  })
USCancerRates.state <- dplyr::mutate(USCancerRates.state,
                                     State = reorder(State, Rate))
head(USCancerRates.state, 10)

     Rate       State Gender
1  286.00     Alabama   Male
2  237.95      Alaska   Male
3  209.30     Arizona   Male
4  284.10    Arkansas   Male
5  221.30  California   Male
6  204.40    Colorado   Male
7  228.55 Connecticut   Male
8  268.25    Delaware   Male
9  250.20     Florida   Male
10 280.80     Georgia   Male

Conditioning by gender -

xyplot(State ~ Rate | Gender, USCancerRates.state, grid = TRUE)

Grouping by gender -

xyplot(State ~ Rate, groups = Gender, data = USCancerRates.state, grid = TRUE)

To add legend -

xyplot(State ~ Rate, groups = Gender, data = USCancerRates.state, 
       grid = TRUE,
       auto.key = TRUE)

Positioning and formatting the legend -

xyplot(State ~ Rate, groups = Gender, data = USCancerRates.state, 
       grid = TRUE,
       auto.key=list(space="bottom", columns = 2,
                     title=NULL, cex.title = 1))

# USCancerRates has been pre-loaded
str(USCancerRates)

'data.frame':   3041 obs. of  9 variables:
 $ rate.male    : num  364 346 341 336 330 ...
 $ LCL95.male   : num  311 274 304 289 293 ...
 $ UCL95.male   : num  423 431 381 389 371 ...
 $ rate.female  : num  151 140 182 185 172 ...
 $ LCL95.female : num  124 103 161 157 151 ...
 $ UCL95.female : num  184 190 206 218 195 ...
 $ state        : Factor w/ 49 levels "Alabama","Alaska",..: 1 1 1 1 1 1 1 1 1 1 ...
 $ county       : 'AsIs' chr  "Pickens County" "Bullock County" "Russell County" "Barbour County" ...
 $ state.ordered: Factor w/ 49 levels "Utah","Colorado",..: 40 40 40 40 40 40 40 40 40 40 ...
  ..- attr(*, "scores")= num [1:49(1d)] 450 428 351 457 383 ...
  .. ..- attr(*, "dimnames")=List of 1
  .. .. ..$ : chr [1:49] "Alabama" "Alaska" "Arizona" "Arkansas" ...

# Create a density plot
densityplot(~ rate.male + rate.female,
    data = USCancerRates,
    # Set value of 'outer' 
    outer = FALSE,
    # Add x-axis label
    xlab = "Rate (per 100,000)",
    # Add a legend
    auto.key = TRUE,
    plot.points = FALSE,
    ref = TRUE)

LS0tDQp0aXRsZTogIlBsb3R0aW5nIGluIFIgdXNpbmcgTGF0dGljZSINCmF1dGhvcjogJ01ELiBBSFNBTlVMIElTTEFNJw0KZGF0ZTogIkxhc3QgdXBkYXRlZCBvbiBgciBmb3JtYXQoU3lzLkRhdGUoKSwgJyVkICVCLCAlWScpYCINCm91dHB1dDoNCiAgcm1kZm9ybWF0czo6cm9ib2Jvb2s6DQogICAgc2VsZl9jb250YWluZWQ6IHRydWUNCiAgICB0aHVtYm5haWxzOiBmYWxzZQ0KICAgIGxpZ2h0Ym94OiB0cnVlDQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KcGtnZG93bjoNCiAgYXNfaXM6IHRydWUNCi0tLQ0KDQpgYGB7Y3NzLCBlY2hvPUZBTFNFfQ0KYm9keXsNCiAgZm9udC1mYW1pbHk6ICJBcmlhbCI7DQogIGZvbnQtc2l6ZTogMTBwdDsNCn0NCmBgYA0KDQpgYGB7ciwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldCgNCiAgY29tbWVudCA9ICIiLCBwcm9tcHQgPSBGLCBtZXNzYWdlID0gRiwgd2FybmluZyA9IEYNCikNCg0KYGBgDQoNCg0KLS0tDQoNCiMgTGlicmFyeQ0KDQpJbnN0YWxsIHRoZSBwYWNrYWdlIC0NCmBgYHtyLCBldmFsID0gRkFMU0V9DQppbnN0YWxsLnBhY2thZ2VzKCJsYXR0aWNlIikNCmBgYA0KDQpMb2FkIHRoZSBwYWNrYWdlIC0gDQpgYGB7cn0NCmxpYnJhcnkobGF0dGljZSkNCmBgYA0KDQojIEhpc3RvZ3JhbQ0KDQpMZXQncyB1c2UgdGhlIFVTQ2FuY2VyUmF0ZXMgZGF0YXNldCBmcm9tIGxhdHRpY2VFeHRyYSBwYWNrYWdlIC0gDQpgYGB7cn0NCmRhdGEoVVNDYW5jZXJSYXRlcywgcGFja2FnZSA9ICJsYXR0aWNlRXh0cmEiKQ0Kc3RyKFVTQ2FuY2VyUmF0ZXMpDQpgYGANCg0KTWFrZSBhIHNpbXBsZSBoaXN0b2dyYW0gLSANCmBgYHtyfQ0KaGlzdG9ncmFtKHggPSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMpDQpgYGANCkhlcmUsIFktYXhpcyBieSBkZWZhdWx0IHNob3dzIHJlbGF0aXZlIGJpbiBmcmVxdWVuY3kuDQoNClVzaW5nIGJhc2UgUi0NCmBgYHtyfQ0KaGlzdChVU0NhbmNlclJhdGVzJHJhdGUubWFsZSkNCmBgYA0KDQpJbiB0aGUgdHdvIG91dHB1dHMgdGhlIGZvbGxvd2luZyB0aGluZ3MgYXJlIGRpZmZlcmVudCAtICAgIA0KDQoxLiBWaXN1YWwgYXBwZWFyYW5jZSAoY29sb3JzLCBldGMuKSBpcyBkaWZmZXJlbnQgICANCjIuIFRoZSB5LWF4ZXMgcmVwcmVzZW50IGRpZmZlcmVudCBxdWFudGl0aWVzICAgDQozLiBCaW4gYm91bmRhcmllcyBhcmUgZGlmZmVyZW50ICAgDQoNCkFkZGluZyB0aXRsZSBhbmQgYXhpcyBsYWJlbHMgLSANCmBgYHtyfQ0KaGlzdG9ncmFtKHggPSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMsDQogICAgICAgICAgbWFpbiA9ICJDb3VudHJ5IHdpc2UgZGVhdGhzIGR1ZSB0byBjYW5jZXIgKDE5OTktMjAwMykiLA0KICAgICAgICAgIHhsYWIgPSAiUmF0ZSBhbW9uZyBtYWxlcyAocGVyIDEwMCwwMDApIikNCmBgYA0KDQpTcGVjaWZ5aW5nIG51bWJlciBvZiBpbnRlcnZhbHMgLSANCmBgYHtyfQ0KaGlzdG9ncmFtKHggPSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMsDQogICAgICAgICAgbmludCA9IDMwKQ0KYGBgDQoNCkluIHRoZSBjYXNlIG9mIGhpc3RvZ3JhbSgpLCB0aGUgb3B0aW9uYWwgYXJndW1lbnQgdHlwZSBjb250cm9scyB3aGF0IGlzIHBsb3R0ZWQgb24gdGhlIHktYXhpcy4gSXQgY2FuIHRha2UgdGhyZWUgdmFsdWVzOiAgIA0KDQoxLiAicGVyY2VudCIsIHRoZSBkZWZhdWx0LCBnaXZlcyBwZXJjZW50YWdlIG9yIHJlbGF0aXZlIGZyZXF1ZW5jeS4oZGVmYXVsdCkgICANCjIuICJjb3VudCIgZ2l2ZXMgYmluIGNvdW50LCB3aGljaCBpcyB0aGUgZGVmYXVsdCBpbiBoaXN0KCkuICAgDQozLiAiZGVuc2l0eSIgZ2l2ZXMgYSBkZW5zaXR5IGhpc3RvZ3JhbS4gICANCg0KYGBge3J9DQpoaXN0b2dyYW0oeCA9IH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcywNCiAgICAgICAgICBuaW50ID0gMzAsIHR5cGUgPSAiZGVuc2l0eSIpDQpoaXN0b2dyYW0oeCA9IH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcywNCiAgICAgICAgICBuaW50ID0gMzAsIHR5cGUgPSAiY291bnQiKQ0KYGBgDQoNCg0KIyBTY2F0dGVycGxvdA0KDQpNYWtlIGEgc2ltcGxlIHNjYXR0ZXJwbG90IC0gDQpgYGB7cn0NCnh5cGxvdChyYXRlLmZlbWFsZSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMpDQpgYGANCg0KVG8gYWRkIGF4aXMgbGFiZWxzIC0gDQpgYGB7cn0NCnh5cGxvdChyYXRlLmZlbWFsZSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMsDQogICAgICAgeGxhYiA9ICJSYXRlIGFtb25nIG1hbGVzIChwZXIgMTAwLDAwMCkiLA0KICAgICAgIHlsYWIgPSAiUmF0ZSBhbW9uZyBmZW1hbGVzIChwZXIgMTAwLDAwMCkiKQ0KYGBgDQoNCkFkZGluZyBncmlkIGFuZCBhYmxpbmUgLSANCmBgYHtyfQ0KeHlwbG90KHJhdGUuZmVtYWxlIH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcywNCiAgICAgICBhYmxpbmUgPSBjKDAsMSksIGdyaWQgPSBUUlVFKQ0KYGBgDQoNCg0KQWRkaW5nIGxpbmVhciByZWdyZXNzaW9uIGxpbmUgLSANCmBgYHtyfQ0KeHlwbG90KHJhdGUuZmVtYWxlIH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcywNCiAgICAgICBwYW5lbCA9IGZ1bmN0aW9uKHgsIHkpIHsNCiAgICAgICAgIHBhbmVsLnh5cGxvdCh4LCB5KQ0KICAgICAgICAgcGFuZWwuYWJsaW5lKGxtKHkgfiB4KSkNCiAgICAgICB9KQ0KYGBgDQoNCkN1c3RvbWl6aW5nIGxlZ2VuZCAtIA0KYGBge3J9DQp4eXBsb3QoT3pvbmUgfiBUZW1wLCBkYXRhID0gYWlycXVhbGl0eSwgZ3JvdXBzID0gTW9udGgsDQogICAgICAgIyBDb21wbGV0ZSB0aGUgbGVnZW5kIHNwZWMgDQogICAgICAgYXV0by5rZXkgPSBsaXN0KHNwYWNlID0gInJpZ2h0IiwgDQogICAgICAgICAgICAgICAgICAgICAgIHRpdGxlID0gIk1vbnRoIiwgDQogICAgICAgICAgICAgICAgICAgICAgIHRleHQgPSBtb250aC5uYW1lWzU6OV0pKQ0KYGBgDQoNCkNvbmRpdGlvbmVkIHNjYXR0ZXJwbG90IC0gDQpgYGB7cn0NCiMgQ3JlYXRlICdzdGF0ZS5vcmRlcmVkJyBieSByZW9yZGVyaW5nIGxldmVscw0KbGlicmFyeShkcGx5cikNClVTQ2FuY2VyUmF0ZXMgPC0gDQogIG11dGF0ZShVU0NhbmNlclJhdGVzLCANCiAgICAgICAgIHN0YXRlLm9yZGVyZWQgPSByZW9yZGVyKHN0YXRlLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHJhdGUubWFsZSArIHJhdGUuZmVtYWxlLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1lYW4sIG5hLnJtID0gVFJVRSkpDQoNCiMgQ3JlYXRlIGNvbmRpdGlvbmVkIHNjYXR0ZXIgcGxvdA0KeHlwbG90KHJhdGUuZmVtYWxlIH4gcmF0ZS5tYWxlIHwgc3RhdGUub3JkZXJlZCwNCiAgICAgICBkYXRhID0gVVNDYW5jZXJSYXRlcywgDQogICAgICAgZ3JpZCA9IFRSVUUsIA0KICAgICAgIHBhbmVsID0gZnVuY3Rpb24oeCwgeSkgew0KICAgICAgICAgcGFuZWwueHlwbG90KHgsIHkpDQogICAgICAgICBwYW5lbC5hYmxpbmUobG0oeSB+IHgpKQ0KICAgICAgIH0pDQpgYGANCg0KSW4gYSBjb25kaXRpb25lZCBsYXR0aWNlIHBsb3QsIHRoZSBwYW5lbHMgYXJlIGJ5IGRlZmF1bHQgZHJhd24gc3RhcnRpbmcgZnJvbSB0aGUgYm90dG9tLWxlZnQgcG9zaXRpb24sIGdvaW5nIHJpZ2h0IGFuZCB0aGVuIHVwLiBUaGlzIGlzIHBhdHRlcm5lZCBvbiB0aGUgQ2FydGVzaWFuIGNvb3JkaW5hdGUgc3lzdGVtIHdoZXJlIHRoZSB4LWF4aXMgaW5jcmVhc2VzIHRvIHRoZSByaWdodCBhbmQgdGhlIHktYXhpcyBpbmNyZWFzZXMgZnJvbSBib3R0b20gdG8gdG9wLg0KDQpPZnRlbiB3ZSB3YW50IHRvIGNoYW5nZSB0aGlzIHNvIHRoYXQgdGhlIGxheW91dCBpcyBzaW1pbGFyIHRvIGEgbWF0cml4IG9yIHRhYmxlLCB3aGVyZSByb3dzIHN0YXJ0IGF0IHRoZSB0b3AuIFRoZSBsYXlvdXQgb2YgYW55IGNvbmRpdGlvbmVkIGxhdHRpY2UgcGxvdCBjYW4gYmUgY2hhbmdlZCB0byBmb2xsb3cgdGhpcyBzY2hlbWUgYnkgYWRkaW5nIHRoZSBvcHRpb25hbCBhcmd1bWVudCBgYXMudGFibGUgPSBUUlVFYC4NCg0KYGBge3J9DQp4eXBsb3QocmF0ZS5mZW1hbGUgfiByYXRlLm1hbGUgfCBzdGF0ZS5vcmRlcmVkLA0KICAgICAgIGRhdGEgPSBVU0NhbmNlclJhdGVzLCANCiAgICAgICBncmlkID0gVFJVRSwgDQogICAgICAgcGFuZWwgPSBmdW5jdGlvbih4LCB5KSB7DQogICAgICAgICBwYW5lbC54eXBsb3QoeCwgeSkNCiAgICAgICAgIHBhbmVsLmFibGluZShsbSh5IH4geCkpDQogICAgICAgfSwNCiAgICAgICBhcy50YWJsZSA9IFRSVUUpDQpgYGANCg0KDQojIERlbnNpdHkgcGxvdA0KDQpVc2UgdGhlICdhaXJxdWFsaXR5JyBkYXRhc2V0DQpgYGB7cn0NCmRhdGEoYWlycXVhbGl0eSkNCnN0cihhaXJxdWFsaXR5KQ0KYGBgDQoNCkNyZWF0ZSBhIGRlbnNpdHkgcGxvdCAtDQpgYGB7cn0NCmRlbnNpdHlwbG90KH4gT3pvbmUsIGRhdGEgPSBhaXJxdWFsaXR5KQ0KYGBgDQoNCkEgdXNlZnVsIG9wdGlvbmFsIGFyZ3VtZW50IGZvciBkZW5zaXR5cGxvdCgpIGlzIHBsb3QucG9pbnRzLCB3aGljaCBjYW4gdGFrZSB2YWx1ZXMgLSAgIA0KDQoxLiBUUlVFLCB0aGUgZGVmYXVsdCwgdG8gcGxvdCB0aGUgZGF0YSBwb2ludHMgYWxvbmcgdGhlIHgtYXhpcyBpbiBhZGRpdGlvbiB0byB0aGUgZGVuc2l0eTsgICANCjIuIEZBTFNFIHRvIHN1cHByZXNzIHBsb3R0aW5nIHRoZSBkYXRhIHBvaW50cywgYW5kICAgDQozLiAiaml0dGVyIiwgdG8gcGxvdCB0aGUgcG9pbnRzIGFsb25nIHRoZSB5LWF4aXMgYnV0IHdpdGggc29tZSByYW5kb20gaml0dGVyaW5nIGluIHRoZSB5LWRpcmVjdGlvbiBzbyB0aGF0IG92ZXJsYXBwaW5nIHBvaW50cyBhcmUgZWFzaWVyIHRvIHNlZS4NCg0KYGBge3J9DQpkZW5zaXR5cGxvdCh+IE96b25lLCBkYXRhID0gYWlycXVhbGl0eSwNCiAgICBwbG90LnBvaW50cyA9IFRSVUUpDQpkZW5zaXR5cGxvdCh+IE96b25lLCBkYXRhID0gYWlycXVhbGl0eSwNCiAgICBwbG90LnBvaW50cyA9IEZBTFNFKQ0KYGBgDQoNCiMgQm94IGFuZCBXaGlza2VyIFBsb3QNCg0KQ3JlYXRpbmcgYSBib3ggYW5kIHdoaXNrZXIgcGxvdCAtIA0KYGBge3J9DQpid3Bsb3QoeCA9IH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcykNCmBgYA0KDQpDcmVhdGluZyBib3ggYW5kIHdoaXNrZXIgcGxvdHMgYnkgc29tZSBmYWN0b3IgLSANCmBgYHtyLCBmaWcuaGVpZ2h0ID0gOX0NCmJ3cGxvdChzdGF0ZSB+IHJhdGUubWFsZSwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMpDQpgYGANCg0KUmVvcmRlcmluZyB0aGUgc3RhdGVzIGJ5IHRoZWlyIG1lZGlhbiByYXRlIC0gDQpgYGB7ciwgZmlnLmhlaWdodCA9IDl9DQpieW1lZGlhbiA8LSB3aXRoKFVTQ2FuY2VyUmF0ZXMsIHJlb3JkZXIoc3RhdGUsIHJhdGUubWFsZSwgbWVkaWFuLCBuYS5ybSA9IFQpKQ0KYndwbG90KGJ5bWVkaWFuIH4gcmF0ZS5tYWxlLCBkYXRhID0gVVNDYW5jZXJSYXRlcykNCmBgYA0KDQpDaGFuZ2luZyBsYWJlbHMgLQ0KYGBge3J9DQojIENyZWF0ZSBib3gtYW5kLXdoaXNrZXIgcGxvdA0KYndwbG90KHN0YXRlLm9yZGVyZWQgfiByYXRlLmZlbWFsZSArIHJhdGUubWFsZSwNCiAgICAgICBkYXRhID0gVVNDYW5jZXJSYXRlcywgDQogICAgICAgb3V0ZXIgPSBUUlVFLCANCiAgICAgICB4bGFiID0gIlJhdGUgKHBlciAxMDAsMDAwKSIsIA0KICAgICAgICMgQWRkIHN0cmlwIGxhYmVscw0KICAgICAgIHN0cmlwID0gc3RyaXAuY3VzdG9tKGZhY3Rvci5sZXZlbHMgPSBjKCJNYWxlIiwgIkZlbWFsZSIpKSkNCmBgYA0KDQpVc2luZyB0aGUgcGxvdCBhcyBhbiBvYmplY3QgLSANCmBgYHtyfQ0KcGwgPC0gYndwbG90KHN0YXRlLm9yZGVyZWQgfiByYXRlLmZlbWFsZSArIHJhdGUubWFsZSwNCiAgICAgICBkYXRhID0gVVNDYW5jZXJSYXRlcywgDQogICAgICAgb3V0ZXIgPSBUUlVFLCANCiAgICAgICB4bGFiID0gIlJhdGUgKHBlciAxMDAsMDAwKSIpDQpwbA0KY2xhc3MocGwpDQpzdW1tYXJ5KHBsKQ0KZGltbmFtZXMocGwpDQpgYGANCg0KVXBkYXRpbmcgdHJlbGxpcyBvYmplY3QgLSANCmBgYHtyfQ0KdXBkYXRlKHBsLCBzdHJpcCA9IHN0cmlwLmN1c3RvbShmYWN0b3IubGV2ZWxzID0gYygiTWVuIiwiV29tZW4iKSkpDQpgYGANCg0KQW5vdGhlciB3YXkgdG8gY2hhbmdlIHRoZSBsYWJlbHMgLSANCmBgYHtyfQ0KZGltbmFtZXMocGwpW1sxXV0gPC0gYygiTWFsZSIsICJGZW1hbGUiKQ0KYGBgDQoNClN1YnNldCB0aGUgdHJlbGxpcyBvYmplY3QgbGlrZSBtYXRyaXggLSANCmBgYHtyfQ0KcGxbMSxdICAjIG9ubHkgbWFsZXMNCmBgYA0KDQoNCiMgQ29uZGl0aW9uaW5nL0ZhY2V0dGluZw0KDQpDb25kaXRpb25pbmcgc2NhdHRlcnBsb3Qgb24gU3BlY2llcyAtIA0KYGBge3J9DQpzdHIoaXJpcykNCnh5cGxvdChTZXBhbC5XaWR0aCB+IFNlcGFsLkxlbmd0aCB8IFNwZWNpZXMsICAgIyBmYWNldCBieSBTcGVjaWVzDQogICAgICAgaXJpcywgZ3JpZCA9IFRSVUUpDQpgYGANCg0KQ29uZGl0aW9uaW5nIGhpc3RvZ3JhbSBvZiB3ZWlnaHQgb24gZ3JvdXAgLQ0KYGBge3J9DQpzdHIoUGxhbnRHcm93dGgpDQpkZW5zaXR5cGxvdCggfiB3ZWlnaHQgfCBncm91cCwgUGxhbnRHcm93dGgpDQpgYGANCg0KQ29uZGl0aW9uaW5nIHR3byBkaWZmZXJlbnQgdmFyaWFibGVzIGluIG9uZSBwbG90IC0NCmBgYHtyfQ0KaGlzdG9ncmFtKCB+IHJhdGUubWFsZSArIHJhdGUuZmVtYWxlLCBVU0NhbmNlclJhdGVzLA0KICAgICAgICAgICBvdXRlciA9IFRSVUUpDQpgYGANCg0KTm90aWNlIHRoYXQgcmF0ZS5tYWxlIGFuZCByYXRlLmZlbWFsZSBhcmUgdHdvIGRpZmZlcmVudCB2YXJpYWJsZXMgaW4gdGhlIGRhdGFzZXQsIHdoaWNoIG1lYW5zIHRoYXQgVVNDYW5jZXJSYXRlcyBpcyBub3QgYSB0aWR5IGRhdGEgZnJhbWUuIGxhdHRpY2UsIHVubGlrZSBnZ3Bsb3QyLCBhbGxvd3MgeW91IHRvIGhhdmUgZGF0YSBpbiBhIHdpZGUgZm9ybWF0Lg0KYGBge3J9DQpkZW5zaXR5cGxvdCh+IHJhdGUubWFsZSArIHJhdGUuZmVtYWxlLA0KICAgIGRhdGEgPSBVU0NhbmNlclJhdGVzLCANCiAgICBwbG90LnBvaW50cyA9IEZBTFNFLCAgICAjIFN1cHByZXNzIGRhdGEgcG9pbnRzDQogICAgKQ0KYGBgDQoNCldpdGggYG91dGVyPVRSVUVgIC0NCmBgYHtyfQ0KZGVuc2l0eXBsb3QofiByYXRlLm1hbGUgKyByYXRlLmZlbWFsZSwNCiAgICBkYXRhID0gVVNDYW5jZXJSYXRlcywgDQogICAgb3V0ZXIgPSBUUlVFLA0KICAgIHBsb3QucG9pbnRzID0gRkFMU0UsICAgICMgU3VwcHJlc3MgZGF0YSBwb2ludHMNCiAgICApDQpgYGANCg0KQ2hhbmdpbmcgbGF5b3V0IC0gDQpgYGB7cn0NCmRlbnNpdHlwbG90KCB+IHJhdGUubWFsZSArIHJhdGUuZmVtYWxlLCBVU0NhbmNlclJhdGVzLA0KICAgICAgICAgICAgIG91dGVyID0gVFJVRSwgbGF5b3V0ID0gYygxLDIpICMgMSBjb2x1bW4sIDIgcm93cw0KICAgICAgICAgICApDQpgYGANCg0KRG9pbmcgc29tZSBkYXRhIG1hbmlwdWxhdGlvbiB0byBnZXQgc3VtbWFyeSBzdGF0aXN0aWNzIC0gDQpgYGB7cn0NClVTQ2FuY2VyUmF0ZXMuc3RhdGUgPC0gd2l0aChVU0NhbmNlclJhdGVzLCB7ICAgIA0KICBybWFsZSA8LSB0YXBwbHkocmF0ZS5tYWxlLCBzdGF0ZSwgbWVkaWFuLCBuYS5ybT0gVFJVRSkgICAgDQogIHJmZW1hbGUgPC0gdGFwcGx5KHJhdGUuZmVtYWxlLCBzdGF0ZSwgbWVkaWFuLCBuYS5ybT0gVFJVRSkgIA0KICBkYXRhLmZyYW1lKA0KICAgIFJhdGUgPSBjKHJtYWxlLCByZmVtYWxlKSwNCiAgICBTdGF0ZSA9IHJlcChuYW1lcyhybWFsZSksIDIpLA0KICAgIEdlbmRlciA9IHJlcChjKCJNYWxlIiwgIkZlbWFsZSIpLCBlYWNoID0gbGVuZ3RoKHJtYWxlKSkNCiAgICApDQogIH0pDQpVU0NhbmNlclJhdGVzLnN0YXRlIDwtIGRwbHlyOjptdXRhdGUoVVNDYW5jZXJSYXRlcy5zdGF0ZSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBTdGF0ZSA9IHJlb3JkZXIoU3RhdGUsIFJhdGUpKQ0KaGVhZChVU0NhbmNlclJhdGVzLnN0YXRlLCAxMCkNCmBgYA0KDQpDb25kaXRpb25pbmcgYnkgZ2VuZGVyIC0NCmBgYHtyfQ0KeHlwbG90KFN0YXRlIH4gUmF0ZSB8IEdlbmRlciwgVVNDYW5jZXJSYXRlcy5zdGF0ZSwgZ3JpZCA9IFRSVUUpDQpgYGANCg0KR3JvdXBpbmcgYnkgZ2VuZGVyIC0NCmBgYHtyfQ0KeHlwbG90KFN0YXRlIH4gUmF0ZSwgZ3JvdXBzID0gR2VuZGVyLCBkYXRhID0gVVNDYW5jZXJSYXRlcy5zdGF0ZSwgZ3JpZCA9IFRSVUUpDQpgYGANCg0KVG8gYWRkIGxlZ2VuZCAtDQpgYGB7cn0NCnh5cGxvdChTdGF0ZSB+IFJhdGUsIGdyb3VwcyA9IEdlbmRlciwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMuc3RhdGUsIA0KICAgICAgIGdyaWQgPSBUUlVFLA0KICAgICAgIGF1dG8ua2V5ID0gVFJVRSkNCmBgYA0KDQpQb3NpdGlvbmluZyBhbmQgZm9ybWF0dGluZyB0aGUgbGVnZW5kIC0gDQpgYGB7cn0NCnh5cGxvdChTdGF0ZSB+IFJhdGUsIGdyb3VwcyA9IEdlbmRlciwgZGF0YSA9IFVTQ2FuY2VyUmF0ZXMuc3RhdGUsIA0KICAgICAgIGdyaWQgPSBUUlVFLA0KICAgICAgIGF1dG8ua2V5PWxpc3Qoc3BhY2U9ImJvdHRvbSIsIGNvbHVtbnMgPSAyLA0KICAgICAgICAgICAgICAgICAgICAgdGl0bGU9TlVMTCwgY2V4LnRpdGxlID0gMSkpDQpgYGANCg0KYGBge3J9DQojIFVTQ2FuY2VyUmF0ZXMgaGFzIGJlZW4gcHJlLWxvYWRlZA0Kc3RyKFVTQ2FuY2VyUmF0ZXMpDQoNCiMgQ3JlYXRlIGEgZGVuc2l0eSBwbG90DQpkZW5zaXR5cGxvdCh+IHJhdGUubWFsZSArIHJhdGUuZmVtYWxlLA0KICAgIGRhdGEgPSBVU0NhbmNlclJhdGVzLA0KICAgICMgU2V0IHZhbHVlIG9mICdvdXRlcicgDQogICAgb3V0ZXIgPSBGQUxTRSwNCiAgICAjIEFkZCB4LWF4aXMgbGFiZWwNCiAgICB4bGFiID0gIlJhdGUgKHBlciAxMDAsMDAwKSIsDQogICAgIyBBZGQgYSBsZWdlbmQNCiAgICBhdXRvLmtleSA9IFRSVUUsDQogICAgcGxvdC5wb2ludHMgPSBGQUxTRSwNCiAgICByZWYgPSBUUlVFKQ0KYGBgDQoNCg0KDQo=