• Load: Packages and df
  • rrBLUP Function
  • Setting up Five-fold Cross-Validation

Author: Shantel A. Martinez
Purpose: Conduct genomic selection using a one-step approach instead of a two-step approach.
Last updated: 2019.03.24

Load: Packages and df

The dataframes were tidyed up in the D:/.../GS/PHS GS Input Data Prep.R file.
We will start with all of the environments calculated together (no subsetting of env), and the kernel colored subsetted to i) Red, ii) White, and iii) Combined red and white.

## All Env
load("D:/PHS Genomic Selection Project/Data Analysis/GS/PHS GS All Env myYs myGDs.RData")
library(BGLR); library(rrBLUP)
library(tidyverse); font<-element_text(face = "bold",  size = 16); font2<-element_text(size = 16)
setwd("D:/PHS Genomic Selection Project/Data Analysis/GS/20190319")

I need to make lists of each of the KC groups for the genotypic data G, the phenotype df PHS and the names of each group name.

G <- list(myGDc ,myGDr ,myGDw ) 
PHS <- list(PHSComb, PHSred7, PHSwhite)
name <- list("Comb", "Red", "White")

Define the parameters needed to run the model, in this case, rrBLUP.

##Modeling Parameters~~~~~~~~~
h<-0.4 ; folds=5 ; i=2

The bandwidth parameter, h, will not be needed until we run the RKHS models.
I only define i=2 until I get to the point of running 5-fold CV, then i will be defined in a for()loop

rrBLUP Function

Next, make a function allend_rrblup for the complete rrBLUP model, so we can run the function on all three KC datasets.
NOTE: This is trained on 100% of the data

m1_rrblup <- function(G, PHS, name) {
  rownames(G) = G[,1] ; G$GID <- NULL
  K=A.mat(G)

  obs <- kin.blup(data = PHS ,geno="GIDx",pheno = "RawMean", fixed = c("Year","Loc"))
  obsu <- obs$pred ; obsu <-as.data.frame(obsu)
  obsu$GIDx <- rownames(obsu) ; names(obsu) <- c("BLUP","GID"); obsu <- obsu[c("GID","BLUP") ]
  obsu <- obsu[order(obsu$GID),]; obsu$KC <- name; obsu$model <- "rrBLUP"; obsu$fixed <- "YrLoc"
  write.csv(obsu,file=paste("AllEnvrrBLUP_",name,"_ObsPHS",sep='',".csv"), row.names=FALSE)
  
  ans <- kin.blup(data = train ,geno="GIDx",pheno = "RawMean", K=K, fixed = c("Year","Loc"))
  pred=ans$pred ; pred <-  as.data.frame(pred)
  pred$GIDx <- rownames(pred); names(pred) <- c("pred","GID"); pred <- pred[c("GID","pred") ]
  pred <- pred[order(pred$GID),] ;  pred$KC <- name 
  write.csv(pred,file=paste("Run",i,k,"_AllEnvrrBLUP_YrLoc_",name,"_PredPHS_",sep='',".csv"), row.names=FALSE)
      
  tpred <- pred$pred; tpred[which(i!=tst)]<-NA ; tpred <- tpred[!is.na(tpred)]
  tobsu <- obsu$BLUP; tobsu[which(i!=tst)]<-NA ; tobsu <- tobsu[!is.na(tobsu)]
  cor(tpred,tobsu)  
}

Broken down into more detail:
After prepping the matrix G for analysis, we ran A.mat on the genetic matrix G

Then a mixed model was used to calulate the BLUPs of the RawMean sprouting score with Year and Loc used as fixed effects and we called the analysis obs.
After organization, the dataframe obsu now includes the GID lines names and the caluculated BLUPs.

Then a GEBVs were calulated from the RawMean sprouting score AND the kinship matrix K with Year and Loc used as fixed effects and we called the analysis pred.
After organization, the dataframe pred now includes the GID lines names and the caluculated GEBVs translated into sprout estimates (using the intercept).

I knew the GID lines should be the same between obsu and pred, but I wasnt sure if they were in the same order, so I just ordered them by GID name. (This may be unneccessary)
The dataframes were saved in the wd as .csv files and the correlation between the observed phenotype obsu$BLUPs were compared the the predicted phenotypes pred$GEBVs

accuracyr <- m1_rrblup(myGDr, PHSred7, "Red")
accuracyw <- m1_rrblup(myGDw, PHSwhite, "White")
accuracyc <- m1_rrblup(myGDc, PHSComb, "Comb")
write.csv(accuracyc,"accuracyc.csv")
write.csv(accuracyr,"accuracyr.csv")
write.csv(accuracyw,"accuracyw.csv")

accuracyr <- read.csv("accuracyr.csv")
accuracyw <- read.csv("accuracyw.csv")
accuracyc <-read.csv("accuracyc.csv")

df <- rbind(accuracyc, accuracyr, accuracyw); df$condition <- "AllEnv"
df1 <-  na.omit(df)#[!is.na(df)]
write.csv(df1,"AllEnvrrBLUP_FixedYrLoc.csv", row.names=FALSE)
kc_ggplot(df1, "PA", "", "Sprout~GID+Yr+Loc", "rrBLUP") 
ggsave("20190319_PA_FixedYrLoc.PNG", width = 10, height = 8, units = "in")

Setting up Five-fold Cross-Validation

Should I use a for() loop or a foreach() command. Using foreach() will allow me to run 5 cores on the Small Grains Mac, however I cant test me code on my laptop. I also need to embedd the model into the code below, but that is not shown here just yet.

Below is just working out how to subset the data for training and testing, 5 randomly different times

PHS=PHSred7
G=myGDr

m1_rrblup <- function(G, PHS, name) {
  accuracy = as.data.frame(matrix(NA,2,4))
  names(accuracy) <- c("results", "KC", "model", "fixed")
  obs <- kin.blup(data = PHS ,geno="GIDx",pheno = "RawMean", fixed = c("Year","Loc"))
  obsu <- obs$pred ; obsu <-as.data.frame(obsu)
  obsu$GIDx <- rownames(obsu) ; names(obsu) <- c("BLUP","GID"); obsu <- obsu[c("GID","BLUP") ]
  obsu <- obsu[order(obsu$GID),]; obsu$KC <- name; obsu$model <- "rrBLUP"; obsu$fixed <- "YrLoc"
  write.csv(obsu,file=paste("AllEnvrrBLUP_",name,"_ObsPHS",sep='',".csv"), row.names=FALSE)
  
  for(k in 1:5){
    set.seed(k)
    tst1 <-  sample(rep(1:folds,length.out=nrow(G))) #has 396 as an array
    G1 <- G
    G1$tst <-  tst1 #Make a 1-5 vector the length of myGD
    Gr1 <- select(G1, GID, tst)
    G1$tst <- NULL
    rownames(G1) = G1[,1] ; G1$GID <- NULL
    K=A.mat(G1)
    
    results <- c()
  
    foreach (i = 1:folds, .combine='c') %do% {
      #First subset train (80%) and test (20%) phenotypes
      tst <- tst1 ; Gr <- Gr1
      Gr$tst[which(i==Gr$tst)]<-NA #Now I want to make one of the 1-5 numbers NA
      
      train <- PHS #Align the Gr$tst to the PHS files based on X and GIDx names, Then omit columns with NA in them (the 20%)
      train$index <- train$GIDx
      train$index <- lapply(train$index, function(x) {
         inds <- match(x, Gr$GID)
         ifelse(is.na(inds),x, Gr$tst[inds]) 
      })
      train <- train[!(is.na(train$index)),]
    
      ans <- kin.blup(data = train ,geno="GIDx",pheno = "RawMean", K=K, fixed = c("Year","Loc"))
      pred=ans$pred ; pred <-  as.data.frame(pred)
      pred$GIDx <- rownames(pred); names(pred) <- c("pred","GID"); pred <- pred[c("GID","pred") ]
      pred <- pred[order(pred$GID),] ;  pred$KC <- name 
      write.csv(pred,file=paste("Run",i,k,"_AllEnvrrBLUP_YrLoc_",name,"_PredPHS_",sep='',".csv"), row.names=FALSE)
      
      tpred <- pred$pred; tpred[which(i!=tst)]<-NA ; tpred <- tpred[!is.na(tpred)]
      tobsu <- obsu$BLUP; tobsu[which(i!=tst)]<-NA ; tobsu <- tobsu[!is.na(tobsu)]
      cor(tpred,tobsu)  
      results <- append(results,cor(tpred,tobsu))
      results
    }
    resultsa <- as.data.frame(results)
    resultsa$KC <- name 
    resultsa$model <- "rrBLUP"
    resultsa$fixed <- "YrLoc"
    accuracy <- rbind(accuracy, resultsa)
  }
  accuracy
}

obsu can be calculated outside of the for loop once, since it is the observed phenotype mixed model estimates on the whole panel. So it doesnt need to be calculated with every round of cross-fold validation.

Every time the loop starts, a new seed is set to i, 1-5, creating the random selection of the subsets.
To clarify how we are subsetting:

  • I am using the length of the G matrix as my total number of lines in the dataset, in the red KC case its 369.
  • We will make a vector called tst with values 1-5, 369 times. What we are setting up, is to randomly select either 1, 2, 3, 4, or 5 and omit those GIDs from the training datsets (1/5 = 20%), leaving 80% of the dataset to train the model on.
  • With i=1, for example, all of the 1 in the tst column are called NA (this is omitting the 20%)
  • I then need to subset the phenotype file PHS that has all of the GIDs multiple times, over years and locations. However, since they have multiple replications, there is more than just 1-369. Which is why I needed to align the 1-5 tst values from the 1-369 GID names to the GID names in the PHS df. This is done using thelappyly function on the column train$index matched to Gr$X. Then all of the NAs in the train$index column are all then removed, which removes the 20% GIDs and leaves only the 80% GIDs (5-fold CV).
  • Then the model is trainted on the train phenotype df.
  • I then need to extract just the 20% GIDs from both the predicted model and the observed model called tpred and tobsu, respectively.
  • The prediction accuracy is calculated between the predicted values of the 20% GIDs compared to the observed values of the 20%
cor(tpred,tobsu)
LS0tDQp0aXRsZTogIlBIUyBHUyBPbmUtU3RlcCBBcHByb2FjaCINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICBjb2RlX2Rvd25sb2FkOiB5ZXMNCiAgICB0b2M6IHRydWUNCiAgICB0b2NfZGVwdGg6IDUNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICB0aGVtZTogZmxhdGx5DQogIHBkZl9kb2N1bWVudDogZGVmYXVsdA0KLS0tDQoqKkF1dGhvcjoqKiBTaGFudGVsIEEuIE1hcnRpbmV6ICANCioqUHVycG9zZToqKiBDb25kdWN0IGdlbm9taWMgc2VsZWN0aW9uIHVzaW5nIGEgb25lLXN0ZXAgYXBwcm9hY2ggaW5zdGVhZCBvZiBhIHR3by1zdGVwIGFwcHJvYWNoLiAgICAgDQoqKkxhc3QgdXBkYXRlZDoqKiAyMDE5LjAzLjI0ICAgDQoNCiMjIyBMb2FkOiBQYWNrYWdlcyBhbmQgZGYgIA0KVGhlIGRhdGFmcmFtZXMgd2VyZSB0aWR5ZWQgdXAgaW4gdGhlIGBEOi8uLi4vR1MvUEhTIEdTIElucHV0IERhdGEgUHJlcC5SYCBmaWxlLiAgDQpXZSB3aWxsIHN0YXJ0IHdpdGggYWxsIG9mIHRoZSBlbnZpcm9ubWVudHMgY2FsY3VsYXRlZCB0b2dldGhlciAobm8gc3Vic2V0dGluZyBvZiBlbnYpLCBhbmQgdGhlIGtlcm5lbCBjb2xvcmVkIHN1YnNldHRlZCB0byBpKSBSZWQsIGlpKSBXaGl0ZSwgYW5kIGlpaSkgQ29tYmluZWQgcmVkIGFuZCB3aGl0ZS4gIA0KYGBge1IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCiMjIEFsbCBFbnYNCmxvYWQoIkQ6L1BIUyBHZW5vbWljIFNlbGVjdGlvbiBQcm9qZWN0L0RhdGEgQW5hbHlzaXMvR1MvUEhTIEdTIEFsbCBFbnYgbXlZcyBteUdEcy5SRGF0YSIpDQpsaWJyYXJ5KEJHTFIpOyBsaWJyYXJ5KHJyQkxVUCkNCmxpYnJhcnkodGlkeXZlcnNlKTsgZm9udDwtZWxlbWVudF90ZXh0KGZhY2UgPSAiYm9sZCIsICBzaXplID0gMTYpOyBmb250MjwtZWxlbWVudF90ZXh0KHNpemUgPSAxNikNCnNldHdkKCJEOi9QSFMgR2Vub21pYyBTZWxlY3Rpb24gUHJvamVjdC9EYXRhIEFuYWx5c2lzL0dTLzIwMTkwMzE5IikNCmBgYA0KSSBuZWVkIHRvIG1ha2UgbGlzdHMgb2YgZWFjaCBvZiB0aGUgS0MgZ3JvdXBzIGZvciB0aGUgZ2Vub3R5cGljIGRhdGEgYEdgLCB0aGUgcGhlbm90eXBlIGRmIGBQSFNgIGFuZCB0aGUgbmFtZXMgb2YgZWFjaCBncm91cCBgbmFtZWAuICANCg0KYGBge3J9DQpHIDwtIGxpc3QobXlHRGMgLG15R0RyICxteUdEdyApIA0KUEhTIDwtIGxpc3QoUEhTQ29tYiwgUEhTcmVkNywgUEhTd2hpdGUpDQpuYW1lIDwtIGxpc3QoIkNvbWIiLCAiUmVkIiwgIldoaXRlIikNCmBgYA0KDQpEZWZpbmUgdGhlIHBhcmFtZXRlcnMgbmVlZGVkIHRvIHJ1biB0aGUgbW9kZWwsIGluIHRoaXMgY2FzZSwgcnJCTFVQLg0KYGBge3J9DQojI01vZGVsaW5nIFBhcmFtZXRlcnN+fn5+fn5+fn4NCmg8LTAuNCA7IGZvbGRzPTUgOyBpPTIgDQpgYGAgDQpUaGUgYmFuZHdpZHRoIHBhcmFtZXRlciwgYGhgLCB3aWxsIG5vdCBiZSBuZWVkZWQgdW50aWwgd2UgcnVuIHRoZSBSS0hTIG1vZGVscy4gIA0KSSBvbmx5IGRlZmluZSBgaT0yYCB1bnRpbCBJIGdldCB0byB0aGUgcG9pbnQgb2YgcnVubmluZyA1LWZvbGQgQ1YsIHRoZW4gYGlgIHdpbGwgYmUgZGVmaW5lZCBpbiBhIGBmb3IoKWBsb29wICANCg0KIyMjIHJyQkxVUCBGdW5jdGlvbiAgDQpOZXh0LCBtYWtlIGEgZnVuY3Rpb24gYGFsbGVuZF9ycmJsdXBgIGZvciB0aGUgY29tcGxldGUgcnJCTFVQIG1vZGVsLCBzbyB3ZSBjYW4gcnVuIHRoZSBmdW5jdGlvbiBvbiBhbGwgdGhyZWUgS0MgZGF0YXNldHMuICANCipOT1RFOiBUaGlzIGlzIHRyYWluZWQgb24gMTAwJSBvZiB0aGUgZGF0YSogIA0KYGBge3J9DQptMV9ycmJsdXAgPC0gZnVuY3Rpb24oRywgUEhTLCBuYW1lKSB7DQogIHJvd25hbWVzKEcpID0gR1ssMV0gOyBHJEdJRCA8LSBOVUxMDQogIEs9QS5tYXQoRykNCg0KICBvYnMgPC0ga2luLmJsdXAoZGF0YSA9IFBIUyAsZ2Vubz0iR0lEeCIscGhlbm8gPSAiUmF3TWVhbiIsIGZpeGVkID0gYygiWWVhciIsIkxvYyIpKQ0KICBvYnN1IDwtIG9icyRwcmVkIDsgb2JzdSA8LWFzLmRhdGEuZnJhbWUob2JzdSkNCiAgb2JzdSRHSUR4IDwtIHJvd25hbWVzKG9ic3UpIDsgbmFtZXMob2JzdSkgPC0gYygiQkxVUCIsIkdJRCIpOyBvYnN1IDwtIG9ic3VbYygiR0lEIiwiQkxVUCIpIF0NCiAgb2JzdSA8LSBvYnN1W29yZGVyKG9ic3UkR0lEKSxdOyBvYnN1JEtDIDwtIG5hbWU7IG9ic3UkbW9kZWwgPC0gInJyQkxVUCI7IG9ic3UkZml4ZWQgPC0gIllyTG9jIg0KICB3cml0ZS5jc3Yob2JzdSxmaWxlPXBhc3RlKCJBbGxFbnZyckJMVVBfIixuYW1lLCJfT2JzUEhTIixzZXA9JycsIi5jc3YiKSwgcm93Lm5hbWVzPUZBTFNFKQ0KICANCiAgYW5zIDwtIGtpbi5ibHVwKGRhdGEgPSB0cmFpbiAsZ2Vubz0iR0lEeCIscGhlbm8gPSAiUmF3TWVhbiIsIEs9SywgZml4ZWQgPSBjKCJZZWFyIiwiTG9jIikpDQogIHByZWQ9YW5zJHByZWQgOyBwcmVkIDwtICBhcy5kYXRhLmZyYW1lKHByZWQpDQogIHByZWQkR0lEeCA8LSByb3duYW1lcyhwcmVkKTsgbmFtZXMocHJlZCkgPC0gYygicHJlZCIsIkdJRCIpOyBwcmVkIDwtIHByZWRbYygiR0lEIiwicHJlZCIpIF0NCiAgcHJlZCA8LSBwcmVkW29yZGVyKHByZWQkR0lEKSxdIDsgIHByZWQkS0MgPC0gbmFtZSANCiAgd3JpdGUuY3N2KHByZWQsZmlsZT1wYXN0ZSgiUnVuIixpLGssIl9BbGxFbnZyckJMVVBfWXJMb2NfIixuYW1lLCJfUHJlZFBIU18iLHNlcD0nJywiLmNzdiIpLCByb3cubmFtZXM9RkFMU0UpDQogICAgICANCiAgdHByZWQgPC0gcHJlZCRwcmVkOyB0cHJlZFt3aGljaChpIT10c3QpXTwtTkEgOyB0cHJlZCA8LSB0cHJlZFshaXMubmEodHByZWQpXQ0KICB0b2JzdSA8LSBvYnN1JEJMVVA7IHRvYnN1W3doaWNoKGkhPXRzdCldPC1OQSA7IHRvYnN1IDwtIHRvYnN1WyFpcy5uYSh0b2JzdSldDQogIGNvcih0cHJlZCx0b2JzdSkgIA0KfQ0KYGBgDQoqKkJyb2tlbiBkb3duIGludG8gbW9yZSBkZXRhaWw6KiogIA0KQWZ0ZXIgcHJlcHBpbmcgdGhlIG1hdHJpeCBgR2AgZm9yIGFuYWx5c2lzLCB3ZSByYW4gYEEubWF0YCBvbiB0aGUgZ2VuZXRpYyBtYXRyaXggYEdgICANCg0KVGhlbiBhIG1peGVkIG1vZGVsIHdhcyB1c2VkIHRvIGNhbHVsYXRlIHRoZSBCTFVQcyBvZiB0aGUgUmF3TWVhbiBzcHJvdXRpbmcgc2NvcmUgd2l0aCBgWWVhcmAgYW5kIGBMb2NgIHVzZWQgYXMgZml4ZWQgZWZmZWN0cyBhbmQgd2UgY2FsbGVkIHRoZSBhbmFseXNpcyBgb2JzYC4gIA0KQWZ0ZXIgb3JnYW5pemF0aW9uLCB0aGUgZGF0YWZyYW1lIGBvYnN1YCBub3cgaW5jbHVkZXMgdGhlIEdJRCBsaW5lcyBuYW1lcyBhbmQgdGhlIGNhbHVjdWxhdGVkIEJMVVBzLiAgDQoNClRoZW4gYSBHRUJWcyB3ZXJlIGNhbHVsYXRlZCBmcm9tIHRoZSBSYXdNZWFuIHNwcm91dGluZyBzY29yZSBBTkQgdGhlIGtpbnNoaXAgbWF0cml4IGBLYCB3aXRoIGBZZWFyYCBhbmQgYExvY2AgdXNlZCBhcyBmaXhlZCBlZmZlY3RzIGFuZCB3ZSBjYWxsZWQgdGhlIGFuYWx5c2lzIGBwcmVkYC4gIA0KQWZ0ZXIgb3JnYW5pemF0aW9uLCB0aGUgZGF0YWZyYW1lIGBwcmVkYCBub3cgaW5jbHVkZXMgdGhlIEdJRCBsaW5lcyBuYW1lcyBhbmQgdGhlIGNhbHVjdWxhdGVkIEdFQlZzIHRyYW5zbGF0ZWQgaW50byBzcHJvdXQgZXN0aW1hdGVzICh1c2luZyB0aGUgaW50ZXJjZXB0KS4gICANCg0KSSBrbmV3IHRoZSBHSUQgbGluZXMgc2hvdWxkIGJlIHRoZSBzYW1lIGJldHdlZW4gYG9ic3VgIGFuZCBgcHJlZGAsIGJ1dCBJIHdhc250IHN1cmUgaWYgdGhleSB3ZXJlIGluIHRoZSBzYW1lIG9yZGVyLCBzbyBJIGp1c3Qgb3JkZXJlZCB0aGVtIGJ5IEdJRCBuYW1lLiAoVGhpcyBtYXkgYmUgdW5uZWNjZXNzYXJ5KSAgDQpUaGUgZGF0YWZyYW1lcyB3ZXJlIHNhdmVkIGluIHRoZSB3ZCBhcyAuY3N2IGZpbGVzIGFuZCB0aGUgY29ycmVsYXRpb24gYmV0d2VlbiB0aGUgb2JzZXJ2ZWQgcGhlbm90eXBlIGBvYnN1JEJMVVBzYCB3ZXJlIGNvbXBhcmVkIHRoZSB0aGUgcHJlZGljdGVkIHBoZW5vdHlwZXMgYHByZWQkR0VCVnNgICANCg0KYGBge3IgZXZhbD1GQUxTRX0NCmFjY3VyYWN5ciA8LSBtMV9ycmJsdXAobXlHRHIsIFBIU3JlZDcsICJSZWQiKQ0KYWNjdXJhY3l3IDwtIG0xX3JyYmx1cChteUdEdywgUEhTd2hpdGUsICJXaGl0ZSIpDQphY2N1cmFjeWMgPC0gbTFfcnJibHVwKG15R0RjLCBQSFNDb21iLCAiQ29tYiIpDQp3cml0ZS5jc3YoYWNjdXJhY3ljLCJhY2N1cmFjeWMuY3N2IikNCndyaXRlLmNzdihhY2N1cmFjeXIsImFjY3VyYWN5ci5jc3YiKQ0Kd3JpdGUuY3N2KGFjY3VyYWN5dywiYWNjdXJhY3l3LmNzdiIpDQoNCmFjY3VyYWN5ciA8LSByZWFkLmNzdigiYWNjdXJhY3lyLmNzdiIpDQphY2N1cmFjeXcgPC0gcmVhZC5jc3YoImFjY3VyYWN5dy5jc3YiKQ0KYWNjdXJhY3ljIDwtcmVhZC5jc3YoImFjY3VyYWN5Yy5jc3YiKQ0KDQpkZiA8LSByYmluZChhY2N1cmFjeWMsIGFjY3VyYWN5ciwgYWNjdXJhY3l3KTsgZGYkY29uZGl0aW9uIDwtICJBbGxFbnYiDQpkZjEgPC0gIG5hLm9taXQoZGYpI1shaXMubmEoZGYpXQ0Kd3JpdGUuY3N2KGRmMSwiQWxsRW52cnJCTFVQX0ZpeGVkWXJMb2MuY3N2Iiwgcm93Lm5hbWVzPUZBTFNFKQ0Ka2NfZ2dwbG90KGRmMSwgIlBBIiwgIiIsICJTcHJvdXR+R0lEK1lyK0xvYyIsICJyckJMVVAiKSANCmdnc2F2ZSgiMjAxOTAzMTlfUEFfRml4ZWRZckxvYy5QTkciLCB3aWR0aCA9IDEwLCBoZWlnaHQgPSA4LCB1bml0cyA9ICJpbiIpDQoNCmBgYA0KDQoNCiMjIyBTZXR0aW5nIHVwIEZpdmUtZm9sZCBDcm9zcy1WYWxpZGF0aW9uIA0KU2hvdWxkIEkgdXNlIGEgYGZvcigpYCBsb29wIG9yIGEgYGZvcmVhY2goKWAgY29tbWFuZC4gVXNpbmcgYGZvcmVhY2goKWAgd2lsbCBhbGxvdyBtZSB0byBydW4gNSBjb3JlcyBvbiB0aGUgU21hbGwgR3JhaW5zIE1hYywgaG93ZXZlciBJIGNhbnQgdGVzdCBtZSBjb2RlIG9uIG15IGxhcHRvcC4gSSBhbHNvIG5lZWQgdG8gZW1iZWRkIHRoZSBtb2RlbCBpbnRvIHRoZSBjb2RlIGJlbG93LCBidXQgdGhhdCBpcyBub3Qgc2hvd24gaGVyZSBqdXN0IHlldC4gIA0KDQpCZWxvdyBpcyBqdXN0IHdvcmtpbmcgb3V0IGhvdyB0byBzdWJzZXQgdGhlIGRhdGEgZm9yIHRyYWluaW5nIGFuZCB0ZXN0aW5nLCA1IHJhbmRvbWx5IGRpZmZlcmVudCB0aW1lcw0KYGBge3IgZXZhbD1GQUxTRX0NClBIUz1QSFNyZWQ3DQpHPW15R0RyDQoNCm0xX3JyYmx1cCA8LSBmdW5jdGlvbihHLCBQSFMsIG5hbWUpIHsNCiAgYWNjdXJhY3kgPSBhcy5kYXRhLmZyYW1lKG1hdHJpeChOQSwyLDQpKQ0KICBuYW1lcyhhY2N1cmFjeSkgPC0gYygicmVzdWx0cyIsICJLQyIsICJtb2RlbCIsICJmaXhlZCIpDQogIG9icyA8LSBraW4uYmx1cChkYXRhID0gUEhTICxnZW5vPSJHSUR4IixwaGVubyA9ICJSYXdNZWFuIiwgZml4ZWQgPSBjKCJZZWFyIiwiTG9jIikpDQogIG9ic3UgPC0gb2JzJHByZWQgOyBvYnN1IDwtYXMuZGF0YS5mcmFtZShvYnN1KQ0KICBvYnN1JEdJRHggPC0gcm93bmFtZXMob2JzdSkgOyBuYW1lcyhvYnN1KSA8LSBjKCJCTFVQIiwiR0lEIik7IG9ic3UgPC0gb2JzdVtjKCJHSUQiLCJCTFVQIikgXQ0KICBvYnN1IDwtIG9ic3Vbb3JkZXIob2JzdSRHSUQpLF07IG9ic3UkS0MgPC0gbmFtZTsgb2JzdSRtb2RlbCA8LSAicnJCTFVQIjsgb2JzdSRmaXhlZCA8LSAiWXJMb2MiDQogIHdyaXRlLmNzdihvYnN1LGZpbGU9cGFzdGUoIkFsbEVudnJyQkxVUF8iLG5hbWUsIl9PYnNQSFMiLHNlcD0nJywiLmNzdiIpLCByb3cubmFtZXM9RkFMU0UpDQogIA0KICBmb3IoayBpbiAxOjUpew0KICAgIHNldC5zZWVkKGspDQogICAgdHN0MSA8LSAgc2FtcGxlKHJlcCgxOmZvbGRzLGxlbmd0aC5vdXQ9bnJvdyhHKSkpICNoYXMgMzk2IGFzIGFuIGFycmF5DQogICAgRzEgPC0gRw0KICAgIEcxJHRzdCA8LSAgdHN0MSAjTWFrZSBhIDEtNSB2ZWN0b3IgdGhlIGxlbmd0aCBvZiBteUdEDQogICAgR3IxIDwtIHNlbGVjdChHMSwgR0lELCB0c3QpDQogICAgRzEkdHN0IDwtIE5VTEwNCiAgICByb3duYW1lcyhHMSkgPSBHMVssMV0gOyBHMSRHSUQgPC0gTlVMTA0KICAgIEs9QS5tYXQoRzEpDQogICAgDQogICAgcmVzdWx0cyA8LSBjKCkNCiAgDQogICAgZm9yZWFjaCAoaSA9IDE6Zm9sZHMsIC5jb21iaW5lPSdjJykgJWRvJSB7DQogICAgICAjRmlyc3Qgc3Vic2V0IHRyYWluICg4MCUpIGFuZCB0ZXN0ICgyMCUpIHBoZW5vdHlwZXMNCiAgICAgIHRzdCA8LSB0c3QxIDsgR3IgPC0gR3IxDQogICAgICBHciR0c3Rbd2hpY2goaT09R3IkdHN0KV08LU5BICNOb3cgSSB3YW50IHRvIG1ha2Ugb25lIG9mIHRoZSAxLTUgbnVtYmVycyBOQQ0KICAgICAgDQogICAgICB0cmFpbiA8LSBQSFMgI0FsaWduIHRoZSBHciR0c3QgdG8gdGhlIFBIUyBmaWxlcyBiYXNlZCBvbiBYIGFuZCBHSUR4IG5hbWVzLCBUaGVuIG9taXQgY29sdW1ucyB3aXRoIE5BIGluIHRoZW0gKHRoZSAyMCUpDQogICAgICB0cmFpbiRpbmRleCA8LSB0cmFpbiRHSUR4DQogICAgICB0cmFpbiRpbmRleCA8LSBsYXBwbHkodHJhaW4kaW5kZXgsIGZ1bmN0aW9uKHgpIHsNCiAgICAgICAgIGluZHMgPC0gbWF0Y2goeCwgR3IkR0lEKQ0KICAgICAgICAgaWZlbHNlKGlzLm5hKGluZHMpLHgsIEdyJHRzdFtpbmRzXSkgDQogICAgICB9KQ0KICAgICAgdHJhaW4gPC0gdHJhaW5bIShpcy5uYSh0cmFpbiRpbmRleCkpLF0NCiAgICANCiAgICAgIGFucyA8LSBraW4uYmx1cChkYXRhID0gdHJhaW4gLGdlbm89IkdJRHgiLHBoZW5vID0gIlJhd01lYW4iLCBLPUssIGZpeGVkID0gYygiWWVhciIsIkxvYyIpKQ0KICAgICAgcHJlZD1hbnMkcHJlZCA7IHByZWQgPC0gIGFzLmRhdGEuZnJhbWUocHJlZCkNCiAgICAgIHByZWQkR0lEeCA8LSByb3duYW1lcyhwcmVkKTsgbmFtZXMocHJlZCkgPC0gYygicHJlZCIsIkdJRCIpOyBwcmVkIDwtIHByZWRbYygiR0lEIiwicHJlZCIpIF0NCiAgICAgIHByZWQgPC0gcHJlZFtvcmRlcihwcmVkJEdJRCksXSA7ICBwcmVkJEtDIDwtIG5hbWUgDQogICAgICB3cml0ZS5jc3YocHJlZCxmaWxlPXBhc3RlKCJSdW4iLGksaywiX0FsbEVudnJyQkxVUF9ZckxvY18iLG5hbWUsIl9QcmVkUEhTXyIsc2VwPScnLCIuY3N2IiksIHJvdy5uYW1lcz1GQUxTRSkNCiAgICAgIA0KICAgICAgdHByZWQgPC0gcHJlZCRwcmVkOyB0cHJlZFt3aGljaChpIT10c3QpXTwtTkEgOyB0cHJlZCA8LSB0cHJlZFshaXMubmEodHByZWQpXQ0KICAgICAgdG9ic3UgPC0gb2JzdSRCTFVQOyB0b2JzdVt3aGljaChpIT10c3QpXTwtTkEgOyB0b2JzdSA8LSB0b2JzdVshaXMubmEodG9ic3UpXQ0KICAgICAgY29yKHRwcmVkLHRvYnN1KSAgDQogICAgICByZXN1bHRzIDwtIGFwcGVuZChyZXN1bHRzLGNvcih0cHJlZCx0b2JzdSkpDQogICAgICByZXN1bHRzDQogICAgfQ0KICAgIHJlc3VsdHNhIDwtIGFzLmRhdGEuZnJhbWUocmVzdWx0cykNCiAgICByZXN1bHRzYSRLQyA8LSBuYW1lIA0KICAgIHJlc3VsdHNhJG1vZGVsIDwtICJyckJMVVAiDQogICAgcmVzdWx0c2EkZml4ZWQgPC0gIllyTG9jIg0KICAgIGFjY3VyYWN5IDwtIHJiaW5kKGFjY3VyYWN5LCByZXN1bHRzYSkNCiAgfQ0KICBhY2N1cmFjeQ0KfQ0KDQpgYGAgDQpgb2JzdWAgY2FuIGJlIGNhbGN1bGF0ZWQgb3V0c2lkZSBvZiB0aGUgYGZvcmAgbG9vcCBvbmNlLCBzaW5jZSBpdCBpcyB0aGUgb2JzZXJ2ZWQgcGhlbm90eXBlIG1peGVkIG1vZGVsIGVzdGltYXRlcyBvbiB0aGUgd2hvbGUgcGFuZWwuIFNvIGl0IGRvZXNudCBuZWVkIHRvIGJlIGNhbGN1bGF0ZWQgd2l0aCBldmVyeSByb3VuZCBvZiBjcm9zcy1mb2xkIHZhbGlkYXRpb24uICANCg0KRXZlcnkgdGltZSB0aGUgbG9vcCBzdGFydHMsIGEgbmV3IHNlZWQgaXMgc2V0IHRvIGBpYCwgMS01LCBjcmVhdGluZyB0aGUgcmFuZG9tIHNlbGVjdGlvbiBvZiB0aGUgc3Vic2V0cy4gIA0KVG8gY2xhcmlmeSBob3cgd2UgYXJlIHN1YnNldHRpbmc6ICANCg0KLSBJIGFtIHVzaW5nIHRoZSBsZW5ndGggb2YgdGhlIGBHYCBtYXRyaXggYXMgbXkgdG90YWwgbnVtYmVyIG9mIGxpbmVzIGluIHRoZSBkYXRhc2V0LCBpbiB0aGUgcmVkIEtDIGNhc2UgaXRzIDM2OS4gICANCi0gV2Ugd2lsbCBtYWtlIGEgdmVjdG9yIGNhbGxlZCBgdHN0YCB3aXRoIHZhbHVlcyAxLTUsIDM2OSB0aW1lcy4gV2hhdCB3ZSBhcmUgc2V0dGluZyB1cCwgaXMgdG8gcmFuZG9tbHkgc2VsZWN0IGVpdGhlciAxLCAyLCAzLCA0LCBvciA1IGFuZCBvbWl0IHRob3NlIEdJRHMgZnJvbSB0aGUgdHJhaW5pbmcgZGF0c2V0cyAoMS81ID0gMjAlKSwgbGVhdmluZyA4MCUgb2YgdGhlIGRhdGFzZXQgdG8gdHJhaW4gdGhlIG1vZGVsIG9uLiAgICAgDQotIFdpdGggYGk9MWAsIGZvciBleGFtcGxlLCBhbGwgb2YgdGhlIGAxYCBpbiB0aGUgYHRzdGAgY29sdW1uIGFyZSBjYWxsZWQgYE5BYCAodGhpcyBpcyBvbWl0dGluZyB0aGUgMjAlKSAgDQotIEkgdGhlbiBuZWVkIHRvICBzdWJzZXQgdGhlIHBoZW5vdHlwZSBmaWxlIGBQSFNgIHRoYXQgaGFzIGFsbCBvZiB0aGUgR0lEcyBtdWx0aXBsZSB0aW1lcywgb3ZlciB5ZWFycyBhbmQgbG9jYXRpb25zLiBIb3dldmVyLCBzaW5jZSB0aGV5IGhhdmUgbXVsdGlwbGUgcmVwbGljYXRpb25zLCB0aGVyZSBpcyBtb3JlIHRoYW4ganVzdCAxLTM2OS4gV2hpY2ggaXMgd2h5IEkgbmVlZGVkIHRvIGFsaWduIHRoZSAxLTUgdHN0IHZhbHVlcyBmcm9tIHRoZSAxLTM2OSBHSUQgbmFtZXMgdG8gdGhlIEdJRCBuYW1lcyBpbiB0aGUgYFBIU2AgZGYuIFRoaXMgaXMgZG9uZSB1c2luZyB0aGVgbGFwcHlseWAgZnVuY3Rpb24gb24gdGhlIGNvbHVtbiBgdHJhaW4kaW5kZXhgIG1hdGNoZWQgdG8gYEdyJFhgLiBUaGVuIGFsbCBvZiB0aGUgYE5Bc2AgaW4gdGhlIGB0cmFpbiRpbmRleGAgY29sdW1uIGFyZSBhbGwgdGhlbiByZW1vdmVkLCB3aGljaCByZW1vdmVzIHRoZSAyMCUgR0lEcyBhbmQgbGVhdmVzIG9ubHkgdGhlIDgwJSBHSURzICg1LWZvbGQgQ1YpLiAgDQotIFRoZW4gdGhlIG1vZGVsIGlzIHRyYWludGVkIG9uIHRoZSBgdHJhaW5gIHBoZW5vdHlwZSBkZi4gIA0KLSBJIHRoZW4gbmVlZCB0byBleHRyYWN0IGp1c3QgdGhlIDIwJSBHSURzIGZyb20gYm90aCB0aGUgcHJlZGljdGVkIG1vZGVsIGFuZCB0aGUgb2JzZXJ2ZWQgbW9kZWwgY2FsbGVkIGB0cHJlZGAgYW5kIGB0b2JzdWAsIHJlc3BlY3RpdmVseS4gDQotIFRoZSBwcmVkaWN0aW9uIGFjY3VyYWN5IGlzIGNhbGN1bGF0ZWQgYmV0d2VlbiB0aGUgcHJlZGljdGVkIHZhbHVlcyBvZiB0aGUgMjAlIEdJRHMgY29tcGFyZWQgdG8gdGhlIG9ic2VydmVkIHZhbHVlcyBvZiB0aGUgMjAlIA0KDQpgYGB7ciBldmFsPUZBTFNFfQ0KY29yKHRwcmVkLHRvYnN1KSAgDQpgYGANCg==