Membuat fungsi dari metode-metode yang telah dipelajari (pertemuan 1-6). Fungsi diuji kelayakannya dengan menggunakan dataset yang tersedia dalam r.

Anggota

  • Alif Andika Putra, 16.8994
  • M Ghozy Al Haqqoni, 16.9293
  • M Rifqi Mubarak, 16.9304
  • Mukhammad Kharis, 16.9311
  • Novia Permatasari, 16.9335

R Dataset

Dataset yang digunakan untuk menguji kelayakan yaitu dataset state.x77. Berikut contoh tampilan dataset:

dataset <- state.x77
head(dataset)
           Population Income Illiteracy Life Exp Murder HS Grad Frost   Area
Alabama          3615   3624        2.1    69.05   15.1    41.3    20  50708
Alaska            365   6315        1.5    69.31   11.3    66.7   152 566432
Arizona          2212   4530        1.8    70.55    7.8    58.1    15 113417
Arkansas         2110   3378        1.9    70.66   10.1    39.9    65  51945
California      21198   5114        1.1    71.71   10.3    62.6    20 156361
Colorado         2541   4884        0.7    72.06    6.8    63.9   166 103766

Mean Vector

#Fungsi
vectorMean <- function(x) {
  n = dim(x)[1]
  xbar = rep(1,n) %*% x / n
  return(xbar)
}

Berikut penggunaan fungsi yang telah dibuat dengan dataset.

vectorMean(dataset)
     Population Income Illiteracy Life Exp Murder HS Grad  Frost     Area
[1,]    4246.42 4435.8       1.17  70.8786  7.378  53.108 104.46 70735.88

Selanjutnya dilakukan pengujian terhadap fungsi colMeans yang telah tersedia dalam R. Fungsi valid jika vectorMean(dataset) == colMeans(dataset).

#Validitas
if(colMeans(dataset) == vectorMean(dataset)){
  print("Fungsi valid")
}else
  print("Fungsi tidak valid")
[1] "Fungsi valid"

Covariance and Correlation Matrix

Covariance Matrix

#Fungsi
matrixCov <- function(x) {
  n = dim(x)[1]
  ones = rep(1,n)
  c = diag(1,n) - ones %*% t(ones) / n
  xc = c %*% x
  matCov = t(xc) %*% xc / (n-1)
  return(matCov)
}

Berikut penggunaan fungsi yang telah dibuat dengan dataset.

matrixCov(dataset)
              Population        Income   Illiteracy      Life Exp       Murder       HS Grad
Population 19931683.7588   571229.7796  292.8679592 -4.078425e+02  5663.523714  -3551.509551
Income       571229.7796   377573.3061 -163.7020408  2.806632e+02  -521.894286   3076.768980
Illiteracy      292.8680     -163.7020    0.3715306 -4.815122e-01     1.581776     -3.235469
Life Exp       -407.8425      280.6632   -0.4815122  1.802020e+00    -3.869480      6.312685
Murder         5663.5237     -521.8943    1.5817755 -3.869480e+00    13.627465    -14.549616
HS Grad       -3551.5096     3076.7690   -3.2354694  6.312685e+00   -14.549616     65.237894
Frost        -77081.9727     7227.6041  -21.2900000  1.828678e+01  -103.406000    153.992163
Area        8587916.9494 19049013.7510 4018.3371429 -1.229410e+04 71940.429959 229873.192816
                  Frost          Area
Population -77081.97265  8.587917e+06
Income       7227.60408  1.904901e+07
Illiteracy    -21.29000  4.018337e+03
Life Exp       18.28678 -1.229410e+04
Murder       -103.40600  7.194043e+04
HS Grad       153.99216  2.298732e+05
Frost        2702.00857  2.627039e+05
Area       262703.89306  7.280748e+09

Selanjutnya dilakukan pengujian terhadap fungsi cov yang telah tersedia dalam R. Fungsi valid jika matrixCov(dataset) == cov(dataset).

#Validitas
if(cov(dataset) == matrixCov(dataset)){
  print("Fungsi valid")
}else
  print("Fungsi tidak valid")
[1] "Fungsi valid"

Correlation Matrix

#Fungsi
matrixCor <- function(x) {
  matCov = matrixCov(x)
  result = matrix(nrow = dim(matCov)[1], ncol = dim(matCov)[2])
  for (i in 1:dim(matCov)[1]) {
    for (j in 1:dim(matCov)[2]) {
      result[i,j] = matCov[i,j] / (sqrt(matCov[i,i]) * sqrt(matCov[j,j]))
    }
  }
  return(result)
}

Berikut menguji kelayakan dengan dataset. Set Variable yang digunakan untuk melihat matriks korelasi yaitu variabel Population, Income, serta Illiteracy.

matrixCor(dataset[,1:3])
          [,1]       [,2]       [,3]
[1,] 1.0000000  0.2082276  0.1076224
[2,] 0.2082276  1.0000000 -0.4370752
[3,] 0.1076224 -0.4370752  1.0000000
#Cek validitas fungsi dengan fungsi cor()
cor(dataset[,1:3])
           Population     Income Illiteracy
Population  1.0000000  0.2082276  0.1076224
Income      0.2082276  1.0000000 -0.4370752
Illiteracy  0.1076224 -0.4370752  1.0000000

Contour Plot

Fungsi yang dibuat menunjukkan garis kontur (plot).

require(ellipse)
#Fungsi
kontur <- function(data){
  plot(data, main = "Contour Plot")
  rata<-vectorMean(data)
  cov<-matrixCov(data)
  lines( ellipse( cov, centre = rata,level=0.20) , col='black')
  lines( ellipse( cov, centre = rata,level=0.50) , col='black')
  lines( ellipse( cov, centre = rata,level=0.75) , col='blue')
  lines( ellipse( cov, centre = rata,level=0.90) , col='blue')
  lines( ellipse( cov, centre = rata,level=0.95) , col='red')
  lines( ellipse( cov, centre = rata,level=0.99) , col='red')
}

Berikut menguji kelayakan dengan dataset.

par(mfrow = c(2,2))
for(i in 1:4){
kontur(dataset[,i:5])
}
par(mfrow = c(1,1))

T2-Hotelling

Satu Sampel

#Fungsi
tHotellingTest1Sampel <- function(x, miu, alpha) {
  n = dim(x)[1]
  p = dim(x)[2]
  ybar = t(vectorMean(x))
  s = matrixCov(x)
  t2 = n * t(ybar - miu) %*% solve(s) %*% (ybar - miu)
  t2table = (n - 1) * p / ((n - 1) - p + 1) * qf(1 - alpha, p, (n - 1) - p + 1)
  rejectH0 = F
  if (t2 >= t2table) {
    rejectH0 = T
  }
  #output
  writeLines('')
  writeLines('\tUji T2 Hotelling Satu Sampel')
  writeLines('')
  writeLines(paste('T2 Obs =', t2))
  writeLines(paste('T2 Tab =', t2table))
  if (rejectH0) {
    writeLines('Keputusan = Tolak H0')
  } else {
    writeLines('Keputusan = Gagal Tolak H0')
  }
}

Berikut menguji kelayakan dengan dataset.

miu <- colMeans(dataset) #Karena colMeans == miu -> keputusan Gagal Tolak H0
tHotellingTest1Sampel(dataset, miu, .05)

    Uji T2 Hotelling Satu Sampel

T2 Obs = 1.54269109497771e-27
T2 Tab = 20.2357556026252
Keputusan = Gagal Tolak H0

Dua Sampel Dependen

#Fungsi
tHotellingTest2SampelDep <- function(x, y, alpha) {
  d = x - y
  n = dim(d)[1]
  p = dim(d)[2]
  dbar = t(vectorMean(d))
  s = matrixCov(d)
  t2 = n * t(dbar) %*% solve(s) %*% (dbar)
  t2table = (n - 1) * p / ((n - 1) - p + 1) * qf(1 - alpha, p, (n - 1) - p + 1)
  rejectH0 = F
  if (t2 >= t2table) {
    rejectH0 = T
  }
  #output
  writeLines('')
  writeLines('\tUji T2 Hotelling Dua Sampel Dependen')
  writeLines('')
  writeLines(paste('T2 Obs =', t2))
  writeLines(paste('T2 Tab =', t2table))
  if (rejectH0) {
    writeLines('Keputusan = Tolak H0')
  } else {
    writeLines('Keputusan = Gagal Tolak H0')
  }
}

Berikut menguji kelayakan dengan dataset.

miu <- colMeans(dataset)
a1 <- dataset[1:25,1:3]
a2 <- dataset[26:50,1:3]
tHotellingTest2SampelDep(a1, a2, .05)

    Uji T2 Hotelling Dua Sampel Dependen

T2 Obs = 4.02788412929234
T2 Tab = 9.97895450831698
Keputusan = Gagal Tolak H0

Dua Sampel Independen

#Fungsi
tHotellingTest2SampelInd <- function(x, y, alpha) {
  nx = dim(x)[1]
  px = dim(x)[2]
  ny = dim(y)[1]
  py = dim(y)[2]
  xbar = t(vectorMean(x))
  ybar = t(vectorMean(y))
  sx = matrixCov(x)
  sy = matrixCov(y)
  sp = ((nx - 1) * sx + (ny - 1) * sy) / (nx + ny - 2)
  t2 = nx * ny / (nx + ny) * t(xbar - ybar) %*% solve(sp) %*% (xbar - ybar)
  t2table = (nx + ny - 2) * px / ((nx + ny - 2) - px + 1) * qf(1 - alpha, px, (nx + ny - 2) - px + 1)
  rejectH0 = F
  if (t2 >= t2table) {
    rejectH0 = T
  }
  #output
  writeLines('')
  writeLines('\tUji T2 Hotelling Dua Sampel Independen')
  writeLines('')
  writeLines(paste('T2 Obs =', t2))
  writeLines(paste('T2 Tab =', t2table))
  if (rejectH0) {
    writeLines('Keputusan = Tolak H0')
  } else {
    writeLines('Keputusan = Gagal Tolak H0')
  }
}

Berikut menguji kelayakan dengan dataset.

tHotellingTest2SampelInd(a1, a2, .05)

    Uji T2 Hotelling Dua Sampel Independen

T2 Obs = 3.0625002928296
T2 Tab = 8.78664499452393
Keputusan = Gagal Tolak H0

Likelihood Ratio Test

Fungsi uji rasio likelihood digunakan untuk dataset satu sampel.

#Fungsi
likelihoodTest <- function(x , xbar_0, alfa){
  p <- ncol(x)
  n <- nrow(x)
  v <- n - 1
  
  xbar <- vectorMean(x)
  
  sgm <- matrixCov(x)
  sgm0 <- matrix(rep(0, (p^2)) , p)    
  for (i in 1:p) {
    for (k in 1:p) {
      sum <- 0
      for (j in 1:n) {
        sum <- sum + ((x[j, i] - xbar_0[i]) * (x[j, k] - xbar_0[k]))
      }
      sgm0[i, k] <- sum / (n - 1)
    }
  }
  sgm0
  
  # wilk <- mpower(det(sgm)/det(sgm0), n/2)
  t2table <- qf((1-alfa) , p, v-p+1) * (v*p) / (v-p+1)
  t2 <- (n-1)*(det(sgm0)/det(sgm)) - (n-1)
  
  rejectH0 = F
  if(t2 >= t2table){
    rejectH0 = T
  }
  #output
  writeLines('')
  writeLines('\tUji Rasio Likelihood')
  writeLines('')
  writeLines(paste('T2 Obs =', t2))
  writeLines(paste('T2 Tab =', t2table))
  if (rejectH0) {
    writeLines('Keputusan = Tolak H0')
  } else {
    writeLines('Keputusan = Gagal Tolak H0')
  }
}

Berikut menguji kelayakan dengan dataset. Fungsi valid jika Keputusan sama dengan keputusan menggunakan fungsi T2-Hotelling Satu Sampel yaitu Gagal Tolak H0.

likelihoodTest(dataset, miu, .05)

    Uji Rasio Likelihood

T2 Obs = 0
T2 Tab = 20.2357556026252
Keputusan = Gagal Tolak H0

TERIMAKASIH. Mohon maaf atas segala kekurangan.

LS0tDQp0aXRsZTogIlR1Z2FzIFByYSBVVFMgQVBHIEtlbG9tcG9rIDUiDQpkZXNjcmlwdGlvbjogS2VsYXMgM0tTMSAtIERhdGEgU2NpZW5jZS4NCm91dHB1dDogDQogIGh0bWxfbm90ZWJvb2s6DQogICAgdG9jOiB0cnVlDQogICAgdG9jX2Zsb2F0OiB0cnVlDQotLS0NCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpDQpgYGANCg0KYE1lbWJ1YXQgZnVuZ3NpIGRhcmkgbWV0b2RlLW1ldG9kZSB5YW5nIHRlbGFoIGRpcGVsYWphcmkgKHBlcnRlbXVhbiAxLTYpLmANCmBGdW5nc2kgZGl1amkga2VsYXlha2FubnlhIGRlbmdhbiBtZW5nZ3VuYWthbiBkYXRhc2V0IHlhbmcgdGVyc2VkaWEgZGFsYW0gci5gDQoNCiMjIyMgQW5nZ290YQ0KKiBBbGlmIEFuZGlrYSBQdXRyYSwgMTYuODk5NA0KKiBNIEdob3p5IEFsIEhhcXFvbmksIDE2LjkyOTMNCiogTSBSaWZxaSBNdWJhcmFrLCAxNi45MzA0DQoqIE11a2hhbW1hZCBLaGFyaXMsIDE2LjkzMTENCiogTm92aWEgUGVybWF0YXNhcmksIDE2LjkzMzUNCg0KIyMgUiBEYXRhc2V0DQpEYXRhc2V0IHlhbmcgZGlndW5ha2FuIHVudHVrIG1lbmd1amkga2VsYXlha2FuIHlhaXR1IGRhdGFzZXQgYHN0YXRlLng3N2AuDQpCZXJpa3V0IGNvbnRvaCB0YW1waWxhbiBkYXRhc2V0Og0KYGBge3IgZGF0YXNldHN9DQpkYXRhc2V0IDwtIHN0YXRlLng3Nw0KaGVhZChkYXRhc2V0KQ0KYGBgDQoNCiMjIE1lYW4gVmVjdG9yIA0KYGBge3IgdmVjbWVhbn0NCiNGdW5nc2kNCnZlY3Rvck1lYW4gPC0gZnVuY3Rpb24oeCkgew0KICBuID0gZGltKHgpWzFdDQogIHhiYXIgPSByZXAoMSxuKSAlKiUgeCAvIG4NCiAgcmV0dXJuKHhiYXIpDQp9DQpgYGANCkJlcmlrdXQgcGVuZ2d1bmFhbiBmdW5nc2kgeWFuZyB0ZWxhaCBkaWJ1YXQgZGVuZ2FuIGBkYXRhc2V0YC4gDQpgYGB7ciB3YXJuaW5nPUZBTFNFfQ0KdmVjdG9yTWVhbihkYXRhc2V0KQ0KYGBgDQpTZWxhbmp1dG55YSBkaWxha3VrYW4gcGVuZ3VqaWFuIHRlcmhhZGFwIGZ1bmdzaSBgY29sTWVhbnNgIHlhbmcgdGVsYWggdGVyc2VkaWEgZGFsYW0gUi4gRnVuZ3NpIHZhbGlkIGppa2EgYHZlY3Rvck1lYW4oZGF0YXNldCkgPT0gY29sTWVhbnMoZGF0YXNldClgLg0KYGBge3Igd2FybmluZz1GQUxTRX0NCiNWYWxpZGl0YXMNCmlmKGNvbE1lYW5zKGRhdGFzZXQpID09IHZlY3Rvck1lYW4oZGF0YXNldCkpew0KICBwcmludCgiRnVuZ3NpIHZhbGlkIikNCn1lbHNlDQogIHByaW50KCJGdW5nc2kgdGlkYWsgdmFsaWQiKQ0KYGBgDQoNCiMjIENvdmFyaWFuY2UgYW5kIENvcnJlbGF0aW9uIE1hdHJpeA0KIyMjIENvdmFyaWFuY2UgTWF0cml4IA0KYGBge3IgbWF0Y292fQ0KI0Z1bmdzaQ0KbWF0cml4Q292IDwtIGZ1bmN0aW9uKHgpIHsNCiAgbiA9IGRpbSh4KVsxXQ0KICBvbmVzID0gcmVwKDEsbikNCiAgYyA9IGRpYWcoMSxuKSAtIG9uZXMgJSolIHQob25lcykgLyBuDQogIHhjID0gYyAlKiUgeA0KICBtYXRDb3YgPSB0KHhjKSAlKiUgeGMgLyAobi0xKQ0KICByZXR1cm4obWF0Q292KQ0KfQ0KYGBgDQpCZXJpa3V0IHBlbmdndW5hYW4gZnVuZ3NpIHlhbmcgdGVsYWggZGlidWF0IGRlbmdhbiBgZGF0YXNldGAuIA0KYGBge3Igd2FybmluZz1GQUxTRX0NCm1hdHJpeENvdihkYXRhc2V0KQ0KYGBgDQpTZWxhbmp1dG55YSBkaWxha3VrYW4gcGVuZ3VqaWFuIHRlcmhhZGFwIGZ1bmdzaSBgY292YCB5YW5nIHRlbGFoIHRlcnNlZGlhIGRhbGFtIFIuIEZ1bmdzaSB2YWxpZCBqaWthIGBtYXRyaXhDb3YoZGF0YXNldCkgPT0gY292KGRhdGFzZXQpYC4NCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQojVmFsaWRpdGFzDQppZihjb3YoZGF0YXNldCkgPT0gbWF0cml4Q292KGRhdGFzZXQpKXsNCiAgcHJpbnQoIkZ1bmdzaSB2YWxpZCIpDQp9ZWxzZQ0KICBwcmludCgiRnVuZ3NpIHRpZGFrIHZhbGlkIikNCmBgYA0KDQojIyMgQ29ycmVsYXRpb24gTWF0cml4IA0KYGBge3IgbWF0Y29yfQ0KI0Z1bmdzaQ0KbWF0cml4Q29yIDwtIGZ1bmN0aW9uKHgpIHsNCiAgbWF0Q292ID0gbWF0cml4Q292KHgpDQogIHJlc3VsdCA9IG1hdHJpeChucm93ID0gZGltKG1hdENvdilbMV0sIG5jb2wgPSBkaW0obWF0Q292KVsyXSkNCiAgZm9yIChpIGluIDE6ZGltKG1hdENvdilbMV0pIHsNCiAgICBmb3IgKGogaW4gMTpkaW0obWF0Q292KVsyXSkgew0KICAgICAgcmVzdWx0W2ksal0gPSBtYXRDb3ZbaSxqXSAvIChzcXJ0KG1hdENvdltpLGldKSAqIHNxcnQobWF0Q292W2osal0pKQ0KICAgIH0NCiAgfQ0KICByZXR1cm4ocmVzdWx0KQ0KfQ0KYGBgDQpCZXJpa3V0IG1lbmd1amkga2VsYXlha2FuIGRlbmdhbiBgZGF0YXNldGAuIFNldCBWYXJpYWJsZSB5YW5nIGRpZ3VuYWthbiB1bnR1ayBtZWxpaGF0IG1hdHJpa3Mga29yZWxhc2kgeWFpdHUgdmFyaWFiZWwgYFBvcHVsYXRpb25gLCBgSW5jb21lYCwgc2VydGEgYElsbGl0ZXJhY3lgLg0KYGBge3Igd2FybmluZz1GQUxTRX0NCm1hdHJpeENvcihkYXRhc2V0WywxOjNdKQ0KI0NlayB2YWxpZGl0YXMgZnVuZ3NpIGRlbmdhbiBmdW5nc2kgY29yKCkNCmNvcihkYXRhc2V0WywxOjNdKQ0KYGBgDQoNCiMjIENvbnRvdXIgUGxvdA0KRnVuZ3NpIHlhbmcgZGlidWF0IG1lbnVuanVra2FuIGdhcmlzIGtvbnR1ciAocGxvdCkuDQpgYGB7ciBjb250b3VyfQ0KcmVxdWlyZShlbGxpcHNlKQ0KDQojRnVuZ3NpDQprb250dXIgPC0gZnVuY3Rpb24oZGF0YSl7DQogIHBsb3QoZGF0YSwgbWFpbiA9ICJDb250b3VyIFBsb3QiKQ0KICByYXRhPC12ZWN0b3JNZWFuKGRhdGEpDQogIGNvdjwtbWF0cml4Q292KGRhdGEpDQogIGxpbmVzKCBlbGxpcHNlKCBjb3YsIGNlbnRyZSA9IHJhdGEsbGV2ZWw9MC4yMCkgLCBjb2w9J2JsYWNrJykNCiAgbGluZXMoIGVsbGlwc2UoIGNvdiwgY2VudHJlID0gcmF0YSxsZXZlbD0wLjUwKSAsIGNvbD0nYmxhY2snKQ0KICBsaW5lcyggZWxsaXBzZSggY292LCBjZW50cmUgPSByYXRhLGxldmVsPTAuNzUpICwgY29sPSdibHVlJykNCiAgbGluZXMoIGVsbGlwc2UoIGNvdiwgY2VudHJlID0gcmF0YSxsZXZlbD0wLjkwKSAsIGNvbD0nYmx1ZScpDQogIGxpbmVzKCBlbGxpcHNlKCBjb3YsIGNlbnRyZSA9IHJhdGEsbGV2ZWw9MC45NSkgLCBjb2w9J3JlZCcpDQogIGxpbmVzKCBlbGxpcHNlKCBjb3YsIGNlbnRyZSA9IHJhdGEsbGV2ZWw9MC45OSkgLCBjb2w9J3JlZCcpDQp9DQpgYGANCkJlcmlrdXQgbWVuZ3VqaSBrZWxheWFrYW4gZGVuZ2FuIGBkYXRhc2V0YC4gDQpgYGB7cn0NCnBhcihtZnJvdyA9IGMoMiwyKSkNCmZvcihpIGluIDE6NCl7DQprb250dXIoZGF0YXNldFssaTo1XSkNCn0NCnBhcihtZnJvdyA9IGMoMSwxKSkNCmBgYA0KDQojIyBUMi1Ib3RlbGxpbmcNCiMjIyBTYXR1IFNhbXBlbA0KYGBge3Igc2F0dXNhbXBlbH0NCiNGdW5nc2kNCnRIb3RlbGxpbmdUZXN0MVNhbXBlbCA8LSBmdW5jdGlvbih4LCBtaXUsIGFscGhhKSB7DQogIG4gPSBkaW0oeClbMV0NCiAgcCA9IGRpbSh4KVsyXQ0KICB5YmFyID0gdCh2ZWN0b3JNZWFuKHgpKQ0KICBzID0gbWF0cml4Q292KHgpDQogIHQyID0gbiAqIHQoeWJhciAtIG1pdSkgJSolIHNvbHZlKHMpICUqJSAoeWJhciAtIG1pdSkNCiAgdDJ0YWJsZSA9IChuIC0gMSkgKiBwIC8gKChuIC0gMSkgLSBwICsgMSkgKiBxZigxIC0gYWxwaGEsIHAsIChuIC0gMSkgLSBwICsgMSkNCiAgcmVqZWN0SDAgPSBGDQogIGlmICh0MiA+PSB0MnRhYmxlKSB7DQogICAgcmVqZWN0SDAgPSBUDQogIH0NCiAgI291dHB1dA0KICB3cml0ZUxpbmVzKCcnKQ0KICB3cml0ZUxpbmVzKCdcdFVqaSBUMiBIb3RlbGxpbmcgU2F0dSBTYW1wZWwnKQ0KICB3cml0ZUxpbmVzKCcnKQ0KICB3cml0ZUxpbmVzKHBhc3RlKCdUMiBPYnMgPScsIHQyKSkNCiAgd3JpdGVMaW5lcyhwYXN0ZSgnVDIgVGFiID0nLCB0MnRhYmxlKSkNCiAgaWYgKHJlamVjdEgwKSB7DQogICAgd3JpdGVMaW5lcygnS2VwdXR1c2FuID0gVG9sYWsgSDAnKQ0KICB9IGVsc2Ugew0KICAgIHdyaXRlTGluZXMoJ0tlcHV0dXNhbiA9IEdhZ2FsIFRvbGFrIEgwJykNCiAgfQ0KfQ0KYGBgDQpCZXJpa3V0IG1lbmd1amkga2VsYXlha2FuIGRlbmdhbiBgZGF0YXNldGAuDQpgYGB7cn0NCm1pdSA8LSBjb2xNZWFucyhkYXRhc2V0KSAjS2FyZW5hIGNvbE1lYW5zID09IG1pdSAtPiBrZXB1dHVzYW4gR2FnYWwgVG9sYWsgSDANCnRIb3RlbGxpbmdUZXN0MVNhbXBlbChkYXRhc2V0LCBtaXUsIC4wNSkNCmBgYA0KDQojIyMgRHVhIFNhbXBlbCBEZXBlbmRlbg0KYGBge3IgZHVhU2FtcGVsRGVwfQ0KI0Z1bmdzaQ0KdEhvdGVsbGluZ1Rlc3QyU2FtcGVsRGVwIDwtIGZ1bmN0aW9uKHgsIHksIGFscGhhKSB7DQogIGQgPSB4IC0geQ0KICBuID0gZGltKGQpWzFdDQogIHAgPSBkaW0oZClbMl0NCiAgZGJhciA9IHQodmVjdG9yTWVhbihkKSkNCiAgcyA9IG1hdHJpeENvdihkKQ0KICB0MiA9IG4gKiB0KGRiYXIpICUqJSBzb2x2ZShzKSAlKiUgKGRiYXIpDQogIHQydGFibGUgPSAobiAtIDEpICogcCAvICgobiAtIDEpIC0gcCArIDEpICogcWYoMSAtIGFscGhhLCBwLCAobiAtIDEpIC0gcCArIDEpDQogIHJlamVjdEgwID0gRg0KICBpZiAodDIgPj0gdDJ0YWJsZSkgew0KICAgIHJlamVjdEgwID0gVA0KICB9DQogICNvdXRwdXQNCiAgd3JpdGVMaW5lcygnJykNCiAgd3JpdGVMaW5lcygnXHRVamkgVDIgSG90ZWxsaW5nIER1YSBTYW1wZWwgRGVwZW5kZW4nKQ0KICB3cml0ZUxpbmVzKCcnKQ0KICB3cml0ZUxpbmVzKHBhc3RlKCdUMiBPYnMgPScsIHQyKSkNCiAgd3JpdGVMaW5lcyhwYXN0ZSgnVDIgVGFiID0nLCB0MnRhYmxlKSkNCiAgaWYgKHJlamVjdEgwKSB7DQogICAgd3JpdGVMaW5lcygnS2VwdXR1c2FuID0gVG9sYWsgSDAnKQ0KICB9IGVsc2Ugew0KICAgIHdyaXRlTGluZXMoJ0tlcHV0dXNhbiA9IEdhZ2FsIFRvbGFrIEgwJykNCiAgfQ0KfQ0KYGBgDQpCZXJpa3V0IG1lbmd1amkga2VsYXlha2FuIGRlbmdhbiBgZGF0YXNldGAuDQpgYGB7cn0NCm1pdSA8LSBjb2xNZWFucyhkYXRhc2V0KQ0KYTEgPC0gZGF0YXNldFsxOjI1LDE6M10NCmEyIDwtIGRhdGFzZXRbMjY6NTAsMTozXQ0KDQp0SG90ZWxsaW5nVGVzdDJTYW1wZWxEZXAoYTEsIGEyLCAuMDUpDQpgYGANCg0KIyMjIER1YSBTYW1wZWwgSW5kZXBlbmRlbg0KYGBge3IgZHVhU2FtcGVsSW5kfQ0KI0Z1bmdzaQ0KdEhvdGVsbGluZ1Rlc3QyU2FtcGVsSW5kIDwtIGZ1bmN0aW9uKHgsIHksIGFscGhhKSB7DQogIG54ID0gZGltKHgpWzFdDQogIHB4ID0gZGltKHgpWzJdDQogIG55ID0gZGltKHkpWzFdDQogIHB5ID0gZGltKHkpWzJdDQogIHhiYXIgPSB0KHZlY3Rvck1lYW4oeCkpDQogIHliYXIgPSB0KHZlY3Rvck1lYW4oeSkpDQogIHN4ID0gbWF0cml4Q292KHgpDQogIHN5ID0gbWF0cml4Q292KHkpDQogIHNwID0gKChueCAtIDEpICogc3ggKyAobnkgLSAxKSAqIHN5KSAvIChueCArIG55IC0gMikNCiAgdDIgPSBueCAqIG55IC8gKG54ICsgbnkpICogdCh4YmFyIC0geWJhcikgJSolIHNvbHZlKHNwKSAlKiUgKHhiYXIgLSB5YmFyKQ0KICB0MnRhYmxlID0gKG54ICsgbnkgLSAyKSAqIHB4IC8gKChueCArIG55IC0gMikgLSBweCArIDEpICogcWYoMSAtIGFscGhhLCBweCwgKG54ICsgbnkgLSAyKSAtIHB4ICsgMSkNCiAgcmVqZWN0SDAgPSBGDQogIGlmICh0MiA+PSB0MnRhYmxlKSB7DQogICAgcmVqZWN0SDAgPSBUDQogIH0NCiAgI291dHB1dA0KICB3cml0ZUxpbmVzKCcnKQ0KICB3cml0ZUxpbmVzKCdcdFVqaSBUMiBIb3RlbGxpbmcgRHVhIFNhbXBlbCBJbmRlcGVuZGVuJykNCiAgd3JpdGVMaW5lcygnJykNCiAgd3JpdGVMaW5lcyhwYXN0ZSgnVDIgT2JzID0nLCB0MikpDQogIHdyaXRlTGluZXMocGFzdGUoJ1QyIFRhYiA9JywgdDJ0YWJsZSkpDQogIGlmIChyZWplY3RIMCkgew0KICAgIHdyaXRlTGluZXMoJ0tlcHV0dXNhbiA9IFRvbGFrIEgwJykNCiAgfSBlbHNlIHsNCiAgICB3cml0ZUxpbmVzKCdLZXB1dHVzYW4gPSBHYWdhbCBUb2xhayBIMCcpDQogIH0NCn0NCmBgYA0KQmVyaWt1dCBtZW5ndWppIGtlbGF5YWthbiBkZW5nYW4gYGRhdGFzZXRgLg0KYGBge3J9DQp0SG90ZWxsaW5nVGVzdDJTYW1wZWxJbmQoYTEsIGEyLCAuMDUpDQpgYGANCg0KIyMgTGlrZWxpaG9vZCBSYXRpbyBUZXN0DQpGdW5nc2kgdWppIHJhc2lvIGxpa2VsaWhvb2QgZGlndW5ha2FuIHVudHVrIGRhdGFzZXQgc2F0dSBzYW1wZWwuDQpgYGB7ciBsaWtlbGlob29kfQ0KI0Z1bmdzaQ0KbGlrZWxpaG9vZFRlc3QgPC0gZnVuY3Rpb24oeCAsIHhiYXJfMCwgYWxmYSl7DQogIHAgPC0gbmNvbCh4KQ0KICBuIDwtIG5yb3coeCkNCiAgdiA8LSBuIC0gMQ0KICANCiAgeGJhciA8LSB2ZWN0b3JNZWFuKHgpDQogIA0KICBzZ20gPC0gbWF0cml4Q292KHgpDQogIHNnbTAgPC0gbWF0cml4KHJlcCgwLCAocF4yKSkgLCBwKSAgICANCiAgZm9yIChpIGluIDE6cCkgew0KICAgIGZvciAoayBpbiAxOnApIHsNCiAgICAgIHN1bSA8LSAwDQogICAgICBmb3IgKGogaW4gMTpuKSB7DQogICAgICAgIHN1bSA8LSBzdW0gKyAoKHhbaiwgaV0gLSB4YmFyXzBbaV0pICogKHhbaiwga10gLSB4YmFyXzBba10pKQ0KICAgICAgfQ0KICAgICAgc2dtMFtpLCBrXSA8LSBzdW0gLyAobiAtIDEpDQogICAgfQ0KICB9DQogIHNnbTANCiAgDQogICMgd2lsayA8LSBtcG93ZXIoZGV0KHNnbSkvZGV0KHNnbTApLCBuLzIpDQogIHQydGFibGUgPC0gcWYoKDEtYWxmYSkgLCBwLCB2LXArMSkgKiAodipwKSAvICh2LXArMSkNCiAgdDIgPC0gKG4tMSkqKGRldChzZ20wKS9kZXQoc2dtKSkgLSAobi0xKQ0KICANCiAgcmVqZWN0SDAgPSBGDQogIGlmKHQyID49IHQydGFibGUpew0KICAgIHJlamVjdEgwID0gVA0KICB9DQogICNvdXRwdXQNCiAgd3JpdGVMaW5lcygnJykNCiAgd3JpdGVMaW5lcygnXHRVamkgUmFzaW8gTGlrZWxpaG9vZCcpDQogIHdyaXRlTGluZXMoJycpDQogIHdyaXRlTGluZXMocGFzdGUoJ1QyIE9icyA9JywgdDIpKQ0KICB3cml0ZUxpbmVzKHBhc3RlKCdUMiBUYWIgPScsIHQydGFibGUpKQ0KICBpZiAocmVqZWN0SDApIHsNCiAgICB3cml0ZUxpbmVzKCdLZXB1dHVzYW4gPSBUb2xhayBIMCcpDQogIH0gZWxzZSB7DQogICAgd3JpdGVMaW5lcygnS2VwdXR1c2FuID0gR2FnYWwgVG9sYWsgSDAnKQ0KICB9DQp9DQpgYGANCkJlcmlrdXQgbWVuZ3VqaSBrZWxheWFrYW4gZGVuZ2FuIGBkYXRhc2V0YC4gRnVuZ3NpIHZhbGlkIGppa2EgS2VwdXR1c2FuIHNhbWEgZGVuZ2FuIGtlcHV0dXNhbiBtZW5nZ3VuYWthbiBmdW5nc2kgVDItSG90ZWxsaW5nIFNhdHUgU2FtcGVsIHlhaXR1IGBHYWdhbCBUb2xhayBIMGAuDQpgYGB7cn0NCmxpa2VsaWhvb2RUZXN0KGRhdGFzZXQsIG1pdSwgLjA1KQ0KYGBgDQoNClxjZW50ZXIgX19URVJJTUFLQVNJSC4gTW9ob24gbWFhZiBhdGFzIHNlZ2FsYSBrZWt1cmFuZ2FuLl9fIFxjZW50ZXI=