tests/testthat/test-fit_metrics.R

In rettopnivek/binclass: Personalized functions for binary classification.

context("Tests for fit_metrics function")
library(binclass)

# Create example data
n = 900
K = 4
K_sig = 2
param = c( .25, .75 )
sim = bc_simulate( n, K, K_sig, param = param )
# Set up cross-validation
index = c( rep( 1, 600 ), rep( 2, 300 ) )
dat = train_test( 2, index, sim$y, sim$X )

# For debugging purposes
# control = list()

# Training subset
dtbf = as.data.frame( dat, train = T )
fit_train = glm( y ~ P1 + P2 + P3 + P4,
                 family = 'binomial',
                 data = dtbf )

test_that( "fit_metrics class works", {
  fm = fit_metrics( fit_train, dat,
                    algorithm = 'glm' )
  expect_true( is.fit_metrics( fm ) )
})

# Call function
fm = fit_metrics( fit_train, dat,
                  algorithm = 'glm' )
# Compute metrics
pred = predict( fit_train, newdata = dtbf )
theta = 1/( 1 + exp(-pred) )
y_prd = as.numeric( theta > .5 )
y_obs = as.integer( dat, T )
# Confusion matrix
CM = table( Predicted = y_prd, Observed = y_obs )
# Match dimension names for confusion matrix
tst = fm$train$CM
dmn = dimnames(CM)
dmn$Predicted[ dmn$Predicted == "1" ] = "Yes"
dmn$Predicted[ dmn$Predicted == "0" ] = "No"
dmn$Observed[ dmn$Observed == "1" ] = "Yes"
dmn$Observed[ dmn$Observed == "0" ] = "No"
dimnames(CM) = dmn
CM = CM[ dimnames(tst)$Predicted, dimnames(tst)$Observed ]
# True/False positive rate
TPR = CM['Yes','Yes']/sum(CM[,'Yes'])
FPR = CM['Yes','No']/sum(CM[,'No'])
# Signal detection
criterion = -.5*( qnorm( TPR ) +
                    qnorm( FPR ) )
d_prime = 2*( qnorm( TPR ) + criterion )
# Mean cross-entropy
CE = mean( -y_obs*log2( theta ) )
# Accuracy
Accuracy = mean( y_obs == y_prd )

test_that( "fit_metrics computes metrics correctly", {

  # Singular values
  expect_identical( fm$train$CM, CM )
  expect_identical( fm$train$TPR, TPR )
  expect_identical( fm$train$FPR, FPR )
  expect_identical( fm$train$d_prime, d_prime )
  expect_identical( fm$train$criterion, criterion )
  expect_identical( fm$train$CE, CE )
  expect_identical( fm$train$Accuracy, Accuracy )
  # Constructs
  expect_identical( fm$train$theta, theta )
  expect_identical( fm$train$residuals, y_obs - theta )
})


test_that( "fit_metrics subset method works correctly", {
  expect_equal( subset( fm, train = T, metric = 'TPR' ), TPR )
  expect_equal( subset( fm, train = F, metric = 'd_prime' ), fm$test$d_prime )
})


test_that( "fit_metrics print method runs without error", {
  expect_output( print( fm ) )
})

dtbf = as.data.frame( dat, T )
res_train = as.integer( dat, T ) -
  ( 1/( 1 + exp( - predict( fit_train, newdata = dtbf ) ) ) )
dtbf = as.data.frame( dat, F )
res_test = as.integer( dat, F ) -
  ( 1/( 1 + exp( - predict( fit_train, newdata = dtbf ) ) ) )
test_that( "fit_metrics residuals method runs without error", {
  expect_equal( residuals( fm, train = T ), res_train )
  expect_equal( residuals( fm, train = F ), res_test )
})