How to make your own heuristic

Writing PredictPairInternal

PredictPair refers to predicting which of the pair of rows, row1 or row2, is greater. In this case the outputs have the following meaning:

• 1 means row 1 is greater.
• 0 means they are the same or it guesses.
• -1 means row 2 is greater (that is, the rows should be reversed).

To make predictions with heuristica, implement a function called predictPairInternal.yourClassName. The “internal” in the name is supposed to indicate that you never call this function yourself– you call predictPair instead. The inputs for this function should be:

• object, which will be the class structure returned by your fitting function.
• row1, one row of a matrix or data.frame having just the columns in cols_to_fit.
• row2, another row of a matrix or data.frame having just the columns in cols_to_fit.

The output should be:

• A value in -1, 0, 1.

If you output anything else, the aggregating functions will not correctly calculate accuracy.

For our bare-bones example, we will randomly guess -1 or 1. 1 means we predict the criterion in row1 will be greater. -1 means we predict the criterion in row2 will be greater– that is, the rows should be reversed.

predictPairInternal.myRandModel <- function(object, row1, row2) {
  prob <- runif(1)
  if (prob > 0.5) {
    return(1)
  } else {
    return(-1)
  }
}

Using PredictPair

Now to use this function, we call predictPair and pass in the fitted model. We could call predictPairInternal directly, but predictPair takes care of some housekeeping. (It calls predictPairInternal(object, row1[cols_to_fit], row2[cols_to_fit]), makes sure the output has the dimension of one row, names its column with the model class or fit_name.) Let’s get some data and run our model on it.

Consider a subset of the high school dropout data included with this package, focusing on just 5 schools. The first column has the school name. The drop-out rates are in column 2, and we will fit them using columns 3-5, namely Enrollment, Attendance Rate, and Low Income Students.

data("highschool_dropout")
schools <- highschool_dropout[c(1:5), c(1,4,6,7,11)]
schools

##       Name Dropout_Rate Enrollment Attendance_Rate Low_Income_Students
## 1   Austin         39.4       1403            72.3                63.7
## 2 Farragut         34.0       1839            76.4                95.9
## 3   Fenger         28.7       1098            79.5                63.2
## 4    Crane         28.6        969            65.5                74.8
## 5      Orr         26.3       1388            68.8                74.6

To analyze myRandModel on this data requires these steps: 1. “Fit” myModel to the schools data. 2. Ask the model to predict whether Austin has a higher dropout rate than Farrgut (the first two schools in our data).

myFit <- myRandModel(schools, 2, c(3:5))
row1 <- oneRow(schools, 1)
row1

##     Name Dropout_Rate Enrollment Attendance_Rate Low_Income_Students
## 1 Austin         39.4       1403            72.3                63.7

row2 <- oneRow(schools, 2)
row2

##       Name Dropout_Rate Enrollment Attendance_Rate Low_Income_Students
## 2 Farragut           34       1839            76.4                95.9

predictPair(row1, row2, myFit)

## [1] 1

We can see in the original data.frame that Austin had the higher dropout rate, meaning 1 would have been correct output. We can get heuristica to show this using a more general rowPair function to view the correct choice based on the criterion– which we tell it is in row 2 using correctGreater. It outputs the correct answer of the rowPair, which could be -1 or 1, and we see it turned out to be 1.

myFit <- myRandModel(schools, 2, c(3:5))
myData <- rbind(oneRow(schools, 1), oneRow(schools, 2))
rowPairApply(myData, correctGreater(2), heuristics(myFit))

##      CorrectGreater myRandModel
## [1,]              1           1

What if we want to see results for all pairs of the first 5 schools? Use rowPairApply.

rowPairApply(schools, correctGreater(2), heuristics(myFit))

##       CorrectGreater myRandModel
##  [1,]              1          -1
##  [2,]              1          -1
##  [3,]              1          -1
##  [4,]              1           1
##  [5,]              1           1
##  [6,]              1          -1
##  [7,]              1           1
##  [8,]              1           1
##  [9,]              1          -1
## [10,]              1          -1

This outputs 10 predictions because there are 5*4/2 = 10 row pairs for 5 schools. Notice that because the data is sorted, CorrectGreater is always 1. (If we had a different sorting, we would see some -1’s.)

Performance

Heuristica can assess the performance of this categorizing of ranking. First, there is a confusion matrix, as in many machine learning problems, except this one assumes you always want to see the output for -1, 0, 1 always. We need to give it the correct answers, which are based on column 2, so we use correctGreater(2). And we need to give it the predictions, which we generate with heuristics(myFit). We pass these generators into rowPairApply. Then we send the output to our confusion matrix function.

set.seed(1)
predictions <- data.frame(rowPairApply(schools, correctGreater(2), heuristics(myFit)))
confusionMatrixFor_Neg1_0_1(predictions$CorrectGreater, predictions$myRandModel)

##        predictions
## correct -1 0 1
##      -1  0 0 0
##      0   0 0 0
##      1   4 0 6

Assuming you used the same random seed as this module, the matrix shows that out of the 10 cases, 6 were predicted correctly (the prediction was 1 and the correct answer was 1) and 4 were not (the prediction was -1 but the correct answer was 1).

What percent correct is this? In this case, it’s an easy division of 6/10 = 0.6. But you can get this result in one step– for many fitted models– with percentCorrect. Below is the call (with the random seed set again).

set.seed(1)
myFit <- myRandModel(schools, 2, c(3:5))
percentCorrect(schools, myFit)

##   myRandModel
## 1          60