Overview

In this homework assignment, you will work through various classification metrics. You will be asked to create functions in R to carry out the various calculations. You will also investigate some functions in packages that will let you obtain the equivalent results. Finally, you will create graphical output that also can be used to evaluate the output of classification models, such as binary logistic regression

1. Loading dataset

library(tidyverse)
library(dplyr)
df <- read.csv('https://raw.githubusercontent.com/lburenkov/classification-output/main/classification-output-data.csv')

Data exploration

summary(df)
##     pregnant         glucose        diastolic        skinfold   
##  Min.   : 0.000   Min.   : 57.0   Min.   : 38.0   Min.   : 0.0  
##  1st Qu.: 1.000   1st Qu.: 99.0   1st Qu.: 64.0   1st Qu.: 0.0  
##  Median : 3.000   Median :112.0   Median : 70.0   Median :22.0  
##  Mean   : 3.862   Mean   :118.3   Mean   : 71.7   Mean   :19.8  
##  3rd Qu.: 6.000   3rd Qu.:136.0   3rd Qu.: 78.0   3rd Qu.:32.0  
##  Max.   :15.000   Max.   :197.0   Max.   :104.0   Max.   :54.0  
##     insulin            bmi           pedigree           age       
##  Min.   :  0.00   Min.   :19.40   Min.   :0.0850   Min.   :21.00  
##  1st Qu.:  0.00   1st Qu.:26.30   1st Qu.:0.2570   1st Qu.:24.00  
##  Median :  0.00   Median :31.60   Median :0.3910   Median :30.00  
##  Mean   : 63.77   Mean   :31.58   Mean   :0.4496   Mean   :33.31  
##  3rd Qu.:105.00   3rd Qu.:36.00   3rd Qu.:0.5800   3rd Qu.:41.00  
##  Max.   :543.00   Max.   :50.00   Max.   :2.2880   Max.   :67.00  
##      class         scored.class    scored.probability
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.02323   
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.11702   
##  Median :0.0000   Median :0.0000   Median :0.23999   
##  Mean   :0.3149   Mean   :0.1768   Mean   :0.30373   
##  3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:0.43093   
##  Max.   :1.0000   Max.   :1.0000   Max.   :0.94633

2. The data set has three key columns

The data set has three key columns we will use: class: the actual class for the observation scored.class: the predicted class for the observation (based on a threshold of 0.5) scored.probability: the predicted probability of success for the observation Use the table() function to get the raw confusion matrix for this scored dataset. Make sure you understand the output. In particular, do the rows represent the actual or predicted class? The columns?

df1 <- df %>% 
  select(class, scored.class, scored.probability)
df1
##     class scored.class scored.probability
## 1       0            0         0.32845226
## 2       0            0         0.27319044
## 3       1            0         0.10966039
## 4       0            0         0.05599835
## 5       0            0         0.10049072
## 6       0            0         0.05515460
## 7       0            0         0.10711542
## 8       0            0         0.45994744
## 9       0            0         0.11702368
## 10      0            0         0.31536320
## 11      0            0         0.12518925
## 12      0            0         0.27062482
## 13      0            0         0.20980960
## 14      0            0         0.09358589
## 15      1            1         0.88484573
## 16      1            0         0.39665216
## 17      0            1         0.89139491
## 18      1            1         0.53454900
## 19      1            1         0.94633418
## 20      0            0         0.14491618
## 21      0            0         0.21763796
## 22      0            0         0.07521357
## 23      0            0         0.08843254
## 24      0            0         0.30346820
## 25      1            1         0.72448003
## 26      1            0         0.27497369
## 27      1            0         0.42486483
## 28      1            0         0.43092552
## 29      0            0         0.02322803
## 30      0            0         0.04596084
## 31      0            0         0.12798534
## 32      0            0         0.29933706
## 33      1            0         0.45909503
## 34      0            0         0.10479581
## 35      1            1         0.86309177
## 36      1            1         0.63997495
## 37      0            0         0.35818434
## 38      0            0         0.37216467
## 39      1            1         0.81110322
## 40      0            0         0.16812736
## 41      0            0         0.15127796
## 42      0            0         0.10700703
## 43      0            0         0.18796139
## 44      0            0         0.13719711
## 45      0            0         0.30047491
## 46      0            0         0.13688715
## 47      0            0         0.09786911
## 48      0            0         0.06290701
## 49      1            0         0.26941931
## 50      0            0         0.48854279
## 51      0            0         0.37175798
## 52      1            0         0.09947993
## 53      0            0         0.08656230
## 54      0            0         0.17528939
## 55      1            0         0.46937901
## 56      1            1         0.61655438
## 57      0            0         0.09982792
## 58      1            1         0.68917710
## 59      0            0         0.25528619
## 60      1            1         0.85054326
## 61      1            0         0.16886251
## 62      0            0         0.09724147
## 63      0            0         0.24836913
## 64      0            0         0.18156098
## 65      0            0         0.23999362
## 66      0            0         0.40455890
## 67      0            0         0.35830256
## 68      0            0         0.15063079
## 69      1            0         0.48653832
## 70      1            1         0.61503482
## 71      0            0         0.35448950
## 72      1            0         0.17313962
## 73      1            0         0.25961113
## 74      1            1         0.69893986
## 75      0            0         0.29860163
## 76      0            0         0.10423133
## 77      0            0         0.21105283
## 78      0            0         0.06542776
## 79      0            0         0.05051433
## 80      0            0         0.10867969
## 81      0            0         0.07868948
## 82      1            1         0.68128759
## 83      1            0         0.37712032
## 84      0            0         0.16270775
## 85      0            0         0.35215080
## 86      1            0         0.47549641
## 87      0            0         0.13565815
## 88      0            0         0.13391981
## 89      0            1         0.52247107
## 90      0            0         0.25938189
## 91      0            0         0.09946740
## 92      0            0         0.12719232
## 93      1            0         0.37644619
## 94      0            1         0.52088231
## 95      1            1         0.76059210
## 96      1            0         0.20892653
## 97      1            0         0.23335214
## 98      0            0         0.20594069
## 99      0            0         0.11565955
## 100     0            0         0.08399311
## 101     1            0         0.11773115
## 102     1            1         0.71703637
## 103     0            0         0.12928998
## 104     0            0         0.43680373
## 105     0            0         0.28155366
## 106     1            1         0.59198379
## 107     1            1         0.84729320
## 108     0            0         0.31515560
## 109     0            0         0.13731015
## 110     0            0         0.16809635
## 111     0            0         0.05067111
## 112     0            0         0.49835908
## 113     1            0         0.45481435
## 114     0            0         0.45044211
## 115     1            0         0.18149738
## 116     0            0         0.29420367
## 117     1            0         0.40944833
## 118     1            0         0.31676829
## 119     0            0         0.19695491
## 120     0            0         0.06279957
## 121     1            1         0.88335913
## 122     0            0         0.09936447
## 123     1            0         0.40883702
## 124     0            0         0.36249223
## 125     0            0         0.07991838
## 126     1            1         0.61727619
## 127     0            0         0.22358166
## 128     0            0         0.30138627
## 129     0            0         0.06610913
## 130     1            0         0.16702896
## 131     0            0         0.29706445
## 132     0            1         0.62765020
## 133     0            0         0.20362875
## 134     0            0         0.45747349
## 135     0            0         0.37227213
## 136     1            1         0.63578069
## 137     0            0         0.08377338
## 138     0            0         0.15193780
## 139     0            0         0.05320989
## 140     1            1         0.54866439
## 141     0            0         0.49462614
## 142     0            0         0.23532549
## 143     0            0         0.18315190
## 144     0            0         0.06415054
## 145     0            0         0.08595564
## 146     0            0         0.37378785
## 147     0            0         0.41280937
## 148     1            1         0.83049762
## 149     0            0         0.13145383
## 150     0            0         0.06614058
## 151     0            0         0.10096173
## 152     0            0         0.02863965
## 153     0            0         0.26964042
## 154     1            0         0.32814202
## 155     0            0         0.14935090
## 156     1            0         0.45557144
## 157     0            0         0.08094979
## 158     0            0         0.03471434
## 159     1            1         0.66147500
## 160     0            0         0.06598930
## 161     0            0         0.13979031
## 162     0            0         0.04742669
## 163     0            0         0.02660702
## 164     1            1         0.78259456
## 165     0            0         0.14182849
## 166     0            0         0.28503028
## 167     1            0         0.33885542
## 168     1            0         0.16264455
## 169     0            1         0.56490618
## 170     0            0         0.05622422
## 171     0            0         0.18911685
## 172     0            0         0.17072487
## 173     0            0         0.16080488
## 174     1            0         0.24577269
## 175     0            0         0.10999049
## 176     1            1         0.67645162
## 177     0            0         0.31141958
## 178     1            1         0.70720959
## 179     1            1         0.88827658
## 180     0            0         0.42246786
## 181     0            0         0.11998103

Use the table() function to get the raw confusion matrix for this scored dataset. Make sure you understand the output. In particular, do the rows represent the actual or predicted class? The columns?

df1 %>% 
  select(class, scored.class) %>%
  mutate(class = recode(class,
                        '0' = 'Actual Negative', 
                        '1' = 'Actual Positive'),
         scored.class = recode(scored.class,
                               '0' = 'Predicted Negative', 
                               '1' = 'Predicted Positive')) %>%
  table()
##                  scored.class
## class             Predicted Negative Predicted Positive
##   Actual Negative                119                  5
##   Actual Positive                 30                 27

3. Accuracy

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the accuracy of the predictions.

𝐴𝑐𝑐𝑢𝑟𝑎𝑐𝑦= 𝑇𝑃+𝑇𝑁/𝑇𝑃+𝐹𝑃+𝑇𝑁+𝐹𝑁

#Creating a function to calculate accuracy
calculate_accuracy <- function(df) {
  #Making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe must have 'class' and 'scored.class' columns.")
  }

  #Calculating True Positives (TP), True Negatives (TN), False Positives (FP), False Negatives (FN)
  TP <- sum(df$class == 1 & df$scored.class == 1)
  TN <- sum(df$class == 0 & df$scored.class == 0)
  FP <- sum(df$class == 0 & df$scored.class == 1)
  FN <- sum(df$class == 1 & df$scored.class == 0)

  #Calculating accuracy
  accuracy <- (TP + TN) / (TP + FP + TN + FN)

  return(accuracy)
}

#Using the calculate_accuracy function with dataframe
accuracy_result <- calculate_accuracy(df1)
print(paste("Accuracy:", accuracy_result))
## [1] "Accuracy: 0.806629834254144"

4. Error

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the classification error rate of the predictions.

𝐶𝑙𝑎𝑠𝑠𝑖𝑓𝑖𝑐𝑎𝑡𝑖𝑜𝑛 𝐸𝑟𝑟𝑜𝑟 𝑅𝑎𝑡𝑒= 𝐹𝑃+𝐹𝑁𝑇𝑃+𝐹𝑃+𝑇𝑁+𝐹𝑁

Verify that you get an accuracy and an error rate that sums to one.

#Creating a function to calculate classification error rate
calculate_error_rate <- function(df) {
  #Dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe has 'class' and 'scored.class' columns.")
  }

  #Calculating the classification error rate
  error_rate <- mean(df$class != df$scored.class)

  return(error_rate)
}

#Example usage with dataframe
error_rate_result <- calculate_error_rate(df1)
print(paste("Classification Error Rate:", error_rate_result))
## [1] "Classification Error Rate: 0.193370165745856"

5. Precision

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the precision of the predictions.

𝑃𝑟𝑒𝑐𝑖𝑠𝑖𝑜𝑛= 𝑇/𝑃𝑇𝑃+𝐹𝑃

#Creating a function to calculate precision
calculate_precision <- function(df) {
  #dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("dataframe has 'class' and 'scored.class' columns.")
  }

  #Calculating true positive (TP), false positive (FP), and precision
  TP <- sum(df$class == 1 & df$scored.class == 1)
  FP <- sum(df$class == 0 & df$scored.class == 1)

  #Avoiding division by zero
  if (TP + FP == 0) {
    precision <- NaN
  } else {
    precision <- TP / (TP + FP)
  }

  return(precision)
}

# Example usage with dataframe
precision_result <- calculate_precision(df1)
print(paste("Precision:", precision_result))
## [1] "Precision: 0.84375"

6. Sensitivity

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the sensitivity of the predictions. Sensitivity is also known as recall.

𝑆𝑒𝑛𝑠𝑖𝑡𝑖𝑣𝑖𝑡𝑦= 𝑇𝑃/𝑇𝑃+𝐹𝑁

#Creating a unction to calculate sensitivity (recall)
calculate_sensitivity <- function(df) {
  #Making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe has 'class' and 'scored.class' columns.")
  }

  #Calculating true positive (TP), false negative (FN), and sensitivity
  TP <- sum(df$class == 1 & df$scored.class == 1)
  FN <- sum(df$class == 1 & df$scored.class == 0)

  #Avoiding division by zero
  if (TP + FN == 0) {
    sensitivity <- NaN
  } else {
    sensitivity <- TP / (TP + FN)
  }

  return(sensitivity)
}

#Example usage with dataframe
sensitivity_result <- calculate_sensitivity(df1)
print(paste("Sensitivity (Recall):", sensitivity_result))
## [1] "Sensitivity (Recall): 0.473684210526316"

7. Specificity

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the specificity of the predictions.

𝑆𝑝𝑒𝑐𝑖𝑓𝑖𝑐𝑖𝑡𝑦= 𝑇𝑁/𝑇𝑁+𝐹𝑃

#creating a function to calculate specificity
calculate_specificity <- function(df) {
  #Making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe has 'class' and 'scored.class' columns.")
  }

  #Calculating true negative (TN), false positive (FP), and specificity
  TN <- sum(df$class == 0 & df$scored.class == 0)
  FP <- sum(df$class == 0 & df$scored.class == 1)

  #Avoiding division by zero
  if (TN + FP == 0) {
    specificity <- NaN
  } else {
    specificity <- TN / (TN + FP)
  }

  return(specificity)
}

#Example usage with dataframe
specificity_result <- calculate_specificity(df1)
print(paste("Specificity:", specificity_result))
## [1] "Specificity: 0.959677419354839"

8. F1 Score

Write a function that takes the data set as a dataframe, with actual and predicted classifications identified, and returns the F1 score of the predictions.

𝐹1 𝑆𝑐𝑜𝑟𝑒= 2×𝑃𝑟𝑒𝑐𝑖𝑠𝑖𝑜𝑛×𝑆𝑒𝑛𝑠𝑖𝑡𝑖𝑣𝑖𝑡𝑦/𝑃𝑟𝑒𝑐𝑖𝑠𝑖𝑜𝑛+𝑆𝑒𝑛𝑠𝑖𝑡𝑖𝑣𝑖𝑡𝑦

#Creating a function to calculate F1 score
calculate_f1_score <- function(df) {
  #Making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe has 'class' and 'scored.class' columns.")
  }

  #Calculating true positive (TP), false positive (FP), false negative (FN), precision, recall, and F1 score
  TP <- sum(df$class == 1 & df$scored.class == 1)
  FP <- sum(df$class == 0 & df$scored.class == 1)
  FN <- sum(df$class == 1 & df$scored.class == 0)

  #Avoiding division by zero
  if (TP + FP == 0 | TP + FN == 0) {
    f1_score <- NaN
  } else {
    precision <- TP / (TP + FP)
    recall <- TP / (TP + FN)
    f1_score <- 2 * precision * recall / (precision + recall)
  }

  return(f1_score)
}

#Example usage with dataframe
f1_score_result <- calculate_f1_score(df1)
print(paste("F1 Score:", f1_score_result))
## [1] "F1 Score: 0.606741573033708"

9. F1 Bounds

Before we move on, let’s consider a question that was asked: What are the bounds on the F1 score? Show that the F1 score will always be between 0 and 1. (Hint: If 0 < 𝑎 < 1 and 0 < 𝑏 < 1 then 𝑎𝑏 < 𝑎.)

#Creating: F1 function definition
f1_function <- function(precision, sensitivity) {
  f1score <- (2 * precision * sensitivity) / (precision + sensitivity)
  return(f1score)
}

#Example: 0 precision, 0.5 sensitivity
f1_example1 <- f1_function(0, 0.5)
cat("F1 Score (0 precision, 0.5 sensitivity):", f1_example1, "\n")
## F1 Score (0 precision, 0.5 sensitivity): 0
#Example: 1 precision, 1 sensitivity
f1_example2 <- f1_function(1, 1)
cat("F1 Score (1 precision, 1 sensitivity):", f1_example2, "\n")
## F1 Score (1 precision, 1 sensitivity): 1

The F1 score is a metric that considers both precision and sensitivity, and it ranges from 0 to 1.

10. ROC curve

Write a function that generates an ROC curve from a data set with a true classification column (class in our example) and a probability column (scored.probability in our example). Your function should return a list that includes the plot of the ROC curve and a vector that contains the calculated area under the curve (AUC). Note that I recommend using a sequence of thresholds ranging from 0 to 1 at 0.01 intervals.

library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
generate_roc_curve <- function(df, true_col, prob_col) {
  #Making sure required libraries are installed
  if (!require(pROC)) {
    install.packages("pROC")
    library(pROC)
  }
  
  #Checking if the necessary columns are present in the dataframe
  if (!(true_col %in% names(df) && prob_col %in% names(df))) {
    stop("The specified columns are not present in the dataframe.")
  }
  
  #Calculating ROC curve and AUC
  roc_curve <- roc(df[[true_col]], df[[prob_col]])
  auc_value <- auc(roc_curve)
  
  #Plotting ROC curve
  plot(roc_curve, main = "ROC Curve", col = "blue", lwd = 2)
  abline(h = seq(0, 1, by = 0.1), v = seq(0, 1, by = 0.1), col = "lightgray", lty = 2)
  grid()
  
  #Returning list with plot and AUC value
  result_list <- list(ROC_Curve_Plot = roc_curve, AUC = auc_value)
  return(result_list)
}

#Example usage:

result <- generate_roc_curve(df, "class", "scored.probability")
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

print(result$AUC)
## Area under the curve: 0.8503

11. Created R functions

Use your created R functions and the provided classification output data set to produce all of the classification metrics discussed above.

# Assuming df1 is your dataframe

# Load required libraries
if (!require(knitr)) {
  install.packages("knitr")
  library(knitr)
}
## Loading required package: knitr
# Create a function to calculate all metrics
calculate_metrics <- function(df) {
  # Making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("The dataframe must have 'class' and 'scored.class' columns.")
  }

  # Calculating True Positives (TP), True Negatives (TN), False Positives (FP), False Negatives (FN)
  TP <- sum(df$class == 1 & df$scored.class == 1)
  TN <- sum(df$class == 0 & df$scored.class == 0)
  FP <- sum(df$class == 0 & df$scored.class == 1)
  FN <- sum(df$class == 1 & df$scored.class == 0)

  # Calculating metrics
  accuracy <- (TP + TN) / (TP + FP + TN + FN)
  error_rate <- mean(df$class != df$scored.class)

  precision <- if (TP + FP == 0) NaN else TP / (TP + FP)
  sensitivity <- if (TP + FN == 0) NaN else TP / (TP + FN)
  specificity <- if (TN + FP == 0) NaN else TN / (TN + FP)

  f1_score <- if ((TP + FP == 0) | (TP + FN == 0)) NaN else 2 * precision * sensitivity / (precision + sensitivity)

  # Return a named vector
  result_vector <- c(
    Accuracy = accuracy,
    `Classification Error Rate` = error_rate,
    Precision = precision,
    Sensitivity = sensitivity,
    Specificity = specificity,
    `F1 Score` = f1_score
  )

  return(result_vector)
}

# Use the calculate_metrics function with your dataframe
created_functions <- calculate_metrics(df1)

# Create a table
kable(data.frame(Metric = names(created_functions), Value = created_functions), col.names = c("Metric", "Value"))
Metric Value
Accuracy Accuracy 0.8066298
Classification Error Rate Classification Error Rate 0.1933702
Precision Precision 0.8437500
Sensitivity Sensitivity 0.4736842
Specificity Specificity 0.9596774
F1 Score F1 Score 0.6067416
#Loading required libraries "knitr"
if (!require(knitr)) {
  install.packages("knitr")
  library(knitr)
}

#Creating a function to calculate all metrics
calculate_metrics <- function(df) {
  #Just making sure the dataframe has 'class' and 'scored.class' columns
  if (!all(c("class", "scored.class") %in% colnames(df))) {
    stop("dataframe must have 'class' and 'scored.class' columns.")
  }

  #Calculating True Positives (TP), True Negatives (TN), False Positives (FP), False Negatives (FN)
  TP <- sum(df$class == 1 & df$scored.class == 1)
  TN <- sum(df$class == 0 & df$scored.class == 0)
  FP <- sum(df$class == 0 & df$scored.class == 1)
  FN <- sum(df$class == 1 & df$scored.class == 0)

  #Calculating metrics
  accuracy <- (TP + TN) / (TP + FP + TN + FN)
  error_rate <- mean(df$class != df$scored.class)

  precision <- if (TP + FP == 0) NaN else TP / (TP + FP)
  sensitivity <- if (TP + FN == 0) NaN else TP / (TP + FN)
  specificity <- if (TN + FP == 0) NaN else TN / (TN + FP)

  f1_score <- if ((TP + FP == 0) | (TP + FN == 0)) NaN else 2 * precision * sensitivity / (precision + sensitivity)

  #Returning a data frame
  result_df <- data.frame(
    Metric = c("Accuracy", "Classification Error Rate", "Precision", "Sensitivity", "Specificity", "F1 Score"),
    Value = c(accuracy, error_rate, precision, sensitivity, specificity, f1_score)
  )

  return(result_df)
}

#Using the calculate_metrics function with your dataframe
result_table <- calculate_metrics(df1)

#Printing the table that displays metrics
kable(result_table, col.names = c("Metric", "Value"))
Metric Value
Accuracy 0.8066298
Classification Error Rate 0.1933702
Precision 0.8437500
Sensitivity 0.4736842
Specificity 0.9596774
F1 Score 0.6067416

12. Caret Package

Investigate the caret package. In particular, consider the functions confusionMatrix, sensitivity, and specificity. Apply the functions to the data set. How do the results compare with your own functions?

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
cm <- confusionMatrix(data = as.factor(df$scored.class), 
                      reference = as.factor(df$class), 
                      positive = "1")
cm
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 119  30
##          1   5  27
##                                           
##                Accuracy : 0.8066          
##                  95% CI : (0.7415, 0.8615)
##     No Information Rate : 0.6851          
##     P-Value [Acc > NIR] : 0.0001712       
##                                           
##                   Kappa : 0.4916          
##                                           
##  Mcnemar's Test P-Value : 4.976e-05       
##                                           
##             Sensitivity : 0.4737          
##             Specificity : 0.9597          
##          Pos Pred Value : 0.8438          
##          Neg Pred Value : 0.7987          
##              Prevalence : 0.3149          
##          Detection Rate : 0.1492          
##    Detection Prevalence : 0.1768          
##       Balanced Accuracy : 0.7167          
##                                           
##        'Positive' Class : 1               
## 

13. pROC package

Investigate the pROC package. Use it to generate an ROC curve for the data set. How do the results compare with your own functions?

library(pROC)

#Assuming data frame with 'class' and 'scored.probability' columns
roc_obj <- roc(df$class, df$scored.probability)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
auc_val <- auc(roc_obj)

par(mfrow = c(1, 2), pty = 's')

#Plotting ROC curve using pROC package
plot(roc_obj, print.auc = TRUE, main = 'ROC Curve - pROC Package')

#Displaying AUC value
cat("AUC (pROC Package):", auc_val, "\n")
## AUC (pROC Package): 0.8503113

LS0tDQp0aXRsZTogIkRhdGEgNjIxIEhvbWV3b3JrIDIiDQphdXRob3I6ICJVbGlhbmEgUGxvdG5pa292YSwgUmVuaWRhIEthc2EsIExhdXJhIFB1ZWJsYSINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KIyMgT3ZlcnZpZXcNCkluIHRoaXMgaG9tZXdvcmsgYXNzaWdubWVudCwgeW91IHdpbGwgd29yayB0aHJvdWdoIHZhcmlvdXMgY2xhc3NpZmljYXRpb24gbWV0cmljcy4gWW91IHdpbGwgYmUgYXNrZWQgdG8gY3JlYXRlDQpmdW5jdGlvbnMgaW4gUiB0byBjYXJyeSBvdXQgdGhlIHZhcmlvdXMgY2FsY3VsYXRpb25zLiBZb3Ugd2lsbCBhbHNvIGludmVzdGlnYXRlIHNvbWUgZnVuY3Rpb25zIGluIHBhY2thZ2VzIHRoYXQgd2lsbCBsZXQNCnlvdSBvYnRhaW4gdGhlIGVxdWl2YWxlbnQgcmVzdWx0cy4gRmluYWxseSwgeW91IHdpbGwgY3JlYXRlIGdyYXBoaWNhbCBvdXRwdXQgdGhhdCBhbHNvIGNhbiBiZSB1c2VkIHRvIGV2YWx1YXRlIHRoZQ0Kb3V0cHV0IG9mIGNsYXNzaWZpY2F0aW9uIG1vZGVscywgc3VjaCBhcyBiaW5hcnkgbG9naXN0aWMgcmVncmVzc2lvbg0KDQojIyAxLiBMb2FkaW5nIGRhdGFzZXQNCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShkcGx5cikNCg0KYGBgDQoNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoJ2h0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9sYnVyZW5rb3YvY2xhc3NpZmljYXRpb24tb3V0cHV0L21haW4vY2xhc3NpZmljYXRpb24tb3V0cHV0LWRhdGEuY3N2JykNCmBgYA0KDQoNCiMjIERhdGEgZXhwbG9yYXRpb24NCg0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0KYGBgDQojIyAyLiBUaGUgZGF0YSBzZXQgaGFzIHRocmVlIGtleSBjb2x1bW5zDQpUaGUgZGF0YSBzZXQgaGFzIHRocmVlIGtleSBjb2x1bW5zIHdlIHdpbGwgdXNlOg0KY2xhc3M6IHRoZSBhY3R1YWwgY2xhc3MgZm9yIHRoZSBvYnNlcnZhdGlvbg0Kc2NvcmVkLmNsYXNzOiB0aGUgcHJlZGljdGVkIGNsYXNzIGZvciB0aGUgb2JzZXJ2YXRpb24gKGJhc2VkIG9uIGEgdGhyZXNob2xkIG9mIDAuNSkNCnNjb3JlZC5wcm9iYWJpbGl0eTogdGhlIHByZWRpY3RlZCBwcm9iYWJpbGl0eSBvZiBzdWNjZXNzIGZvciB0aGUgb2JzZXJ2YXRpb24NClVzZSB0aGUgdGFibGUoKSBmdW5jdGlvbiB0byBnZXQgdGhlIHJhdyBjb25mdXNpb24gbWF0cml4IGZvciB0aGlzIHNjb3JlZCBkYXRhc2V0LiBNYWtlIHN1cmUgeW91IHVuZGVyc3RhbmQgdGhlIG91dHB1dC4gSW4gcGFydGljdWxhciwgZG8gdGhlIHJvd3MgcmVwcmVzZW50IHRoZSBhY3R1YWwgb3IgcHJlZGljdGVkIGNsYXNzPyBUaGUgY29sdW1ucz8NCg0KYGBge3J9DQpkZjEgPC0gZGYgJT4lIA0KICBzZWxlY3QoY2xhc3MsIHNjb3JlZC5jbGFzcywgc2NvcmVkLnByb2JhYmlsaXR5KQ0KZGYxDQpgYGANCg0KVXNlIHRoZSB0YWJsZSgpIGZ1bmN0aW9uIHRvIGdldCB0aGUgcmF3IGNvbmZ1c2lvbiBtYXRyaXggZm9yIHRoaXMgc2NvcmVkIGRhdGFzZXQuIE1ha2Ugc3VyZSB5b3UgdW5kZXJzdGFuZCB0aGUgb3V0cHV0LiBJbiBwYXJ0aWN1bGFyLCBkbyB0aGUgcm93cyByZXByZXNlbnQgdGhlIGFjdHVhbCBvciBwcmVkaWN0ZWQgY2xhc3M/IFRoZSBjb2x1bW5zPw0KDQpgYGB7cn0NCmRmMSAlPiUgDQogIHNlbGVjdChjbGFzcywgc2NvcmVkLmNsYXNzKSAlPiUNCiAgbXV0YXRlKGNsYXNzID0gcmVjb2RlKGNsYXNzLA0KICAgICAgICAgICAgICAgICAgICAgICAgJzAnID0gJ0FjdHVhbCBOZWdhdGl2ZScsIA0KICAgICAgICAgICAgICAgICAgICAgICAgJzEnID0gJ0FjdHVhbCBQb3NpdGl2ZScpLA0KICAgICAgICAgc2NvcmVkLmNsYXNzID0gcmVjb2RlKHNjb3JlZC5jbGFzcywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnMCcgPSAnUHJlZGljdGVkIE5lZ2F0aXZlJywgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJzEnID0gJ1ByZWRpY3RlZCBQb3NpdGl2ZScpKSAlPiUNCiAgdGFibGUoKQ0KYGBgDQoNCiMjIDMuIEFjY3VyYWN5DQoNCldyaXRlIGEgZnVuY3Rpb24gdGhhdCB0YWtlcyB0aGUgZGF0YSBzZXQgYXMgYSBkYXRhZnJhbWUsIHdpdGggYWN0dWFsIGFuZCBwcmVkaWN0ZWQgY2xhc3NpZmljYXRpb25zIGlkZW50aWZpZWQsIGFuZCByZXR1cm5zIHRoZSBhY2N1cmFjeSBvZiB0aGUgcHJlZGljdGlvbnMuDQoNCvCdkLTwnZGQ8J2RkPCdkaLwnZGf8J2RjvCdkZDwnZGmPSDwnZGH8J2RgyvwnZGH8J2RgS/wnZGH8J2RgyvwnZC58J2RgyvwnZGH8J2RgSvwnZC58J2RgQ0KDQpgYGB7cn0NCiNDcmVhdGluZyBhIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSBhY2N1cmFjeQ0KY2FsY3VsYXRlX2FjY3VyYWN5IDwtIGZ1bmN0aW9uKGRmKSB7DQogICNNYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoIlRoZSBkYXRhZnJhbWUgbXVzdCBoYXZlICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICNDYWxjdWxhdGluZyBUcnVlIFBvc2l0aXZlcyAoVFApLCBUcnVlIE5lZ2F0aXZlcyAoVE4pLCBGYWxzZSBQb3NpdGl2ZXMgKEZQKSwgRmFsc2UgTmVnYXRpdmVzIChGTikNCiAgVFAgPC0gc3VtKGRmJGNsYXNzID09IDEgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCiAgVE4gPC0gc3VtKGRmJGNsYXNzID09IDAgJiBkZiRzY29yZWQuY2xhc3MgPT0gMCkNCiAgRlAgPC0gc3VtKGRmJGNsYXNzID09IDAgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCiAgRk4gPC0gc3VtKGRmJGNsYXNzID09IDEgJiBkZiRzY29yZWQuY2xhc3MgPT0gMCkNCg0KICAjQ2FsY3VsYXRpbmcgYWNjdXJhY3kNCiAgYWNjdXJhY3kgPC0gKFRQICsgVE4pIC8gKFRQICsgRlAgKyBUTiArIEZOKQ0KDQogIHJldHVybihhY2N1cmFjeSkNCn0NCg0KI1VzaW5nIHRoZSBjYWxjdWxhdGVfYWNjdXJhY3kgZnVuY3Rpb24gd2l0aCBkYXRhZnJhbWUNCmFjY3VyYWN5X3Jlc3VsdCA8LSBjYWxjdWxhdGVfYWNjdXJhY3koZGYxKQ0KcHJpbnQocGFzdGUoIkFjY3VyYWN5OiIsIGFjY3VyYWN5X3Jlc3VsdCkpDQoNCmBgYA0KIyMgNC4gRXJyb3INCg0KV3JpdGUgYSBmdW5jdGlvbiB0aGF0IHRha2VzIHRoZSBkYXRhIHNldCBhcyBhIGRhdGFmcmFtZSwgd2l0aCBhY3R1YWwgYW5kIHByZWRpY3RlZCBjbGFzc2lmaWNhdGlvbnMgaWRlbnRpZmllZCwgYW5kIHJldHVybnMgdGhlIGNsYXNzaWZpY2F0aW9uIGVycm9yIHJhdGUgb2YgdGhlIHByZWRpY3Rpb25zLg0KDQrwnZC28J2RmfCdkY7wnZGg8J2RoPCdkZbwnZGT8J2RlvCdkZDwnZGO8J2RofCdkZbwnZGc8J2RmyDwnZC48J2Rn/CdkZ/wnZGc8J2RnyDwnZGF8J2RjvCdkaHwnZGSPSDwnZC58J2RgyvwnZC58J2RgfCdkYfwnZGDK/CdkLnwnZGDK/CdkYfwnZGBK/CdkLnwnZGBDQoNClZlcmlmeSB0aGF0IHlvdSBnZXQgYW4gYWNjdXJhY3kgYW5kIGFuIGVycm9yIHJhdGUgdGhhdCBzdW1zIHRvIG9uZS4NCg0KYGBge3J9DQojQ3JlYXRpbmcgYSBmdW5jdGlvbiB0byBjYWxjdWxhdGUgY2xhc3NpZmljYXRpb24gZXJyb3IgcmF0ZQ0KY2FsY3VsYXRlX2Vycm9yX3JhdGUgPC0gZnVuY3Rpb24oZGYpIHsNCiAgI0RhdGFmcmFtZSBoYXMgJ2NsYXNzJyBhbmQgJ3Njb3JlZC5jbGFzcycgY29sdW1ucw0KICBpZiAoIWFsbChjKCJjbGFzcyIsICJzY29yZWQuY2xhc3MiKSAlaW4lIGNvbG5hbWVzKGRmKSkpIHsNCiAgICBzdG9wKCJUaGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zLiIpDQogIH0NCg0KICAjQ2FsY3VsYXRpbmcgdGhlIGNsYXNzaWZpY2F0aW9uIGVycm9yIHJhdGUNCiAgZXJyb3JfcmF0ZSA8LSBtZWFuKGRmJGNsYXNzICE9IGRmJHNjb3JlZC5jbGFzcykNCg0KICByZXR1cm4oZXJyb3JfcmF0ZSkNCn0NCg0KI0V4YW1wbGUgdXNhZ2Ugd2l0aCBkYXRhZnJhbWUNCmVycm9yX3JhdGVfcmVzdWx0IDwtIGNhbGN1bGF0ZV9lcnJvcl9yYXRlKGRmMSkNCnByaW50KHBhc3RlKCJDbGFzc2lmaWNhdGlvbiBFcnJvciBSYXRlOiIsIGVycm9yX3JhdGVfcmVzdWx0KSkNCg0KYGBgDQoNCiMjIDUuIFByZWNpc2lvbg0KDQpXcml0ZSBhIGZ1bmN0aW9uIHRoYXQgdGFrZXMgdGhlIGRhdGEgc2V0IGFzIGEgZGF0YWZyYW1lLCB3aXRoIGFjdHVhbCBhbmQgcHJlZGljdGVkIGNsYXNzaWZpY2F0aW9ucyBpZGVudGlmaWVkLCBhbmQgcmV0dXJucyB0aGUgcHJlY2lzaW9uIG9mIHRoZSBwcmVkaWN0aW9ucy4NCg0K8J2Rg/CdkZ/wnZGS8J2RkPCdkZbwnZGg8J2RlvCdkZzwnZGbPSDwnZGHL/CdkYPwnZGH8J2RgyvwnZC58J2Rgw0KDQpgYGB7cn0NCiNDcmVhdGluZyBhIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSBwcmVjaXNpb24NCmNhbGN1bGF0ZV9wcmVjaXNpb24gPC0gZnVuY3Rpb24oZGYpIHsNCiAgI2RhdGFmcmFtZSBoYXMgJ2NsYXNzJyBhbmQgJ3Njb3JlZC5jbGFzcycgY29sdW1ucw0KICBpZiAoIWFsbChjKCJjbGFzcyIsICJzY29yZWQuY2xhc3MiKSAlaW4lIGNvbG5hbWVzKGRmKSkpIHsNCiAgICBzdG9wKCJkYXRhZnJhbWUgaGFzICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICNDYWxjdWxhdGluZyB0cnVlIHBvc2l0aXZlIChUUCksIGZhbHNlIHBvc2l0aXZlIChGUCksIGFuZCBwcmVjaXNpb24NCiAgVFAgPC0gc3VtKGRmJGNsYXNzID09IDEgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCiAgRlAgPC0gc3VtKGRmJGNsYXNzID09IDAgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCg0KICAjQXZvaWRpbmcgZGl2aXNpb24gYnkgemVybw0KICBpZiAoVFAgKyBGUCA9PSAwKSB7DQogICAgcHJlY2lzaW9uIDwtIE5hTg0KICB9IGVsc2Ugew0KICAgIHByZWNpc2lvbiA8LSBUUCAvIChUUCArIEZQKQ0KICB9DQoNCiAgcmV0dXJuKHByZWNpc2lvbikNCn0NCg0KIyBFeGFtcGxlIHVzYWdlIHdpdGggZGF0YWZyYW1lDQpwcmVjaXNpb25fcmVzdWx0IDwtIGNhbGN1bGF0ZV9wcmVjaXNpb24oZGYxKQ0KcHJpbnQocGFzdGUoIlByZWNpc2lvbjoiLCBwcmVjaXNpb25fcmVzdWx0KSkNCg0KYGBgDQoNCiMjIDYuIFNlbnNpdGl2aXR5DQoNCldyaXRlIGEgZnVuY3Rpb24gdGhhdCB0YWtlcyB0aGUgZGF0YSBzZXQgYXMgYSBkYXRhZnJhbWUsIHdpdGggYWN0dWFsIGFuZCBwcmVkaWN0ZWQgY2xhc3NpZmljYXRpb25zIGlkZW50aWZpZWQsIGFuZCByZXR1cm5zIHRoZSBzZW5zaXRpdml0eSBvZiB0aGUgcHJlZGljdGlvbnMuIFNlbnNpdGl2aXR5IGlzIGFsc28ga25vd24gYXMgcmVjYWxsLg0KDQrwnZGG8J2RkvCdkZvwnZGg8J2RlvCdkaHwnZGW8J2Ro/CdkZbwnZGh8J2Rpj0g8J2Rh/CdkYMv8J2Rh/CdkYMr8J2QufCdkYENCg0KYGBge3J9DQojQ3JlYXRpbmcgYSB1bmN0aW9uIHRvIGNhbGN1bGF0ZSBzZW5zaXRpdml0eSAocmVjYWxsKQ0KY2FsY3VsYXRlX3NlbnNpdGl2aXR5IDwtIGZ1bmN0aW9uKGRmKSB7DQogICNNYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoIlRoZSBkYXRhZnJhbWUgaGFzICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICNDYWxjdWxhdGluZyB0cnVlIHBvc2l0aXZlIChUUCksIGZhbHNlIG5lZ2F0aXZlIChGTiksIGFuZCBzZW5zaXRpdml0eQ0KICBUUCA8LSBzdW0oZGYkY2xhc3MgPT0gMSAmIGRmJHNjb3JlZC5jbGFzcyA9PSAxKQ0KICBGTiA8LSBzdW0oZGYkY2xhc3MgPT0gMSAmIGRmJHNjb3JlZC5jbGFzcyA9PSAwKQ0KDQogICNBdm9pZGluZyBkaXZpc2lvbiBieSB6ZXJvDQogIGlmIChUUCArIEZOID09IDApIHsNCiAgICBzZW5zaXRpdml0eSA8LSBOYU4NCiAgfSBlbHNlIHsNCiAgICBzZW5zaXRpdml0eSA8LSBUUCAvIChUUCArIEZOKQ0KICB9DQoNCiAgcmV0dXJuKHNlbnNpdGl2aXR5KQ0KfQ0KDQojRXhhbXBsZSB1c2FnZSB3aXRoIGRhdGFmcmFtZQ0Kc2Vuc2l0aXZpdHlfcmVzdWx0IDwtIGNhbGN1bGF0ZV9zZW5zaXRpdml0eShkZjEpDQpwcmludChwYXN0ZSgiU2Vuc2l0aXZpdHkgKFJlY2FsbCk6Iiwgc2Vuc2l0aXZpdHlfcmVzdWx0KSkNCg0KYGBgDQoNCiMjIDcuIFNwZWNpZmljaXR5DQoNCldyaXRlIGEgZnVuY3Rpb24gdGhhdCB0YWtlcyB0aGUgZGF0YSBzZXQgYXMgYSBkYXRhZnJhbWUsIHdpdGggYWN0dWFsIGFuZCBwcmVkaWN0ZWQgY2xhc3NpZmljYXRpb25zIGlkZW50aWZpZWQsIGFuZCByZXR1cm5zIHRoZSBzcGVjaWZpY2l0eSBvZiB0aGUgcHJlZGljdGlvbnMuDQoNCvCdkYbwnZGd8J2RkvCdkZDwnZGW8J2Rk/CdkZbwnZGQ8J2RlvCdkaHwnZGmPSDwnZGH8J2RgS/wnZGH8J2RgSvwnZC58J2Rgw0KDQpgYGB7cn0NCiNjcmVhdGluZyBhIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSBzcGVjaWZpY2l0eQ0KY2FsY3VsYXRlX3NwZWNpZmljaXR5IDwtIGZ1bmN0aW9uKGRmKSB7DQogICNNYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoIlRoZSBkYXRhZnJhbWUgaGFzICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICNDYWxjdWxhdGluZyB0cnVlIG5lZ2F0aXZlIChUTiksIGZhbHNlIHBvc2l0aXZlIChGUCksIGFuZCBzcGVjaWZpY2l0eQ0KICBUTiA8LSBzdW0oZGYkY2xhc3MgPT0gMCAmIGRmJHNjb3JlZC5jbGFzcyA9PSAwKQ0KICBGUCA8LSBzdW0oZGYkY2xhc3MgPT0gMCAmIGRmJHNjb3JlZC5jbGFzcyA9PSAxKQ0KDQogICNBdm9pZGluZyBkaXZpc2lvbiBieSB6ZXJvDQogIGlmIChUTiArIEZQID09IDApIHsNCiAgICBzcGVjaWZpY2l0eSA8LSBOYU4NCiAgfSBlbHNlIHsNCiAgICBzcGVjaWZpY2l0eSA8LSBUTiAvIChUTiArIEZQKQ0KICB9DQoNCiAgcmV0dXJuKHNwZWNpZmljaXR5KQ0KfQ0KDQojRXhhbXBsZSB1c2FnZSB3aXRoIGRhdGFmcmFtZQ0Kc3BlY2lmaWNpdHlfcmVzdWx0IDwtIGNhbGN1bGF0ZV9zcGVjaWZpY2l0eShkZjEpDQpwcmludChwYXN0ZSgiU3BlY2lmaWNpdHk6Iiwgc3BlY2lmaWNpdHlfcmVzdWx0KSkNCg0KYGBgDQoNCiMjIDguIEYxIFNjb3JlDQoNCldyaXRlIGEgZnVuY3Rpb24gdGhhdCB0YWtlcyB0aGUgZGF0YSBzZXQgYXMgYSBkYXRhZnJhbWUsIHdpdGggYWN0dWFsIGFuZCBwcmVkaWN0ZWQgY2xhc3NpZmljYXRpb25zIGlkZW50aWZpZWQsIGFuZCByZXR1cm5zIHRoZSBGMSBzY29yZSBvZiB0aGUgcHJlZGljdGlvbnMuDQoNCvCdkLkxIPCdkYbwnZGQ8J2RnPCdkZ/wnZGSPSAyw5fwnZGD8J2Rn/CdkZLwnZGQ8J2RlvCdkaDwnZGW8J2RnPCdkZvDl/CdkYbwnZGS8J2Rm/CdkaDwnZGW8J2RofCdkZbwnZGj8J2RlvCdkaHwnZGmL/CdkYPwnZGf8J2RkvCdkZDwnZGW8J2RoPCdkZbwnZGc8J2RmyvwnZGG8J2RkvCdkZvwnZGg8J2RlvCdkaHwnZGW8J2Ro/CdkZbwnZGh8J2Rpg0KDQpgYGB7cn0NCiNDcmVhdGluZyBhIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSBGMSBzY29yZQ0KY2FsY3VsYXRlX2YxX3Njb3JlIDwtIGZ1bmN0aW9uKGRmKSB7DQogICNNYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoIlRoZSBkYXRhZnJhbWUgaGFzICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICNDYWxjdWxhdGluZyB0cnVlIHBvc2l0aXZlIChUUCksIGZhbHNlIHBvc2l0aXZlIChGUCksIGZhbHNlIG5lZ2F0aXZlIChGTiksIHByZWNpc2lvbiwgcmVjYWxsLCBhbmQgRjEgc2NvcmUNCiAgVFAgPC0gc3VtKGRmJGNsYXNzID09IDEgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCiAgRlAgPC0gc3VtKGRmJGNsYXNzID09IDAgJiBkZiRzY29yZWQuY2xhc3MgPT0gMSkNCiAgRk4gPC0gc3VtKGRmJGNsYXNzID09IDEgJiBkZiRzY29yZWQuY2xhc3MgPT0gMCkNCg0KICAjQXZvaWRpbmcgZGl2aXNpb24gYnkgemVybw0KICBpZiAoVFAgKyBGUCA9PSAwIHwgVFAgKyBGTiA9PSAwKSB7DQogICAgZjFfc2NvcmUgPC0gTmFODQogIH0gZWxzZSB7DQogICAgcHJlY2lzaW9uIDwtIFRQIC8gKFRQICsgRlApDQogICAgcmVjYWxsIDwtIFRQIC8gKFRQICsgRk4pDQogICAgZjFfc2NvcmUgPC0gMiAqIHByZWNpc2lvbiAqIHJlY2FsbCAvIChwcmVjaXNpb24gKyByZWNhbGwpDQogIH0NCg0KICByZXR1cm4oZjFfc2NvcmUpDQp9DQoNCiNFeGFtcGxlIHVzYWdlIHdpdGggZGF0YWZyYW1lDQpmMV9zY29yZV9yZXN1bHQgPC0gY2FsY3VsYXRlX2YxX3Njb3JlKGRmMSkNCnByaW50KHBhc3RlKCJGMSBTY29yZToiLCBmMV9zY29yZV9yZXN1bHQpKQ0KDQpgYGANCg0KIyMgOS4gRjEgQm91bmRzDQoNCkJlZm9yZSB3ZSBtb3ZlIG9uLCBsZXTigJlzIGNvbnNpZGVyIGEgcXVlc3Rpb24gdGhhdCB3YXMgYXNrZWQ6IFdoYXQgYXJlIHRoZSBib3VuZHMgb24gdGhlIEYxIHNjb3JlPyBTaG93IHRoYXQgdGhlIEYxIHNjb3JlIHdpbGwgYWx3YXlzIGJlIGJldHdlZW4gMCBhbmQgMS4gKEhpbnQ6IElmIDAgPCDwnZGOIDwgMSBhbmQgMCA8IPCdkY8gPCAxIHRoZW4g8J2RjvCdkY8gPCDwnZGOLikNCg0KDQpgYGB7cn0NCiNDcmVhdGluZzogRjEgZnVuY3Rpb24gZGVmaW5pdGlvbg0KZjFfZnVuY3Rpb24gPC0gZnVuY3Rpb24ocHJlY2lzaW9uLCBzZW5zaXRpdml0eSkgew0KICBmMXNjb3JlIDwtICgyICogcHJlY2lzaW9uICogc2Vuc2l0aXZpdHkpIC8gKHByZWNpc2lvbiArIHNlbnNpdGl2aXR5KQ0KICByZXR1cm4oZjFzY29yZSkNCn0NCg0KI0V4YW1wbGU6IDAgcHJlY2lzaW9uLCAwLjUgc2Vuc2l0aXZpdHkNCmYxX2V4YW1wbGUxIDwtIGYxX2Z1bmN0aW9uKDAsIDAuNSkNCmNhdCgiRjEgU2NvcmUgKDAgcHJlY2lzaW9uLCAwLjUgc2Vuc2l0aXZpdHkpOiIsIGYxX2V4YW1wbGUxLCAiXG4iKQ0KDQojRXhhbXBsZTogMSBwcmVjaXNpb24sIDEgc2Vuc2l0aXZpdHkNCmYxX2V4YW1wbGUyIDwtIGYxX2Z1bmN0aW9uKDEsIDEpDQpjYXQoIkYxIFNjb3JlICgxIHByZWNpc2lvbiwgMSBzZW5zaXRpdml0eSk6IiwgZjFfZXhhbXBsZTIsICJcbiIpDQoNCmBgYA0KVGhlIEYxIHNjb3JlIGlzIGEgbWV0cmljIHRoYXQgY29uc2lkZXJzIGJvdGggcHJlY2lzaW9uIGFuZCBzZW5zaXRpdml0eSwgYW5kIGl0IHJhbmdlcyBmcm9tIDAgdG8gMS4NCg0KIyMgMTAuIFJPQyBjdXJ2ZQ0KDQpXcml0ZSBhIGZ1bmN0aW9uIHRoYXQgZ2VuZXJhdGVzIGFuIFJPQyBjdXJ2ZSBmcm9tIGEgZGF0YSBzZXQgd2l0aCBhIHRydWUgY2xhc3NpZmljYXRpb24gY29sdW1uIChjbGFzcyBpbiBvdXIgZXhhbXBsZSkgYW5kIGEgcHJvYmFiaWxpdHkgY29sdW1uIChzY29yZWQucHJvYmFiaWxpdHkgaW4gb3VyIGV4YW1wbGUpLiBZb3VyIGZ1bmN0aW9uIHNob3VsZCByZXR1cm4gYSBsaXN0IHRoYXQgaW5jbHVkZXMgdGhlIHBsb3Qgb2YgdGhlIFJPQyBjdXJ2ZSBhbmQgYSB2ZWN0b3IgdGhhdCBjb250YWlucyB0aGUgY2FsY3VsYXRlZCBhcmVhIHVuZGVyIHRoZSBjdXJ2ZSAoQVVDKS4gTm90ZSB0aGF0IEkgcmVjb21tZW5kIHVzaW5nIGEgc2VxdWVuY2Ugb2YgdGhyZXNob2xkcyByYW5naW5nIGZyb20gMCB0byAxIGF0IDAuMDEgaW50ZXJ2YWxzLg0KDQoNCmBgYHtyfQ0KDQpsaWJyYXJ5KHBST0MpDQoNCmdlbmVyYXRlX3JvY19jdXJ2ZSA8LSBmdW5jdGlvbihkZiwgdHJ1ZV9jb2wsIHByb2JfY29sKSB7DQogICNNYWtpbmcgc3VyZSByZXF1aXJlZCBsaWJyYXJpZXMgYXJlIGluc3RhbGxlZA0KICBpZiAoIXJlcXVpcmUocFJPQykpIHsNCiAgICBpbnN0YWxsLnBhY2thZ2VzKCJwUk9DIikNCiAgICBsaWJyYXJ5KHBST0MpDQogIH0NCiAgDQogICNDaGVja2luZyBpZiB0aGUgbmVjZXNzYXJ5IGNvbHVtbnMgYXJlIHByZXNlbnQgaW4gdGhlIGRhdGFmcmFtZQ0KICBpZiAoISh0cnVlX2NvbCAlaW4lIG5hbWVzKGRmKSAmJiBwcm9iX2NvbCAlaW4lIG5hbWVzKGRmKSkpIHsNCiAgICBzdG9wKCJUaGUgc3BlY2lmaWVkIGNvbHVtbnMgYXJlIG5vdCBwcmVzZW50IGluIHRoZSBkYXRhZnJhbWUuIikNCiAgfQ0KICANCiAgI0NhbGN1bGF0aW5nIFJPQyBjdXJ2ZSBhbmQgQVVDDQogIHJvY19jdXJ2ZSA8LSByb2MoZGZbW3RydWVfY29sXV0sIGRmW1twcm9iX2NvbF1dKQ0KICBhdWNfdmFsdWUgPC0gYXVjKHJvY19jdXJ2ZSkNCiAgDQogICNQbG90dGluZyBST0MgY3VydmUNCiAgcGxvdChyb2NfY3VydmUsIG1haW4gPSAiUk9DIEN1cnZlIiwgY29sID0gImJsdWUiLCBsd2QgPSAyKQ0KICBhYmxpbmUoaCA9IHNlcSgwLCAxLCBieSA9IDAuMSksIHYgPSBzZXEoMCwgMSwgYnkgPSAwLjEpLCBjb2wgPSAibGlnaHRncmF5IiwgbHR5ID0gMikNCiAgZ3JpZCgpDQogIA0KICAjUmV0dXJuaW5nIGxpc3Qgd2l0aCBwbG90IGFuZCBBVUMgdmFsdWUNCiAgcmVzdWx0X2xpc3QgPC0gbGlzdChST0NfQ3VydmVfUGxvdCA9IHJvY19jdXJ2ZSwgQVVDID0gYXVjX3ZhbHVlKQ0KICByZXR1cm4ocmVzdWx0X2xpc3QpDQp9DQoNCiNFeGFtcGxlIHVzYWdlOg0KDQpyZXN1bHQgPC0gZ2VuZXJhdGVfcm9jX2N1cnZlKGRmLCAiY2xhc3MiLCAic2NvcmVkLnByb2JhYmlsaXR5IikNCnByaW50KHJlc3VsdCRBVUMpDQoNCmBgYA0KDQoNCiMjIDExLiBDcmVhdGVkIFIgZnVuY3Rpb25zDQoNClVzZSB5b3VyIGNyZWF0ZWQgUiBmdW5jdGlvbnMgYW5kIHRoZSBwcm92aWRlZCBjbGFzc2lmaWNhdGlvbiBvdXRwdXQgZGF0YSBzZXQgdG8gcHJvZHVjZSBhbGwgb2YgdGhlIGNsYXNzaWZpY2F0aW9uIG1ldHJpY3MgZGlzY3Vzc2VkIGFib3ZlLg0KDQpgYGB7cn0NCiMgQXNzdW1pbmcgZGYxIGlzIHlvdXIgZGF0YWZyYW1lDQoNCiMgTG9hZCByZXF1aXJlZCBsaWJyYXJpZXMNCmlmICghcmVxdWlyZShrbml0cikpIHsNCiAgaW5zdGFsbC5wYWNrYWdlcygia25pdHIiKQ0KICBsaWJyYXJ5KGtuaXRyKQ0KfQ0KDQojIENyZWF0ZSBhIGZ1bmN0aW9uIHRvIGNhbGN1bGF0ZSBhbGwgbWV0cmljcw0KY2FsY3VsYXRlX21ldHJpY3MgPC0gZnVuY3Rpb24oZGYpIHsNCiAgIyBNYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoIlRoZSBkYXRhZnJhbWUgbXVzdCBoYXZlICdjbGFzcycgYW5kICdzY29yZWQuY2xhc3MnIGNvbHVtbnMuIikNCiAgfQ0KDQogICMgQ2FsY3VsYXRpbmcgVHJ1ZSBQb3NpdGl2ZXMgKFRQKSwgVHJ1ZSBOZWdhdGl2ZXMgKFROKSwgRmFsc2UgUG9zaXRpdmVzIChGUCksIEZhbHNlIE5lZ2F0aXZlcyAoRk4pDQogIFRQIDwtIHN1bShkZiRjbGFzcyA9PSAxICYgZGYkc2NvcmVkLmNsYXNzID09IDEpDQogIFROIDwtIHN1bShkZiRjbGFzcyA9PSAwICYgZGYkc2NvcmVkLmNsYXNzID09IDApDQogIEZQIDwtIHN1bShkZiRjbGFzcyA9PSAwICYgZGYkc2NvcmVkLmNsYXNzID09IDEpDQogIEZOIDwtIHN1bShkZiRjbGFzcyA9PSAxICYgZGYkc2NvcmVkLmNsYXNzID09IDApDQoNCiAgIyBDYWxjdWxhdGluZyBtZXRyaWNzDQogIGFjY3VyYWN5IDwtIChUUCArIFROKSAvIChUUCArIEZQICsgVE4gKyBGTikNCiAgZXJyb3JfcmF0ZSA8LSBtZWFuKGRmJGNsYXNzICE9IGRmJHNjb3JlZC5jbGFzcykNCg0KICBwcmVjaXNpb24gPC0gaWYgKFRQICsgRlAgPT0gMCkgTmFOIGVsc2UgVFAgLyAoVFAgKyBGUCkNCiAgc2Vuc2l0aXZpdHkgPC0gaWYgKFRQICsgRk4gPT0gMCkgTmFOIGVsc2UgVFAgLyAoVFAgKyBGTikNCiAgc3BlY2lmaWNpdHkgPC0gaWYgKFROICsgRlAgPT0gMCkgTmFOIGVsc2UgVE4gLyAoVE4gKyBGUCkNCg0KICBmMV9zY29yZSA8LSBpZiAoKFRQICsgRlAgPT0gMCkgfCAoVFAgKyBGTiA9PSAwKSkgTmFOIGVsc2UgMiAqIHByZWNpc2lvbiAqIHNlbnNpdGl2aXR5IC8gKHByZWNpc2lvbiArIHNlbnNpdGl2aXR5KQ0KDQogICMgUmV0dXJuIGEgbmFtZWQgdmVjdG9yDQogIHJlc3VsdF92ZWN0b3IgPC0gYygNCiAgICBBY2N1cmFjeSA9IGFjY3VyYWN5LA0KICAgIGBDbGFzc2lmaWNhdGlvbiBFcnJvciBSYXRlYCA9IGVycm9yX3JhdGUsDQogICAgUHJlY2lzaW9uID0gcHJlY2lzaW9uLA0KICAgIFNlbnNpdGl2aXR5ID0gc2Vuc2l0aXZpdHksDQogICAgU3BlY2lmaWNpdHkgPSBzcGVjaWZpY2l0eSwNCiAgICBgRjEgU2NvcmVgID0gZjFfc2NvcmUNCiAgKQ0KDQogIHJldHVybihyZXN1bHRfdmVjdG9yKQ0KfQ0KDQojIFVzZSB0aGUgY2FsY3VsYXRlX21ldHJpY3MgZnVuY3Rpb24gd2l0aCB5b3VyIGRhdGFmcmFtZQ0KY3JlYXRlZF9mdW5jdGlvbnMgPC0gY2FsY3VsYXRlX21ldHJpY3MoZGYxKQ0KDQojIENyZWF0ZSBhIHRhYmxlDQprYWJsZShkYXRhLmZyYW1lKE1ldHJpYyA9IG5hbWVzKGNyZWF0ZWRfZnVuY3Rpb25zKSwgVmFsdWUgPSBjcmVhdGVkX2Z1bmN0aW9ucyksIGNvbC5uYW1lcyA9IGMoIk1ldHJpYyIsICJWYWx1ZSIpKQ0KDQoNCmBgYA0KDQpgYGB7cn0NCiNMb2FkaW5nIHJlcXVpcmVkIGxpYnJhcmllcyAia25pdHIiDQppZiAoIXJlcXVpcmUoa25pdHIpKSB7DQogIGluc3RhbGwucGFja2FnZXMoImtuaXRyIikNCiAgbGlicmFyeShrbml0cikNCn0NCg0KI0NyZWF0aW5nIGEgZnVuY3Rpb24gdG8gY2FsY3VsYXRlIGFsbCBtZXRyaWNzDQpjYWxjdWxhdGVfbWV0cmljcyA8LSBmdW5jdGlvbihkZikgew0KICAjSnVzdCBtYWtpbmcgc3VyZSB0aGUgZGF0YWZyYW1lIGhhcyAnY2xhc3MnIGFuZCAnc2NvcmVkLmNsYXNzJyBjb2x1bW5zDQogIGlmICghYWxsKGMoImNsYXNzIiwgInNjb3JlZC5jbGFzcyIpICVpbiUgY29sbmFtZXMoZGYpKSkgew0KICAgIHN0b3AoImRhdGFmcmFtZSBtdXN0IGhhdmUgJ2NsYXNzJyBhbmQgJ3Njb3JlZC5jbGFzcycgY29sdW1ucy4iKQ0KICB9DQoNCiAgI0NhbGN1bGF0aW5nIFRydWUgUG9zaXRpdmVzIChUUCksIFRydWUgTmVnYXRpdmVzIChUTiksIEZhbHNlIFBvc2l0aXZlcyAoRlApLCBGYWxzZSBOZWdhdGl2ZXMgKEZOKQ0KICBUUCA8LSBzdW0oZGYkY2xhc3MgPT0gMSAmIGRmJHNjb3JlZC5jbGFzcyA9PSAxKQ0KICBUTiA8LSBzdW0oZGYkY2xhc3MgPT0gMCAmIGRmJHNjb3JlZC5jbGFzcyA9PSAwKQ0KICBGUCA8LSBzdW0oZGYkY2xhc3MgPT0gMCAmIGRmJHNjb3JlZC5jbGFzcyA9PSAxKQ0KICBGTiA8LSBzdW0oZGYkY2xhc3MgPT0gMSAmIGRmJHNjb3JlZC5jbGFzcyA9PSAwKQ0KDQogICNDYWxjdWxhdGluZyBtZXRyaWNzDQogIGFjY3VyYWN5IDwtIChUUCArIFROKSAvIChUUCArIEZQICsgVE4gKyBGTikNCiAgZXJyb3JfcmF0ZSA8LSBtZWFuKGRmJGNsYXNzICE9IGRmJHNjb3JlZC5jbGFzcykNCg0KICBwcmVjaXNpb24gPC0gaWYgKFRQICsgRlAgPT0gMCkgTmFOIGVsc2UgVFAgLyAoVFAgKyBGUCkNCiAgc2Vuc2l0aXZpdHkgPC0gaWYgKFRQICsgRk4gPT0gMCkgTmFOIGVsc2UgVFAgLyAoVFAgKyBGTikNCiAgc3BlY2lmaWNpdHkgPC0gaWYgKFROICsgRlAgPT0gMCkgTmFOIGVsc2UgVE4gLyAoVE4gKyBGUCkNCg0KICBmMV9zY29yZSA8LSBpZiAoKFRQICsgRlAgPT0gMCkgfCAoVFAgKyBGTiA9PSAwKSkgTmFOIGVsc2UgMiAqIHByZWNpc2lvbiAqIHNlbnNpdGl2aXR5IC8gKHByZWNpc2lvbiArIHNlbnNpdGl2aXR5KQ0KDQogICNSZXR1cm5pbmcgYSBkYXRhIGZyYW1lDQogIHJlc3VsdF9kZiA8LSBkYXRhLmZyYW1lKA0KICAgIE1ldHJpYyA9IGMoIkFjY3VyYWN5IiwgIkNsYXNzaWZpY2F0aW9uIEVycm9yIFJhdGUiLCAiUHJlY2lzaW9uIiwgIlNlbnNpdGl2aXR5IiwgIlNwZWNpZmljaXR5IiwgIkYxIFNjb3JlIiksDQogICAgVmFsdWUgPSBjKGFjY3VyYWN5LCBlcnJvcl9yYXRlLCBwcmVjaXNpb24sIHNlbnNpdGl2aXR5LCBzcGVjaWZpY2l0eSwgZjFfc2NvcmUpDQogICkNCg0KICByZXR1cm4ocmVzdWx0X2RmKQ0KfQ0KDQojVXNpbmcgdGhlIGNhbGN1bGF0ZV9tZXRyaWNzIGZ1bmN0aW9uIHdpdGggeW91ciBkYXRhZnJhbWUNCnJlc3VsdF90YWJsZSA8LSBjYWxjdWxhdGVfbWV0cmljcyhkZjEpDQoNCiNQcmludGluZyB0aGUgdGFibGUgdGhhdCBkaXNwbGF5cyBtZXRyaWNzDQprYWJsZShyZXN1bHRfdGFibGUsIGNvbC5uYW1lcyA9IGMoIk1ldHJpYyIsICJWYWx1ZSIpKQ0KDQpgYGANCg0KIyMgMTIuIENhcmV0IFBhY2thZ2UNCg0KSW52ZXN0aWdhdGUgdGhlIGNhcmV0IHBhY2thZ2UuIEluIHBhcnRpY3VsYXIsIGNvbnNpZGVyIHRoZSBmdW5jdGlvbnMgY29uZnVzaW9uTWF0cml4LCBzZW5zaXRpdml0eSwgYW5kIHNwZWNpZmljaXR5LiBBcHBseSB0aGUgZnVuY3Rpb25zIHRvIHRoZSBkYXRhIHNldC4gSG93IGRvIHRoZSByZXN1bHRzIGNvbXBhcmUgd2l0aCB5b3VyIG93biBmdW5jdGlvbnM/DQoNCg0KYGBge3J9DQpsaWJyYXJ5KGNhcmV0KQ0KDQpjbSA8LSBjb25mdXNpb25NYXRyaXgoZGF0YSA9IGFzLmZhY3RvcihkZiRzY29yZWQuY2xhc3MpLCANCiAgICAgICAgICAgICAgICAgICAgICByZWZlcmVuY2UgPSBhcy5mYWN0b3IoZGYkY2xhc3MpLCANCiAgICAgICAgICAgICAgICAgICAgICBwb3NpdGl2ZSA9ICIxIikNCmNtDQpgYGANCg0KIyMgMTMuIHBST0MgcGFja2FnZQ0KDQpJbnZlc3RpZ2F0ZSB0aGUgcFJPQyBwYWNrYWdlLiBVc2UgaXQgdG8gZ2VuZXJhdGUgYW4gUk9DIGN1cnZlIGZvciB0aGUgZGF0YSBzZXQuIEhvdyBkbyB0aGUgcmVzdWx0cyBjb21wYXJlIHdpdGggeW91ciBvd24gZnVuY3Rpb25zPw0KDQoNCmBgYHtyfQ0KbGlicmFyeShwUk9DKQ0KDQojQXNzdW1pbmcgZGF0YSBmcmFtZSB3aXRoICdjbGFzcycgYW5kICdzY29yZWQucHJvYmFiaWxpdHknIGNvbHVtbnMNCnJvY19vYmogPC0gcm9jKGRmJGNsYXNzLCBkZiRzY29yZWQucHJvYmFiaWxpdHkpDQphdWNfdmFsIDwtIGF1Yyhyb2Nfb2JqKQ0KDQpwYXIobWZyb3cgPSBjKDEsIDIpLCBwdHkgPSAncycpDQoNCiNQbG90dGluZyBST0MgY3VydmUgdXNpbmcgcFJPQyBwYWNrYWdlDQpwbG90KHJvY19vYmosIHByaW50LmF1YyA9IFRSVUUsIG1haW4gPSAnUk9DIEN1cnZlIC0gcFJPQyBQYWNrYWdlJykNCg0KI0Rpc3BsYXlpbmcgQVVDIHZhbHVlDQpjYXQoIkFVQyAocFJPQyBQYWNrYWdlKToiLCBhdWNfdmFsLCAiXG4iKQ0KDQpgYGANCg0KDQo=