[r-cran-modelmetrics] 01/02: Imported Upstream version 1.1.0
Andreas Tille
tille at debian.org
Tue Nov 29 14:17:51 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-modelmetrics.
commit c6bcc59c1a123b5d8cda10fea6db14430a047bdb
Author: Andreas Tille <tille at debian.org>
Date: Tue Nov 29 15:16:47 2016 +0100
Imported Upstream version 1.1.0
---
DESCRIPTION | 19 ++
MD5 | 37 ++++
NAMESPACE | 26 +++
NEWS.md | 11 +
R/ModelMetrics.R | 436 +++++++++++++++++++++++++++++++++++++
R/RcppExports.R | 75 +++++++
R/binaryChecks.R | 8 +
README.md | 61 ++++++
data/testDF.rda | Bin 0 -> 1800 bytes
man/auc.Rd | 25 +++
man/brier.Rd | 17 ++
man/ce.Rd | 17 ++
man/confusionMatrix.Rd | 19 ++
man/f1Score.Rd | 19 ++
man/logLoss.Rd | 27 +++
man/mae.Rd | 17 ++
man/mauc.Rd | 35 +++
man/mcc.Rd | 19 ++
man/mlogLoss.Rd | 17 ++
man/mse.Rd | 25 +++
man/msle.Rd | 17 ++
man/npv.Rd | 27 +++
man/ppv.Rd | 29 +++
man/recall.Rd | 31 +++
man/rmse.Rd | 25 +++
man/rmsle.Rd | 17 ++
man/testDF.Rd | 10 +
man/tnr.Rd | 29 +++
src/RcppExports.cpp | 231 ++++++++++++++++++++
src/auc_.cpp | 29 +++
src/confusionMatrix_.cpp | 119 ++++++++++
src/error.cpp | 67 ++++++
src/logLoss_.cpp | 39 ++++
tests/testthat.R | 4 +
tests/testthat/test_auc.R | 45 ++++
tests/testthat/test_calculations.R | 113 ++++++++++
tests/testthat/test_errors.R | 15 ++
tests/testthat/test_logloss.R | 92 ++++++++
38 files changed, 1849 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..9220497
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,19 @@
+Package: ModelMetrics
+Title: Rapid Calculation of Model Metrics
+Version: 1.1.0
+Authors at R: person("Tyler", "Hunt", email = "thunt at snapfinance.com", role = c("aut", "cre"))
+Description: Collection of metrics for evaluating models written in C++ using 'Rcpp'.
+Depends: R (>= 3.2.2)
+License: GPL (>= 2)
+Encoding: UTF-8
+LazyData: true
+LinkingTo: Rcpp
+Imports: Rcpp
+RoxygenNote: 5.0.1
+Suggests: testthat
+NeedsCompilation: yes
+Packaged: 2016-08-26 15:27:50 UTC; snapadmin
+Author: Tyler Hunt [aut, cre]
+Maintainer: Tyler Hunt <thunt at snapfinance.com>
+Repository: CRAN
+Date/Publication: 2016-08-26 20:35:22
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..d1d98e4
--- /dev/null
+++ b/MD5
@@ -0,0 +1,37 @@
+595ad87b75b9d726fa4ea4c2db87a240 *DESCRIPTION
+9bfd9577a53cdcb1ae4a9bae79b54987 *NAMESPACE
+3d3a8726516d3278c2fdbe5dab5478bd *NEWS.md
+0a0d59d09e469e67c104c0afcce69c8b *R/ModelMetrics.R
+601d629eff7bf45f3eb340cb961cbdb1 *R/RcppExports.R
+3548331a7b2c91664e40f37dfba33898 *R/binaryChecks.R
+03630ba4a731932bfdcb246c712e5d33 *README.md
+94a989fe38ef05dac738e1e1b2c9da87 *data/testDF.rda
+3aadcd4db23ad43c34c5b5d7b4eed350 *man/auc.Rd
+f7ff43b72bf66422d0f04fe034e6537d *man/brier.Rd
+ac013245680743e74c52970be4264f7e *man/ce.Rd
+241c10cf68bcabfe0511783cf0a3d49e *man/confusionMatrix.Rd
+3cabb871651da8e966975cd1ab544222 *man/f1Score.Rd
+c712c75b1d530484050d68be3922c9f3 *man/logLoss.Rd
+48cbdc2d86237e4dd90bcd9de46188b2 *man/mae.Rd
+f98aaa694d2f674e8371dc13f7d4b0c8 *man/mauc.Rd
+da29e9201fb1586189383b7f625529ec *man/mcc.Rd
+567c0661d83e5659e1f59da8f85d687a *man/mlogLoss.Rd
+c5b797a337a6bae76a3d3b94844c1ff5 *man/mse.Rd
+f4237239aa6193064d1db050a0e39dfc *man/msle.Rd
+9451864c2f8c3f4368f09f92aa2d1b08 *man/npv.Rd
+6fc943bd2e96cd15f5d679611353e6d3 *man/ppv.Rd
+99de0c545b018c22cd67866516ab1305 *man/recall.Rd
+f58daed178ae6db5ad9a65b72f1c5b91 *man/rmse.Rd
+33ef19c3f73b06806bf219f0de775bd5 *man/rmsle.Rd
+4a48fb486513978199508e14e41e25d4 *man/testDF.Rd
+c2e0e9f68f2dcfe3b240b3951a02d403 *man/tnr.Rd
+863200f7a9a765aab1779cbd0c95c322 *src/RcppExports.cpp
+2232ba7876742b7dbc58d698fb01c282 *src/auc_.cpp
+dc6e7ac26c47421ec74ee9f5bbd257a8 *src/confusionMatrix_.cpp
+b5b7bc99d9f0b86619af70fe9e469cea *src/error.cpp
+ca2737469df1206c7b559d0c9dc9df16 *src/logLoss_.cpp
+bb16f91f58e82e738df1dfa6bf6f6cc6 *tests/testthat.R
+bf8de8742209c6f32ede83d1b7baf623 *tests/testthat/test_auc.R
+a828f0139b2ab2833ef3abe40dfcc1a9 *tests/testthat/test_calculations.R
+f131ea7bb2f8ece346adb4175152a7d1 *tests/testthat/test_errors.R
+5ff1987509866d669ef0e45d6ba9784e *tests/testthat/test_logloss.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..a29b857
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,26 @@
+# Generated by roxygen2: do not edit by hand
+
+export(auc)
+export(brier)
+export(ce)
+export(confusionMatrix)
+export(f1Score)
+export(logLoss)
+export(mae)
+export(mauc)
+export(mcc)
+export(mlogLoss)
+export(mse)
+export(msle)
+export(npv)
+export(ppv)
+export(precision)
+export(recall)
+export(rmse)
+export(rmsle)
+export(sensitivity)
+export(specificity)
+export(tnr)
+export(tpr)
+importFrom(Rcpp,sourceCpp)
+useDynLib(ModelMetrics)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..c0ffb53
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,11 @@
+# ModelMetrics 1.1.0
+
+* added Matthews correlation coefficient (`mcc`)
+* added multiclass auc (`mauc` )
+* lots more tests
+* fixed bug when rank ties were present in `auc` (#10)
+* added code to handle different classes in functions
+
+
+# ModelMetrics 1.0.0
+* Refactor `common_by()` (#1928).
diff --git a/R/ModelMetrics.R b/R/ModelMetrics.R
new file mode 100644
index 0000000..ebbf443
--- /dev/null
+++ b/R/ModelMetrics.R
@@ -0,0 +1,436 @@
+#' @useDynLib ModelMetrics
+#' @importFrom Rcpp sourceCpp
+NULL
+
+#' Test data
+#'
+#' @name testDF
+#' @docType data
+NULL
+
+#' @title Log Loss
+#'
+#' @description Calculates the log loss or entropy loss for a binary outcome
+#'
+#' @param actual a binary vector of the labels
+#' @param predicted a vector of predicted values
+#' @param distribution the distribution of the loss function needed \code{binomial, poisson}
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' logLoss(testDF$y, Preds)
+#'
+#' @export
+
+logLoss <- function(actual, predicted, distribution = "binomial"){
+
+ eps <- 1e-15
+ predicted = pmax(pmin(predicted, 1 - eps), eps)
+
+ if(distribution == "binomial"){
+
+ return(logLoss_(actual, predicted))
+
+ } else if(distribution == 'poisson'){
+
+ return(plogLoss_(actual, predicted))
+
+ } else {
+ stop(paste(distribution, "is not defined. Please use binomial or poisson"))
+ }
+
+}
+
+
+#' @title Multiclass Log Loss
+#'
+#' @description Calculated the multi-class log loss
+#'
+#' @param actual A vector of the labels. Can be \code{numeric, character, or factor}
+#' @param predicted matrix of predicted values. Can be \code{matrix, data.frame}
+#'
+#' @export
+
+mlogLoss <- function(actual, predicted){
+
+ if(class(actual) %in% c('factor', 'character')){
+ actual = as.numeric(as.factor(actual))
+ }
+ if(class(predicted) %in% c('data.frame')){
+ predicted = as.matrix(predicted)
+ }
+
+ eps <- 1e-15
+ predicted = pmax(pmin(predicted, 1 - eps), eps)
+
+ mlogLoss_(actual, predicted)
+}
+
+
+
+#' @title Area Under the Curve
+#'
+#' @description Calculates the area under the curve for a binary classifcation model
+#'
+#' @param actual A vector of the labels. Can be \code{numeric, character, or factor}
+#' @param predicted A vector of predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' auc(testDF$y, Preds)
+#'
+#' @export
+
+auc <- function(actual, predicted){
+
+ binaryChecks(actual, 'auc')
+ if(class(actual) %in% c('factor', 'character')){
+ actual = as.numeric(as.factor(as.character(actual))) - 1
+ }
+ ranks <- rank(predicted)
+
+ auc_(actual, predicted, ranks)
+}
+
+
+#' @title Multiclass Area Under the Curve
+#'
+#' @description Calculates the area under the curve for a binary classifcation model
+#'
+#' @param actual A vector of the labels. Can be \code{numeric, character, or factor}
+#' @param predicted A data.frame of predicted values. Can be \code{matrix, data.frame}
+#'
+#'
+#' @examples
+#' setosa <- glm(I(Species == 'setosa') ~ Sepal.Length, data = iris, family = 'binomial')
+#' versicolor <- glm(I(Species == 'versicolor') ~ Sepal.Length, data = iris, family = 'binomial')
+#' virginica <- glm(I(Species == 'virginica') ~ Sepal.Length, data = iris, family = 'binomial')
+#'
+#' Pred <-
+#' data.frame(
+#' setosa = predict(setosa, type = 'response')
+#' ,versicolor = predict(versicolor, type = 'response')
+#' ,virginica = predict(virginica, type = 'response')
+#' )
+#'
+#' Predicted = Pred/rowSums(Pred)
+#' Actual = iris$Species
+#'
+#' mauc(Actual, Predicted)
+#'
+#' @export
+
+mauc <- function(actual, predicted){
+
+ actual <- factor(actual)
+ Data <- data.frame(predicted, actual)
+ Outcomes <- length(unique(actual))
+
+ simpleAUC <- function(x){
+ # One-vs-all
+ y1 = levels(Data$actual)[x]
+ y <- as.numeric(Data[, "actual"] == y1)
+ prob <- Data[,x]
+ AUCs <- auc(y, prob)
+ return(AUCs)
+ }
+
+ AUCs <- sapply(1:Outcomes, simpleAUC)
+ list(mauc = mean(AUCs), auc = AUCs)
+
+}
+
+
+#' @title Mean Square Error
+#' @description Calculates the mean square error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' mse(testDF$y, Preds)
+#'
+#' @export
+
+mse <- function(actual, predicted){
+ mse_(actual, predicted)
+}
+
+
+#' @title Root-Mean Square Error
+#' @description Calculates the root mean square error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' rmse(testDF$y, Preds)
+#'
+#' @export
+
+rmse <- function(actual, predicted){
+ rmse_(actual, predicted)
+}
+
+
+
+#' @title Confusion Matrix
+#' @description Create a confusion matrix given a specific cutoff.
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @export
+
+confusionMatrix <- function(actual, predicted, cutoff = .5){
+ confusionMatrix_(actual, predicted, cutoff)
+}
+
+
+
+#' @title Postive Predictive Value
+#'
+#' @description True Postives / (True Positives + False Positives)
+#'
+#' @aliases precision
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' ppv(testDF$y, Preds, cutoff = 0)
+#' precision(testDF$y, Preds, cutoff = 0)
+#'
+#' @export
+
+ppv <- function(actual, predicted, cutoff = .5){
+ ppv_(actual, predicted, cutoff)
+}
+
+#' @export
+
+precision <- function(actual, predicted, cutoff = .5){
+ ppv_(actual, predicted, cutoff)
+}
+
+
+
+
+#' @title Negative Predictive Value
+#'
+#' @description True Negatives / (True Negatives + False Negatives)
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' npv(testDF$y, Preds, cutoff = 0)
+#'
+#' @export
+
+npv <- function(actual, predicted, cutoff = .5){
+ npv_(actual, predicted, cutoff)
+}
+
+
+
+#' @title Recall, Sensitivity, tpr
+#'
+#' @aliases sensitivity tpr
+#'
+#' @description True Positives / (True Positives + False Negatives)
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' recall(testDF$y, Preds, cutoff = 0)
+#' sensitivity(testDF$y, Preds, cutoff = 0)
+#' tpr(testDF$y, Preds, cutoff = 0)
+#'
+#' @export
+
+recall <- function(actual, predicted, cutoff = .5){
+ recall_(actual, predicted, cutoff)
+}
+
+#' @export
+sensitivity <- function(actual, predicted, cutoff = .5){
+ recall_(actual, predicted, cutoff)
+}
+
+#' @export
+tpr <- function(actual, predicted, cutoff = .5){
+ recall_(actual, predicted, cutoff)
+}
+
+
+#' @title Specificity, True negative rate
+#'
+#' @aliases specificity tnr
+#'
+#' @description True Negatives / (True Negatives + False Positives)
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @examples
+#' data(testDF)
+#' glmModel <- glm(y ~ ., data = testDF, family="binomial")
+#' Preds <- predict(glmModel, type = 'response')
+#'
+#' tnr(testDF$y, Preds, cutoff = 0)
+#' specificity(testDF$y, Preds, cutoff = 0)
+#'
+#' @export
+
+tnr <- function(actual, predicted, cutoff = .5){
+ tnr_(actual, predicted, cutoff)
+}
+
+#' @export
+specificity <- function(actual, predicted, cutoff = .5){
+ tnr_(actual, predicted, cutoff)
+}
+
+
+
+#' @title F1 Score
+#' @description Calculates the f1 score
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @export
+
+f1Score <- function(actual, predicted, cutoff = .5){
+
+ f1Score_(actual, predicted, cutoff)
+
+}
+
+
+
+#' @title Mean absolute error
+#' @description Calculates the mean absolute error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @export
+
+mae <- function(actual, predicted){
+
+ mae_(actual, predicted)
+
+}
+
+
+
+#' @title Classification error
+#' @description Calculates the classification error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @export
+
+ce <- function(actual, predicted){
+
+ ce_(actual, predicted)
+
+}
+
+
+
+
+#' @title Mean Squared Log Error
+#' @description Calculates the mean square log error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @export
+
+msle <- function(actual, predicted){
+ msle_(actual, predicted)
+}
+
+
+
+
+#' @title Root Mean Squared Log Error
+#' @description Calculates the mean square log error
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @export
+
+rmsle <- function(actual, predicted){
+ rmsle_(actual, predicted)
+}
+
+
+
+#' @title Brier Score
+#' @description Calculates the Brier score
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#'
+#' @export
+
+brier <- function(actual, predicted){
+ brier_(actual, predicted)
+}
+
+
+
+
+#' @title Matthews Correlation Coefficient
+#' @description Calculates the Matthews Correlation Coefficient
+#'
+#' @param actual A vector of the labels
+#' @param predicted A vector of predicted values
+#' @param cutoff A cutoff for the predicted values
+#'
+#' @export
+
+mcc <- function(actual, predicted, cutoff){
+ mcc_(actual, predicted, cutoff)
+}
+
+
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..25a06f1
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,75 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+auc_ <- function(actual, predicted, ranks) {
+ .Call('ModelMetrics_auc_', PACKAGE = 'ModelMetrics', actual, predicted, ranks)
+}
+
+confusionMatrix_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_confusionMatrix_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+ppv_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_ppv_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+npv_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_npv_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+tnr_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_tnr_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+recall_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_recall_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+f1Score_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_f1Score_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+brier_ <- function(actual, predicted) {
+ .Call('ModelMetrics_brier_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+mcc_ <- function(actual, predicted, cutoff) {
+ .Call('ModelMetrics_mcc_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff)
+}
+
+mae_ <- function(actual, predicted) {
+ .Call('ModelMetrics_mae_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+ce_ <- function(actual, predicted) {
+ .Call('ModelMetrics_ce_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+mse_ <- function(actual, predicted) {
+ .Call('ModelMetrics_mse_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+msle_ <- function(actual, predicted) {
+ .Call('ModelMetrics_msle_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+rmsle_ <- function(actual, predicted) {
+ .Call('ModelMetrics_rmsle_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+rmse_ <- function(actual, predicted) {
+ .Call('ModelMetrics_rmse_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+logLoss_ <- function(actual, predicted) {
+ .Call('ModelMetrics_logLoss_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+mlogLoss_ <- function(actual, predicted) {
+ .Call('ModelMetrics_mlogLoss_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
+plogLoss_ <- function(actual, predicted) {
+ .Call('ModelMetrics_plogLoss_', PACKAGE = 'ModelMetrics', actual, predicted)
+}
+
diff --git a/R/binaryChecks.R b/R/binaryChecks.R
new file mode 100644
index 0000000..cc8a953
--- /dev/null
+++ b/R/binaryChecks.R
@@ -0,0 +1,8 @@
+
+
+
+binaryChecks <- function(x, method){
+ if(length(unique(x)) > 2){
+ stop(paste(method, "only works for binary outcomes at this time"))
+ }
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..4c4557e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,61 @@
+## ModelMetrics: Rapid Calculation of Model Metrics
+[](https://travis-ci.org/JackStat/ModelMetrics)
+[](https://ci.appveyor.com/project/JackStat/modelmetrics/branch/master)
+[](https://coveralls.io/github/JackStat/ModelMetrics?branch=master)
+
+Tyler Hunt thunt at snapfinance.com
+
+### Introduction
+ModelMetrics is a much faster and reliable package for evaluating models. ModelMetrics is written in using Rcpp making it faster than the other packages used for model metrics.
+
+
+### Installation
+
+You can install this package from CRAN:
+
+```r
+install.packages("ModelMetrics")
+```
+
+Or you can install the development version from Github with [devtools](https://github.com/hadley/devtools):
+
+```r
+devtools::install_github("JackStat/ModelMetrics")
+```
+
+
+### Benchmark and comparison
+
+```r
+N = 100000
+Actual = as.numeric(runif(N) > .5)
+Predicted = as.numeric(runif(N))
+
+actual = Actual
+predicted = Predicted
+
+s1 <- system.time(a1 <- ModelMetrics::auc(Actual, Predicted))
+s2 <- system.time(a2 <- Metrics::auc(Actual, Predicted))
+# Warning message:
+# In n_pos * n_neg : NAs produced by integer overflow
+s3 <- system.time(a3 <- pROC::auc(Actual, Predicted))
+s4 <- system.time(a4 <- MLmetrics::AUC(Predicted, Actual))
+# Warning message:
+# In n_pos * n_neg : NAs produced by integer overflow
+s5 <- system.time({pp <- ROCR::prediction(Predicted, Actual); a5 <- ROCR::performance(pp, 'auc')})
+
+
+data.frame(
+ package = c("ModelMetrics", "pROC", "ROCR")
+ ,Time = c(s1[[3]],s3[[3]],s5[[3]])
+)
+
+# MLmetrics and Metrics could not calculate so they are dropped from time comparison
+# package Time
+# 1 ModelMetrics 0.034
+# 2 pROC 85.289
+# 3 ROCR 0.565
+```
+
+
+
diff --git a/data/testDF.rda b/data/testDF.rda
new file mode 100644
index 0000000..90407f5
Binary files /dev/null and b/data/testDF.rda differ
diff --git a/man/auc.Rd b/man/auc.Rd
new file mode 100644
index 0000000..22371e8
--- /dev/null
+++ b/man/auc.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{auc}
+\alias{auc}
+\title{Area Under the Curve}
+\usage{
+auc(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels. Can be \code{numeric, character, or factor}}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the area under the curve for a binary classifcation model
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+auc(testDF$y, Preds)
+
+}
+
diff --git a/man/brier.Rd b/man/brier.Rd
new file mode 100644
index 0000000..d5beb04
--- /dev/null
+++ b/man/brier.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{brier}
+\alias{brier}
+\title{Brier Score}
+\usage{
+brier(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the Brier score
+}
+
diff --git a/man/ce.Rd b/man/ce.Rd
new file mode 100644
index 0000000..741beff
--- /dev/null
+++ b/man/ce.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{ce}
+\alias{ce}
+\title{Classification error}
+\usage{
+ce(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the classification error
+}
+
diff --git a/man/confusionMatrix.Rd b/man/confusionMatrix.Rd
new file mode 100644
index 0000000..95631a5
--- /dev/null
+++ b/man/confusionMatrix.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{confusionMatrix}
+\alias{confusionMatrix}
+\title{Confusion Matrix}
+\usage{
+confusionMatrix(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+Create a confusion matrix given a specific cutoff.
+}
+
diff --git a/man/f1Score.Rd b/man/f1Score.Rd
new file mode 100644
index 0000000..bc564d5
--- /dev/null
+++ b/man/f1Score.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{f1Score}
+\alias{f1Score}
+\title{F1 Score}
+\usage{
+f1Score(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+Calculates the f1 score
+}
+
diff --git a/man/logLoss.Rd b/man/logLoss.Rd
new file mode 100644
index 0000000..d13ba23
--- /dev/null
+++ b/man/logLoss.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{logLoss}
+\alias{logLoss}
+\title{Log Loss}
+\usage{
+logLoss(actual, predicted, distribution = "binomial")
+}
+\arguments{
+\item{actual}{a binary vector of the labels}
+
+\item{predicted}{a vector of predicted values}
+
+\item{distribution}{the distribution of the loss function needed \code{binomial, poisson}}
+}
+\description{
+Calculates the log loss or entropy loss for a binary outcome
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+logLoss(testDF$y, Preds)
+
+}
+
diff --git a/man/mae.Rd b/man/mae.Rd
new file mode 100644
index 0000000..d4bd65e
--- /dev/null
+++ b/man/mae.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{mae}
+\alias{mae}
+\title{Mean absolute error}
+\usage{
+mae(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the mean absolute error
+}
+
diff --git a/man/mauc.Rd b/man/mauc.Rd
new file mode 100644
index 0000000..be926cc
--- /dev/null
+++ b/man/mauc.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{mauc}
+\alias{mauc}
+\title{Multiclass Area Under the Curve}
+\usage{
+mauc(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels. Can be \code{numeric, character, or factor}}
+
+\item{predicted}{A data.frame of predicted values. Can be \code{matrix, data.frame}}
+}
+\description{
+Calculates the area under the curve for a binary classifcation model
+}
+\examples{
+setosa <- glm(I(Species == 'setosa') ~ Sepal.Length, data = iris, family = 'binomial')
+versicolor <- glm(I(Species == 'versicolor') ~ Sepal.Length, data = iris, family = 'binomial')
+virginica <- glm(I(Species == 'virginica') ~ Sepal.Length, data = iris, family = 'binomial')
+
+Pred <-
+ data.frame(
+ setosa = predict(setosa, type = 'response')
+ ,versicolor = predict(versicolor, type = 'response')
+ ,virginica = predict(virginica, type = 'response')
+ )
+
+Predicted = Pred/rowSums(Pred)
+Actual = iris$Species
+
+mauc(Actual, Predicted)
+
+}
+
diff --git a/man/mcc.Rd b/man/mcc.Rd
new file mode 100644
index 0000000..5735071
--- /dev/null
+++ b/man/mcc.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{mcc}
+\alias{mcc}
+\title{Matthews Correlation Coefficient}
+\usage{
+mcc(actual, predicted, cutoff)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+Calculates the Matthews Correlation Coefficient
+}
+
diff --git a/man/mlogLoss.Rd b/man/mlogLoss.Rd
new file mode 100644
index 0000000..16bc069
--- /dev/null
+++ b/man/mlogLoss.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{mlogLoss}
+\alias{mlogLoss}
+\title{Multiclass Log Loss}
+\usage{
+mlogLoss(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels. Can be \code{numeric, character, or factor}}
+
+\item{predicted}{matrix of predicted values. Can be \code{matrix, data.frame}}
+}
+\description{
+Calculated the multi-class log loss
+}
+
diff --git a/man/mse.Rd b/man/mse.Rd
new file mode 100644
index 0000000..98ef285
--- /dev/null
+++ b/man/mse.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{mse}
+\alias{mse}
+\title{Mean Square Error}
+\usage{
+mse(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the mean square error
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+mse(testDF$y, Preds)
+
+}
+
diff --git a/man/msle.Rd b/man/msle.Rd
new file mode 100644
index 0000000..a897032
--- /dev/null
+++ b/man/msle.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{msle}
+\alias{msle}
+\title{Mean Squared Log Error}
+\usage{
+msle(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the mean square log error
+}
+
diff --git a/man/npv.Rd b/man/npv.Rd
new file mode 100644
index 0000000..7b4e271
--- /dev/null
+++ b/man/npv.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{npv}
+\alias{npv}
+\title{Negative Predictive Value}
+\usage{
+npv(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+True Negatives / (True Negatives + False Negatives)
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+npv(testDF$y, Preds, cutoff = 0)
+
+}
+
diff --git a/man/ppv.Rd b/man/ppv.Rd
new file mode 100644
index 0000000..7b693da
--- /dev/null
+++ b/man/ppv.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{ppv}
+\alias{ppv}
+\alias{precision}
+\title{Postive Predictive Value}
+\usage{
+ppv(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+True Postives / (True Positives + False Positives)
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+ppv(testDF$y, Preds, cutoff = 0)
+precision(testDF$y, Preds, cutoff = 0)
+
+}
+
diff --git a/man/recall.Rd b/man/recall.Rd
new file mode 100644
index 0000000..6c4f77a
--- /dev/null
+++ b/man/recall.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{recall}
+\alias{recall}
+\alias{sensitivity}
+\alias{tpr}
+\title{Recall, Sensitivity, tpr}
+\usage{
+recall(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+True Positives / (True Positives + False Negatives)
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+recall(testDF$y, Preds, cutoff = 0)
+sensitivity(testDF$y, Preds, cutoff = 0)
+tpr(testDF$y, Preds, cutoff = 0)
+
+}
+
diff --git a/man/rmse.Rd b/man/rmse.Rd
new file mode 100644
index 0000000..73737c5
--- /dev/null
+++ b/man/rmse.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{rmse}
+\alias{rmse}
+\title{Root-Mean Square Error}
+\usage{
+rmse(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the root mean square error
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+rmse(testDF$y, Preds)
+
+}
+
diff --git a/man/rmsle.Rd b/man/rmsle.Rd
new file mode 100644
index 0000000..e6b99d9
--- /dev/null
+++ b/man/rmsle.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{rmsle}
+\alias{rmsle}
+\title{Root Mean Squared Log Error}
+\usage{
+rmsle(actual, predicted)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+}
+\description{
+Calculates the mean square log error
+}
+
diff --git a/man/testDF.Rd b/man/testDF.Rd
new file mode 100644
index 0000000..f78f49b
--- /dev/null
+++ b/man/testDF.Rd
@@ -0,0 +1,10 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\docType{data}
+\name{testDF}
+\alias{testDF}
+\title{Test data}
+\description{
+Test data
+}
+
diff --git a/man/tnr.Rd b/man/tnr.Rd
new file mode 100644
index 0000000..0d7c8c0
--- /dev/null
+++ b/man/tnr.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ModelMetrics.R
+\name{tnr}
+\alias{specificity}
+\alias{tnr}
+\title{Specificity, True negative rate}
+\usage{
+tnr(actual, predicted, cutoff = 0.5)
+}
+\arguments{
+\item{actual}{A vector of the labels}
+
+\item{predicted}{A vector of predicted values}
+
+\item{cutoff}{A cutoff for the predicted values}
+}
+\description{
+True Negatives / (True Negatives + False Positives)
+}
+\examples{
+data(testDF)
+glmModel <- glm(y ~ ., data = testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+tnr(testDF$y, Preds, cutoff = 0)
+specificity(testDF$y, Preds, cutoff = 0)
+
+}
+
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..51868a6
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,231 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// auc_
+double auc_(NumericVector actual, NumericVector predicted, NumericVector ranks);
+RcppExport SEXP ModelMetrics_auc_(SEXP actualSEXP, SEXP predictedSEXP, SEXP ranksSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type ranks(ranksSEXP);
+ rcpp_result_gen = Rcpp::wrap(auc_(actual, predicted, ranks));
+ return rcpp_result_gen;
+END_RCPP
+}
+// confusionMatrix_
+NumericMatrix confusionMatrix_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_confusionMatrix_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(confusionMatrix_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// ppv_
+double ppv_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_ppv_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(ppv_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// npv_
+double npv_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_npv_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(npv_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// tnr_
+double tnr_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_tnr_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(tnr_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// recall_
+double recall_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_recall_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(recall_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// f1Score_
+double f1Score_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_f1Score_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(f1Score_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// brier_
+double brier_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_brier_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(brier_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// mcc_
+double mcc_(NumericVector actual, NumericVector predicted, double cutoff);
+RcppExport SEXP ModelMetrics_mcc_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ Rcpp::traits::input_parameter< double >::type cutoff(cutoffSEXP);
+ rcpp_result_gen = Rcpp::wrap(mcc_(actual, predicted, cutoff));
+ return rcpp_result_gen;
+END_RCPP
+}
+// mae_
+double mae_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_mae_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(mae_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// ce_
+double ce_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_ce_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(ce_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// mse_
+double mse_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_mse_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(mse_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// msle_
+double msle_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_msle_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(msle_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// rmsle_
+double rmsle_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_rmsle_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(rmsle_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// rmse_
+double rmse_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_rmse_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(rmse_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// logLoss_
+double logLoss_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_logLoss_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(logLoss_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// mlogLoss_
+double mlogLoss_(NumericVector actual, NumericMatrix predicted);
+RcppExport SEXP ModelMetrics_mlogLoss_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericMatrix >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(mlogLoss_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
+// plogLoss_
+double plogLoss_(NumericVector actual, NumericVector predicted);
+RcppExport SEXP ModelMetrics_plogLoss_(SEXP actualSEXP, SEXP predictedSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP);
+ Rcpp::traits::input_parameter< NumericVector >::type predicted(predictedSEXP);
+ rcpp_result_gen = Rcpp::wrap(plogLoss_(actual, predicted));
+ return rcpp_result_gen;
+END_RCPP
+}
diff --git a/src/auc_.cpp b/src/auc_.cpp
new file mode 100644
index 0000000..f044bbe
--- /dev/null
+++ b/src/auc_.cpp
@@ -0,0 +1,29 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+
+// [[Rcpp::export]]
+double auc_(NumericVector actual, NumericVector predicted, NumericVector ranks) {
+
+ double n = actual.size();
+
+ double NPos = sum(actual == 1);
+ double NNeg = (actual.size() - NPos);
+
+ double sumranks = 0;
+
+ for(int i = 0; i < n; ++i) {
+ if (actual[i] == 1){
+ sumranks = sumranks + ranks[i];
+ }
+ }
+
+ double p1 = (sumranks - NPos*( NPos + 1 ) / 2);
+ double p2 = NPos*NNeg;
+
+ double auc = p1 / p2;
+ return auc ;
+
+}
+
+
diff --git a/src/confusionMatrix_.cpp b/src/confusionMatrix_.cpp
new file mode 100644
index 0000000..7d22d96
--- /dev/null
+++ b/src/confusionMatrix_.cpp
@@ -0,0 +1,119 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+NumericMatrix confusionMatrix_(NumericVector actual, NumericVector predicted, double cutoff) {
+
+ NumericMatrix cMat = NumericMatrix(Dimension(2, 2));
+
+ // True Negatives
+ cMat(0,0) = sum(predicted <= cutoff & actual == 0);
+ // False Negatives
+ cMat(0,1) = sum(predicted <= cutoff & actual == 1);
+ // False positives
+ cMat(1,0) = sum(predicted > cutoff & actual == 0);
+ // True positives
+ cMat(1,1) = sum(predicted > cutoff & actual == 1);
+
+ return cMat;
+
+}
+
+// [[Rcpp::export]]
+double ppv_(NumericVector actual, NumericVector predicted, double cutoff) {
+
+ NumericMatrix cMat = confusionMatrix_(actual, predicted, cutoff);
+ double Denom = (cMat(1,1) + cMat(1,0));
+ double ppv = 0;
+
+ if(Denom != 0){
+ ppv = cMat(1,1) / Denom;
+ }
+
+ return ppv;
+
+}
+
+
+// [[Rcpp::export]]
+double npv_(NumericVector actual, NumericVector predicted, double cutoff) {
+
+ NumericMatrix cMat = confusionMatrix_(actual, predicted, cutoff);
+ double Denom (cMat(0,0) + cMat(0,1));
+ double npv = 0;
+
+ if(Denom != 0){
+ npv = cMat(0,0) / Denom;
+ }
+
+ return npv;
+
+}
+
+
+// [[Rcpp::export]]
+double tnr_(NumericVector actual, NumericVector predicted, double cutoff) {
+
+ double TN = sum(predicted < cutoff & actual == 0);
+ double N = sum(actual == 0);
+ double tnr = TN/N;
+
+ return tnr;
+
+}
+
+
+
+// [[Rcpp::export]]
+double recall_(NumericVector actual, NumericVector predicted, double cutoff) {
+
+ NumericMatrix cMat = confusionMatrix_(actual, predicted, cutoff);
+
+ double recall = cMat(1,1) / (cMat(1,1) + cMat(0,1));
+ return recall;
+
+}
+
+// [[Rcpp::export]]
+double f1Score_(NumericVector actual, NumericVector predicted, double cutoff){
+
+ double p = ppv_(actual, predicted, cutoff);
+ double r = recall_(actual, predicted, cutoff);
+ double f1 = 0;
+
+ if(p + r != 0){
+ f1 = (2*p*r)/(p + r);
+ }
+
+ return f1;
+}
+
+
+// [[Rcpp::export]]
+double brier_(NumericVector actual, NumericVector predicted){
+
+ double brier = mean(pow(actual - predicted, 2));
+ return brier;
+}
+
+
+// [[Rcpp::export]]
+double mcc_(NumericVector actual, NumericVector predicted, double cutoff){
+
+ // True Negatives
+ double TN = sum(predicted < cutoff & actual == 0);
+ // False Negatives
+ double FN = sum(predicted < cutoff & actual == 1);
+ // False positives
+ double FP = sum(predicted >= cutoff & actual == 0);
+ // True positives
+ double TP = sum(predicted >= cutoff & actual == 1);
+
+ double numerator = ((TP*TN) - (FP*FN));
+ double denom = sqrt((TP + FP)*(TP + FN)*(TN + FP)*(TN + FN));
+
+ double mcc = numerator/denom;
+ return mcc;
+}
+
+
diff --git a/src/error.cpp b/src/error.cpp
new file mode 100644
index 0000000..cc6867f
--- /dev/null
+++ b/src/error.cpp
@@ -0,0 +1,67 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+double mae_(NumericVector actual, NumericVector predicted) {
+ double mae = mean(abs(actual - predicted));
+ return mae;
+}
+
+
+// [[Rcpp::export]]
+double ce_(NumericVector actual, NumericVector predicted) {
+
+ double Rows = predicted.size();
+ double ErrorCount = 0;
+
+ for(int i = 0; i < Rows; ++i) {
+ if(actual(i) != predicted(i)) {
+ ErrorCount = ErrorCount + 1;
+ }
+ }
+
+ double ce = ErrorCount/Rows;
+ return ce;
+
+}
+
+
+// [[Rcpp::export]]
+double mse_(NumericVector actual, NumericVector predicted) {
+
+ NumericVector err = (actual-predicted);
+ double mse = mean(err*err);
+ return mse;
+
+}
+
+
+// [[Rcpp::export]]
+double msle_(NumericVector actual, NumericVector predicted) {
+
+ NumericVector logdiff = (log(1 + actual) - log(1 + predicted));
+ NumericVector le = logdiff*logdiff;
+
+ double msle = mean(le);
+ return msle;
+
+}
+
+
+// [[Rcpp::export]]
+double rmsle_(NumericVector actual, NumericVector predicted) {
+
+ double rmsle = sqrt(mse_(actual, predicted));
+ return rmsle;
+
+}
+
+
+// [[Rcpp::export]]
+double rmse_(NumericVector actual, NumericVector predicted) {
+
+ double rmse = sqrt(mse_(actual, predicted));
+ return rmse;
+
+}
+
diff --git a/src/logLoss_.cpp b/src/logLoss_.cpp
new file mode 100644
index 0000000..7fa8906
--- /dev/null
+++ b/src/logLoss_.cpp
@@ -0,0 +1,39 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+double logLoss_(NumericVector actual, NumericVector predicted) {
+
+ NumericVector ll = -1*(actual*log(predicted) + (1-actual)*log(1-predicted));
+ double logloss = mean(ll);
+ return logloss ;
+
+}
+
+
+// [[Rcpp::export]]
+double mlogLoss_(NumericVector actual, NumericMatrix predicted) {
+
+ double Rows = predicted.nrow();
+ double Cols = predicted.ncol();
+
+ NumericMatrix actualMat = NumericMatrix(Dimension(Rows, Cols));
+
+ for(int i = 0; i < Rows; ++i) {
+ actualMat(i, actual(i) - 1) = 1;
+ }
+
+ double mlogloss = (-1 / Rows) * sum(actualMat * log(predicted));
+ return mlogloss ;
+
+}
+
+
+// [[Rcpp::export]]
+double plogLoss_(NumericVector actual, NumericVector predicted) {
+
+ NumericVector pl = log(gamma(actual + 1)) + predicted - log(predicted) * actual;
+ double plogloss = mean(pl);
+ return plogloss ;
+
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..0ff8540
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(ModelMetrics)
+
+test_check("ModelMetrics")
diff --git a/tests/testthat/test_auc.R b/tests/testthat/test_auc.R
new file mode 100644
index 0000000..681419f
--- /dev/null
+++ b/tests/testthat/test_auc.R
@@ -0,0 +1,45 @@
+
+context("auc Tests")
+
+test_that("auc binary error", {
+
+ Levs = 8
+ Size = 100
+ y = sample(1:Levs, Size, replace = TRUE)
+
+ xm = matrix(runif(Levs*Size), ncol = Levs)
+ xm = xm/rowSums(xm)
+
+ expect_error(auc(y, xm)
+ , "auc only works for binary outcomes at this time")
+
+})
+
+
+test_that("mauc", {
+
+ Levs = 8
+ Size = 100
+ y = sample(1:Levs, Size, replace = TRUE)
+
+ xm = matrix(runif(Levs*Size), ncol = Levs)
+ xm = xm/rowSums(xm)
+ # no warnings
+ expect_silent(res1 <- mauc(y, xm))
+ # estimated
+ expect_true(!is.nan(res1$mauc))
+
+ expect_silent(res2 <- mauc(y, as.data.frame(xm)))
+ expect_true(res1$mauc == res2$mauc)
+ expect_true(all(res1$auc == res2$auc))
+
+ expect_silent(res3 <- mauc(as.character(y), as.data.frame(xm)))
+ expect_true(res1$mauc == res3$mauc)
+ expect_true(all(res1$auc == res3$auc))
+
+ expect_silent(res4 <- mauc(as.factor(y), as.data.frame(xm)))
+ expect_true(res1$mauc == res4$mauc)
+ expect_true(all(res1$auc == res4$auc))
+
+})
+
diff --git a/tests/testthat/test_calculations.R b/tests/testthat/test_calculations.R
new file mode 100644
index 0000000..d4f9f14
--- /dev/null
+++ b/tests/testthat/test_calculations.R
@@ -0,0 +1,113 @@
+
+context("Calculation Tests")
+data(testDF)
+glmModel <- glm(y ~ ., data=testDF, family="binomial")
+Preds <- predict(glmModel, type = 'response')
+
+
+test_that("logLoss returns correct values", {
+
+ expect_equal(logLoss(testDF$y, Preds), 0.1546854, tolerance = .000001)
+ expect_equal(logLoss(testDF$y, Preds, 'poisson'), 0.6910357, tolerance = .000001)
+
+})
+
+
+test_that("auc returns correct values", {
+
+ expect_equal(auc(testDF$y, Preds), 0.9872666, tolerance = .000001)
+ expect_equal(auc(c(testDF$y,testDF$y), c(Preds, Preds)), 0.9872666, tolerance = .000001)
+
+})
+
+
+test_that("rmse returns correct values", {
+
+ expect_equal(rmse(testDF$y, Preds), 0.2188343, tolerance = .000001)
+
+})
+
+
+test_that("mse returns correct values", {
+
+ expect_equal(mse(testDF$y, Preds), 0.04788846, tolerance = .000001)
+
+})
+
+
+test_that("ppv returns correct values", {
+
+ expect_equal(ppv(testDF$y, Preds, .5), 0.9365079, tolerance = .000001)
+ expect_equal(precision(testDF$y, Preds, .5), 0.9365079, tolerance = .000001)
+
+})
+
+
+test_that("npv returns correct values", {
+
+ expect_equal(npv(testDF$y, Preds, .5), 0.9189189, tolerance = .000001)
+
+})
+
+
+test_that("specificity returns correct values", {
+
+ tempTab <- table(testDF$y, Preds > .5)
+ SPC <- tempTab[1,1]/sum(tempTab[1,])
+
+ expect_equal(specificity(testDF$y, Preds, .5), SPC, tolerance = .000001)
+ expect_equal(tnr(testDF$y, Preds, .5), SPC, tolerance = .000001)
+
+})
+
+
+test_that("sensitivity returns correct values", {
+
+ expect_equal(recall(testDF$y, Preds, .5), 0.9516129, tolerance = .000001)
+ expect_equal(sensitivity(testDF$y, Preds, .5), 0.9516129, tolerance = .000001)
+ expect_equal(tpr(testDF$y, Preds, .5), 0.9516129, tolerance = .000001)
+
+})
+
+test_that("f1 score returns correct values", {
+
+ expect_equal(f1Score(testDF$y, Preds, .5), 0.944, tolerance = .000001)
+
+})
+
+test_that("mcc returns correct values", {
+
+ expect_equal(mcc(testDF$y, Preds, .5), 0.8508762, tolerance = .000001)
+
+})
+
+
+test_that("brier returns correct values", {
+
+ expect_equal(brier(testDF$y, Preds), 0.04788846, tolerance = .000001)
+
+})
+
+
+
+test_that("mae returns correct values", {
+
+ expect_equal(mae(testDF$y, Preds), 0.09440662, tolerance = .000001)
+
+})
+
+
+test_that("msle returns correct values", {
+
+ expect_equal(msle(testDF$y, Preds), 0.02318011, tolerance = .000001)
+
+})
+
+
+test_that("rmsle returns correct values", {
+
+ expect_equal(rmsle(testDF$y, Preds), 0.2188343, tolerance = .000001)
+
+})
+
+
diff --git a/tests/testthat/test_errors.R b/tests/testthat/test_errors.R
new file mode 100644
index 0000000..880ec50
--- /dev/null
+++ b/tests/testthat/test_errors.R
@@ -0,0 +1,15 @@
+context("Error Messages")
+
+
+test_that("Error messages are correct", {
+
+ Actual = sample(c(0,1), 10, replace = TRUE)
+ Predicted = runif(10)
+ expect_error(logLoss(Actual, Predicted, distribution = "exp")
+ ,'exp is not defined. Please use binomial or poisson')
+
+ expect_silent(logLoss(Actual, Predicted, distribution = "binomial"))
+
+ expect_silent(logLoss(Actual, Predicted, distribution = "poisson"))
+
+})
diff --git a/tests/testthat/test_logloss.R b/tests/testthat/test_logloss.R
new file mode 100644
index 0000000..69fbc0d
--- /dev/null
+++ b/tests/testthat/test_logloss.R
@@ -0,0 +1,92 @@
+
+context("logLoss Tests")
+
+test_that("mlogLoss character/factor actual", {
+
+ Levs = 8
+ Size = 100
+ y = sample(1:Levs, Size, replace = TRUE)
+
+ xm = matrix(runif(Levs*Size), ncol = Levs)
+ xm = xm/rowSums(xm)
+
+ m1 <- mlogLoss(y, xm)
+ m2 <- mlogLoss(as.character(y), xm)
+ m3 <- mlogLoss(as.factor(y), xm)
+
+ expect_true(m1 == m2)
+ expect_true(m1 == m3)
+
+})
+
+
+test_that("mlogLoss different classes", {
+
+ Levs = 8
+ Size = 100
+ y = sample(1:Levs, Size, replace = TRUE)
+
+ xm = matrix(runif(Levs*Size), ncol = Levs)
+ xm = xm/rowSums(xm)
+
+ # no warnings
+ expect_silent(res1 <- mlogLoss(y, xm))
+ # estimated
+ expect_true(!is.nan(res1))
+
+ expect_silent(res2 <- mlogLoss(y, as.data.frame(xm)))
+ expect_true(res1 == res2)
+ expect_true(all(res1 == res2))
+
+ expect_silent(res3 <- mlogLoss(as.character(y), as.data.frame(xm)))
+ expect_true(res1 == res3)
+ expect_true(all(res1 == res3))
+
+ expect_silent(res4 <- mlogLoss(as.factor(y), as.data.frame(xm)))
+ expect_true(res1 == res4)
+ expect_true(all(res1 == res4))
+
+})
+
+
+
+test_that("mauc", {
+
+ Levs = 8
+ Size = 100
+ y = sample(1:Levs, Size, replace = TRUE)
+
+ xm = matrix(runif(Levs*Size), ncol = Levs)
+ xm = xm/rowSums(xm)
+ # no warnings
+ expect_silent(res1 <- mauc(y, xm))
+ # estimated
+ expect_true(!is.nan(res1$mauc))
+
+ expect_silent(res2 <- mauc(y, as.data.frame(xm)))
+ expect_true(res1$mauc == res2$mauc)
+ expect_true(all(res1$auc == res2$auc))
+
+ expect_silent(res3 <- mauc(as.character(y), as.data.frame(xm)))
+ expect_true(res1$mauc == res3$mauc)
+ expect_true(all(res1$auc == res3$auc))
+
+ expect_silent(res4 <- mauc(as.factor(y), as.data.frame(xm)))
+ expect_true(res1$mauc == res4$mauc)
+ expect_true(all(res1$auc == res4$auc))
+
+})
+
+
+
+test_that("logLoss estimates with 0s and 1s as values", {
+
+ data(testDF)
+ glmModel <- glm(y ~ ., data=testDF, family="binomial")
+ Preds <- predict(glmModel, type = 'response')
+
+ Preds[1] = 0
+ Preds[2] = 1
+ logLoss(testDF$y, Preds)
+
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-modelmetrics.git
More information about the debian-science-commits
mailing list