hmeasure.R
In hmeasure: The H-Measure and Other Scalar Classification Performance Metrics

### R code from vignette source 'hmeasure.Rnw'

###################################################
### code chunk number 1: hmeasure.Rnw:65-70
###################################################
require(MASS); require(class); data(Pima.te); 
library(hmeasure)
n <- dim(Pima.te)[1]; ntrain <- floor(2*n/3); ntest <- n-ntrain
pima.train <- Pima.te[seq(1,n,3),]
pima.test <- Pima.te[-seq(1,n,3),]


###################################################
### code chunk number 2: hmeasure.Rnw:73-75
###################################################
true.labels <- pima.test[,8]
str(true.labels)


###################################################
### code chunk number 3: hmeasure.Rnw:78-79
###################################################
lda.pima <- lda(formula=type~., data=pima.train)


###################################################
### code chunk number 4: hmeasure.Rnw:82-85
###################################################
out.lda = predict(lda.pima, newdata=pima.test)
true.labels.01 <- relabel(true.labels)
lda.labels.01 <- relabel(out.lda$class)


###################################################
### code chunk number 5: hmeasure.Rnw:88-89
###################################################
lda.counts <- misclassCounts(true.labels.01, lda.labels.01); lda.counts$conf.matrix


###################################################
### code chunk number 6: hmeasure.Rnw:92-93
###################################################
print(lda.counts$metrics,digits=3)


###################################################
### code chunk number 7: hmeasure.Rnw:104-105
###################################################
relabel(c("Yes","No","No"))


###################################################
### code chunk number 8: hmeasure.Rnw:108-109
###################################################
relabel(c("case","noncase","case"))


###################################################
### code chunk number 9: hmeasure.Rnw:130-131
###################################################
out.lda$posterior[1:3,]


###################################################
### code chunk number 10: hmeasure.Rnw:134-136
###################################################
scores.lda <- out.lda$posterior[,2]; 
all((scores.lda > 0.5) == lda.labels.01)


###################################################
### code chunk number 11: hmeasure.Rnw:139-142
###################################################
lda.counts.T03 <- misclassCounts(scores.lda>0.3, true.labels.01)
lda.counts.T03$conf.matrix
lda.counts.T03$metrics[c('Sens','Spec')]


###################################################
### code chunk number 12: hmeasure.Rnw:148-152
###################################################
class.knn <- knn(train=pima.train[,-8], test=pima.test[,-8],
  cl=pima.train$type, k=9, prob=TRUE, use.all=TRUE)
scores.knn <- attr(class.knn,"prob")
scores.knn[class.knn=="No"] <- 1-scores.knn[class.knn=="No"] 


###################################################
### code chunk number 13: hmeasure.Rnw:155-158
###################################################
scores <- data.frame(LDA=scores.lda,kNN=scores.knn)
results <- HMeasure(true.labels,scores)
class(results)


###################################################
### code chunk number 14: hmeasure.Rnw:168-169
###################################################
plotROC(results)


###################################################
### code chunk number 15: hmeasure.Rnw:178-179
###################################################
summary(results)


###################################################
### code chunk number 16: hmeasure.Rnw:195-196
###################################################
summary(results,show.all=TRUE)


###################################################
### code chunk number 17: hmeasure.Rnw:199-200
###################################################
HMeasure(true.labels,scores,threshold=0.3)$metrics[c('Sens','Spec')]


###################################################
### code chunk number 18: hmeasure.Rnw:203-204
###################################################
HMeasure(true.labels,scores,threshold=c(0.3,0.3))$metrics[c('Sens','Spec')]


###################################################
### code chunk number 19: hmeasure.Rnw:207-208
###################################################
HMeasure(true.labels,scores,threshold=c(0.5,0.3))$metrics[c('Sens','Spec')]


###################################################
### code chunk number 20: hmeasure.Rnw:213-214
###################################################
summary(HMeasure(true.labels,scores,level=c(0.95,0.99)))


###################################################
### code chunk number 21: hmeasure.Rnw:237-238
###################################################
plotROC(results,which=4)


###################################################
### code chunk number 22: hmeasure.Rnw:276-277
###################################################
results$metrics[c('H','KS','ER','FP','FN')]


###################################################
### code chunk number 23: hmeasure.Rnw:280-281
###################################################
summary(pima.test[,8])


###################################################
### code chunk number 24: hmeasure.Rnw:284-287
###################################################
results.SR1 <- HMeasure(
  true.labels, data.frame(LDA=scores.lda,kNN=scores.knn),severity.ratio=1)
results.SR1$metrics[c('H','KS','ER','FP','FN')]


###################################################
### code chunk number 25: hmeasure.Rnw:292-295
###################################################
par(mfrow=c(2,1))
plotROC(results,which=2)
plotROC(results.SR1,which=2)


###################################################
### code chunk number 26: hmeasure.Rnw:303-304
###################################################
plotROC(results,which=3)