ModelMetrics/0000755000176000001440000000000013634100033012662 5ustar ripleyusersModelMetrics/NAMESPACE0000644000176000001440000000340013324437276014120 0ustar ripleyusers# Generated by roxygen2: do not edit by hand S3method(auc,default) S3method(auc,gbm) S3method(auc,glm) S3method(auc,glmerMod) S3method(auc,randomForest) S3method(auc,rpart) S3method(brier,default) S3method(brier,gbm) S3method(brier,glm) S3method(brier,glmerMod) S3method(brier,randomForest) S3method(brier,rpart) S3method(ce,default) S3method(ce,gbm) S3method(ce,glm) S3method(ce,glmerMod) S3method(ce,lm) S3method(ce,randomForest) S3method(ce,rpart) S3method(gini,default) S3method(gini,gbm) S3method(gini,glm) S3method(gini,glmerMod) S3method(gini,randomForest) S3method(gini,rpart) S3method(logLoss,default) S3method(logLoss,gbm) S3method(logLoss,glm) S3method(logLoss,glmerMod) S3method(logLoss,randomForest) S3method(logLoss,rpart) S3method(mae,default) S3method(mae,gbm) S3method(mae,glm) S3method(mae,glmerMod) S3method(mae,randomForest) S3method(mae,rpart) S3method(mse,default) S3method(mse,glm) S3method(mse,lm) S3method(msle,default) S3method(msle,gbm) S3method(msle,glm) S3method(msle,glmerMod) S3method(msle,lm) S3method(msle,randomForest) S3method(msle,rpart) S3method(rmse,default) S3method(rmse,glm) S3method(rmse,lm) S3method(rmsle,default) S3method(rmsle,gbm) S3method(rmsle,glm) S3method(rmsle,glmerMod) S3method(rmsle,lm) S3method(rmsle,randomForest) S3method(rmsle,rpart) export(auc) export(brier) export(ce) export(confusionMatrix) export(f1Score) export(fScore) export(gini) export(kappa) 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) importFrom(data.table,frankv) importFrom(data.table,fsort) importFrom(stats,predict) useDynLib(ModelMetrics) ModelMetrics/README.md0000644000176000001440000000400313333323657014155 0ustar ripleyusers## ModelMetrics: Rapid Calculation of Model Metrics [![Build Status](https://travis-ci.org/JackStat/ModelMetrics.svg?branch=master)](https://travis-ci.org/JackStat/ModelMetrics) [![Build status](https://ci.appveyor.com/api/projects/status/evm55ctrlwp6fjs3/branch/master?svg=true)](https://ci.appveyor.com/project/JackStat/modelmetrics/branch/master) [![Coverage Status](https://coveralls.io/repos/github/JackStat/ModelMetrics/badge.svg?branch=master)](https://coveralls.io/github/JackStat/ModelMetrics?branch=master) [![Downloads](https://cranlogs.r-pkg.org/badges/ModelMetrics)](https://CRAN.R-project.org/package=ModelMetrics) Tyler Hunt thunt@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.030 # 2 pROC 50.359 # 3 ROCR 0.358 ``` ModelMetrics/data/0000755000176000001440000000000013324437276013615 5ustar ripleyusersModelMetrics/data/testDF.rda0000644000176000001440000000341113607123617015470 0ustar ripleyusersVy<%eyRP2+}0cT%MZ!mL!1Ydil2,Z˵޹%ۛS}ޜ;89bhKZ@ $Io  Hkao/oC#A@}^͇2"Y)|.S}8?|S|"ɇ= o]r=:nzh& uGpwNa_ua`1,{Cba`k\"H ͻk{trqK siܔ`dԹƓKg"ا6+ó5j.#H'rD #6r=[$Ojh$Lshq嵛uU=0{"Aq Ed">'}" y t4 xY*ĺpـq;up*L/ C>C#2׳6OLЌcg pzrz|ޠEKyAli%Ⲱwkw_=E#dOQܰ<'WpKUa.n2h_a/|H={AǠorx گtԀ50UC*̅5<;A*0"EEUQሪ8Dw~Lc0lXdڛ F[],לE]>X>E(E^i=i:D_vA&ULr [@o;~o_ah E--ǒvBI? ٵc3L6JݦlzO]p$tw™lO ,jq/2r_%u8^O5 q{ƞ.d"{=9o -am7eXg%NpXt{,dg4qMM@#tCtz*a&4i xnZy{:zv3.+%Fݣ[[HĶ\MKXTهZ/waJ_YyT5Lb7h_(zT|sr).s Lo7–p3=+D˅ȚTe cK~`Kv#~Z{,~| p e6A%G[yajE#GZ;;t2w9c\)! uQ*4ꥴs հ7MSQDh;Φ'}GG}b rssk ?D$YVTy૱\au ]KKKI+[uZnp7zModelMetrics/man/0000755000176000001440000000000013324437276013457 5ustar ripleyusersModelMetrics/man/f1Score.Rd0000644000176000001440000000057613324437276015260 0ustar ripleyusers% 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 } ModelMetrics/man/gini.Rd0000644000176000001440000000213713324437276014677 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/gini.R \name{gini} \alias{gini} \alias{gini.default} \alias{gini.glm} \alias{gini.randomForest} \alias{gini.glmerMod} \alias{gini.gbm} \alias{gini.rpart} \title{GINI Coefficient} \usage{ gini(...) \method{gini}{default}(actual, predicted, ...) \method{gini}{glm}(modelObject, ...) \method{gini}{randomForest}(modelObject, ...) \method{gini}{glmerMod}(modelObject, ...) \method{gini}{gbm}(modelObject, ...) \method{gini}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels. Can be \code{numeric, character, or factor}} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \description{ Calculates the GINI coefficient for a binary classifcation model } \examples{ data(testDF) glmModel <- glm(y ~ ., data = testDF, family="binomial") Preds <- predict(glmModel, type = 'response') gini(testDF$y, Preds) # using s3 method for glm gini(glmModel) } ModelMetrics/man/ce.Rd0000644000176000001440000000156313324437276014342 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ce.R \name{ce} \alias{ce} \alias{ce.default} \alias{ce.lm} \alias{ce.glm} \alias{ce.randomForest} \alias{ce.glmerMod} \alias{ce.gbm} \alias{ce.rpart} \title{Classification error} \usage{ ce(...) \method{ce}{default}(actual, predicted, ...) \method{ce}{lm}(modelObject, ...) \method{ce}{glm}(modelObject, ...) \method{ce}{randomForest}(modelObject, ...) \method{ce}{glmerMod}(modelObject, ...) \method{ce}{gbm}(modelObject, ...) \method{ce}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{lm, glm, randomForest, glmerMod, gbm, rpart}} } \description{ Calculates the classification error } ModelMetrics/man/npv.Rd0000644000176000001440000000110313324437276014544 0ustar ripleyusers% 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) } ModelMetrics/man/recall.Rd0000644000176000001440000000127013324437276015210 0ustar ripleyusers% 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) } ModelMetrics/man/kappa.Rd0000644000176000001440000000070413324437276015043 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ModelMetrics.R \name{kappa} \alias{kappa} \title{kappa statistic} \usage{ kappa(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 kappa statistic. Currently build to handle binary values in \code{actual} vector. } ModelMetrics/man/mauc.Rd0000644000176000001440000000176713324437276014706 0ustar ripleyusers% 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) } ModelMetrics/man/msle.Rd0000644000176000001440000000161713324437276014713 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/msle.R \name{msle} \alias{msle} \alias{msle.default} \alias{msle.lm} \alias{msle.glm} \alias{msle.randomForest} \alias{msle.glmerMod} \alias{msle.gbm} \alias{msle.rpart} \title{Mean Squared Log Error} \usage{ msle(...) \method{msle}{default}(actual, predicted, ...) \method{msle}{lm}(modelObject, ...) \method{msle}{glm}(modelObject, ...) \method{msle}{randomForest}(modelObject, ...) \method{msle}{glmerMod}(modelObject, ...) \method{msle}{gbm}(modelObject, ...) \method{msle}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \description{ Calculates the mean square log error } ModelMetrics/man/mlogLoss.Rd0000644000176000001440000000064513324437276015552 0ustar ripleyusers% 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 } ModelMetrics/man/mcc.Rd0000644000176000001440000000063413324437276014513 0ustar ripleyusers% 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 } ModelMetrics/man/mae.Rd0000644000176000001440000000150513324437276014511 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mae.R \name{mae} \alias{mae} \alias{mae.default} \alias{mae.glm} \alias{mae.randomForest} \alias{mae.glmerMod} \alias{mae.gbm} \alias{mae.rpart} \title{Mean absolute error} \usage{ mae(...) \method{mae}{default}(actual, predicted, ...) \method{mae}{glm}(modelObject, ...) \method{mae}{randomForest}(modelObject, ...) \method{mae}{glmerMod}(modelObject, ...) \method{mae}{gbm}(modelObject, ...) \method{mae}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \description{ Calculates the mean absolute error } ModelMetrics/man/rmse.Rd0000644000176000001440000000141613324437276014716 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mse.R \name{rmse} \alias{rmse} \alias{rmse.default} \alias{rmse.lm} \alias{rmse.glm} \title{Root-Mean Square Error} \usage{ rmse(...) \method{rmse}{default}(actual, predicted, ...) \method{rmse}{lm}(modelObject, ...) \method{rmse}{glm}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{lm}} } \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) } ModelMetrics/man/auc.Rd0000644000176000001440000000212613324437276014517 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/auc.R \name{auc} \alias{auc} \alias{auc.default} \alias{auc.glm} \alias{auc.randomForest} \alias{auc.glmerMod} \alias{auc.gbm} \alias{auc.rpart} \title{Area Under the Curve} \usage{ auc(...) \method{auc}{default}(actual, predicted, ...) \method{auc}{glm}(modelObject, ...) \method{auc}{randomForest}(modelObject, ...) \method{auc}{glmerMod}(modelObject, ...) \method{auc}{gbm}(modelObject, ...) \method{auc}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels. Can be \code{numeric, character, or factor}} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \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) # using s3 method for glm auc(glmModel) } ModelMetrics/man/testDF.Rd0000644000176000001440000000026513324437276015142 0ustar ripleyusers% 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 } ModelMetrics/man/confusionMatrix.Rd0000644000176000001440000000067113324437276017142 0ustar ripleyusers% 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. } ModelMetrics/man/logLoss.Rd0000644000176000001440000000233213324437276015370 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/logLoss.R \name{logLoss} \alias{logLoss} \alias{logLoss.default} \alias{logLoss.glm} \alias{logLoss.randomForest} \alias{logLoss.glmerMod} \alias{logLoss.gbm} \alias{logLoss.rpart} \title{Log Loss} \usage{ logLoss(...) \method{logLoss}{default}(actual, predicted, distribution = "binomial", ...) \method{logLoss}{glm}(modelObject, ...) \method{logLoss}{randomForest}(modelObject, ...) \method{logLoss}{glmerMod}(modelObject, ...) \method{logLoss}{gbm}(modelObject, ...) \method{logLoss}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \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}} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \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) # using s3 method for glm logLoss(glmModel) } ModelMetrics/man/ppv.Rd0000644000176000001440000000117413367345375014563 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ModelMetrics.R \name{ppv} \alias{ppv} \alias{precision} \title{Positive 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 Positives / (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) } ModelMetrics/man/fScore.Rd0000644000176000001440000000104613324437276015170 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ModelMetrics.R \name{fScore} \alias{fScore} \title{F Score} \usage{ fScore(actual, predicted, cutoff = 0.5, beta = 1) } \arguments{ \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{cutoff}{A cutoff for the predicted values} \item{beta}{the desired beta value (lower increases weight of precision over recall). Defaults to 1} } \description{ Calculates the F score and allows different specifications of the beta value (F0.5) } ModelMetrics/man/rmsle.Rd0000644000176000001440000000164613324437276015077 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rmsle.R \name{rmsle} \alias{rmsle} \alias{rmsle.default} \alias{rmsle.lm} \alias{rmsle.glm} \alias{rmsle.randomForest} \alias{rmsle.glmerMod} \alias{rmsle.gbm} \alias{rmsle.rpart} \title{Root Mean Squared Log Error} \usage{ rmsle(...) \method{rmsle}{default}(actual, predicted, ...) \method{rmsle}{lm}(modelObject, ...) \method{rmsle}{glm}(modelObject, ...) \method{rmsle}{randomForest}(modelObject, ...) \method{rmsle}{glmerMod}(modelObject, ...) \method{rmsle}{gbm}(modelObject, ...) \method{rmsle}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \description{ Calculates the mean square log error } ModelMetrics/man/mse.Rd0000644000176000001440000000137213324437276014535 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mse.R \name{mse} \alias{mse} \alias{mse.default} \alias{mse.lm} \alias{mse.glm} \title{Mean Square Error} \usage{ mse(...) \method{mse}{default}(actual, predicted, ...) \method{mse}{lm}(modelObject, ...) \method{mse}{glm}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{lm}} } \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) } ModelMetrics/man/brier.Rd0000644000176000001440000000152513324437276015054 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/brier.R \name{brier} \alias{brier} \alias{brier.default} \alias{brier.glm} \alias{brier.randomForest} \alias{brier.glmerMod} \alias{brier.gbm} \alias{brier.rpart} \title{Brier Score} \usage{ brier(...) \method{brier}{default}(actual, predicted, ...) \method{brier}{glm}(modelObject, ...) \method{brier}{randomForest}(modelObject, ...) \method{brier}{glmerMod}(modelObject, ...) \method{brier}{gbm}(modelObject, ...) \method{brier}{rpart}(modelObject, ...) } \arguments{ \item{\dots}{additional parameters to be passed the the s3 methods} \item{actual}{A vector of the labels} \item{predicted}{A vector of predicted values} \item{modelObject}{the model object. Currently supported \code{glm, randomForest, glmerMod, gbm}} } \description{ Calculates the Brier score } ModelMetrics/man/tnr.Rd0000644000176000001440000000120613324437276014550 0ustar ripleyusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ModelMetrics.R \name{tnr} \alias{tnr} \alias{specificity} \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) } ModelMetrics/DESCRIPTION0000644000176000001440000000131213634100033014365 0ustar ripleyusersPackage: ModelMetrics Title: Rapid Calculation of Model Metrics Version: 1.2.2.2 Date: 2018-11-03 Authors@R: person("Tyler", "Hunt", email = "thunt@snapfinance.com", role = c("aut", "cre")) Description: Collection of metrics for evaluating models written in C++ using 'Rcpp'. Popular metrics include area under the curve, log loss, root mean square error, etc. Depends: R (>= 3.2.2) License: GPL (>= 2) Encoding: UTF-8 LazyData: true LinkingTo: Rcpp Imports: Rcpp, data.table RoxygenNote: 6.0.1 Suggests: testthat NeedsCompilation: yes Packaged: 2020-03-17 06:58:01 UTC; ripley Author: Tyler Hunt [aut, cre] Maintainer: Tyler Hunt Repository: CRAN Date/Publication: 2020-03-17 07:45:31 UTC ModelMetrics/tests/0000755000176000001440000000000013324437276014046 5ustar ripleyusersModelMetrics/tests/testthat/0000755000176000001440000000000013634100033015664 5ustar ripleyusersModelMetrics/tests/testthat/test_calculations.R0000644000176000001440000000744413324437276021562 0ustar ripleyusers 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) expect_equal(logLoss(glmModel), 0.1546854, 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) expect_equal(auc(glmModel), 0.9872666, tolerance = .000001) }) test_that("gini returns correct values", { expect_equal(gini(testDF$y, Preds), 0.9745332, tolerance = .000001) expect_equal(gini(c(testDF$y,testDF$y), c(Preds, Preds)), 0.9745332, tolerance = .000001) expect_equal(gini(glmModel), 0.9745332, tolerance = .000001) }) test_that("rmse returns correct values", { expect_equal(rmse(testDF$y, Preds), 0.2188343, tolerance = .000001) expect_equal(rmse(glmModel), 0.2188343, tolerance = .000001) }) test_that("mse returns correct values", { expect_equal(mse(testDF$y, Preds), 0.04788846, tolerance = .000001) expect_equal(mse(glmModel), 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("f1 score and F score agree with beta 1 (default value)", { expect_equal(f1Score(testDF$y, Preds, .5), fScore(testDF$y, Preds, .5, 1), 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) expect_equal(brier(glmModel), 0.04788846, tolerance = .000001) }) test_that("mae returns correct values", { expect_equal(mae(testDF$y, Preds), 0.09440662, tolerance = .000001) expect_equal(mae(glmModel), 0.09440662, tolerance = .000001) }) test_that("msle returns correct values", { expect_equal(msle(testDF$y, Preds), 0.02318011, tolerance = .000001) expect_equal(msle(glmModel), 0.02318011, tolerance = .000001) }) test_that("rmsle returns correct values", { expect_equal(rmsle(testDF$y, Preds), 0.1522501, tolerance = .000001) expect_equal(rmsle(glmModel), 0.1522501, tolerance = .000001) }) test_that("rmsle returns correct values", { A <- c(rep(1, 63), rep(0, 31)) B <- c(rep(1, 61), rep(0, 25), rep(1, 6), rep(0, 2)) tab <- table(A, B) a = tab[2,2] b = tab[2,1] c = tab[1,2] d = tab[1,1] marginA = ((a + b)*(a + c))/(a + b + c + d) marginB = ((c + d)*(b + d))/(a + b + c + d) Pe = (marginA + marginB)/(a + b + c + d) Po = (a + d)/(a + b + c + d) manualKappa = (Po - Pe)/(1 - Pe) expect_equal(kappa(A, B), manualKappa, tolerance = .000001) }) ModelMetrics/tests/testthat/test_auc.R0000644000176000001440000000170413324437276017642 0ustar ripleyusers 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)) }) ModelMetrics/tests/testthat/test_errors.R0000644000176000001440000000064613324437276020412 0ustar ripleyuserscontext("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")) }) ModelMetrics/tests/testthat/test_logloss.R0000644000176000001440000000551113324437276020554 0ustar ripleyusers 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 taken from caret written by Max Kuhn eps <- 1e-15 classes <- LETTERS[1:3] test_dat1 <- data.frame(obs = c("A", "A", "A", "B", "B", "C"), pred = c("A", "A", "A", "B", "B", "C"), A = c(1, .80, .51, .1, .2, .3), B = c(0, .05, .29, .8, .6, .3), C = c(0, .15, .20, .1, .2, .4)) expected1 <- log(1-eps) + log(.8) + log(.51) + log(.8) + log(.6) + log(.4) expected1 <- -expected1/nrow(test_dat1) result1 <- mlogLoss(test_dat1$obs, test_dat1[,3:5]) # test_dat2 <- test_dat1 # test_dat2$A[1] <- NA # # expected2 <- log(.8) + log(.51) + log(.8) + log(.6) + log(.4) # expected2 <- c(logLoss = -expected2/sum(complete.cases(test_dat2))) # result2 <- mlogLoss(test_dat2$obs, test_dat2[,3:5]) expect_equal(result1, expected1) # expect_equal(result2, expected2) # expect_equal(result3, expected3) }) 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) }) ModelMetrics/tests/testthat.R0000644000176000001440000000010413324437276016024 0ustar ripleyuserslibrary(testthat) library(ModelMetrics) test_check("ModelMetrics") ModelMetrics/src/0000755000176000001440000000000013634072371013466 5ustar ripleyusersModelMetrics/src/gini_.cpp0000644000176000001440000000123313634072277015263 0ustar ripleyusers#include #ifdef _OPENMP #include #endif using namespace Rcpp; // Assumes that actual is sorted by predicted values // [[Rcpp::export]] double gini_(NumericVector actual) { double n = actual.size(); double pop_delta = 1/n; double total_loss = sum(actual); NumericVector accum_loss = actual/total_loss; Rcpp::NumericVector giniVector = Rcpp::no_init_vector(n); #pragma omp parallel for for(int i = 0; i < (int) n; ++i) { if(i == 0){ giniVector[i] = (accum_loss[i] - pop_delta); } else { giniVector[i] = giniVector[i-1] + (accum_loss[i] - pop_delta); } } double gini = sum(giniVector)/n; return gini; } ModelMetrics/src/auc_.cpp0000644000176000001440000000466613634072255015116 0ustar ripleyusers#include #ifdef _OPENMP #include #endif using namespace Rcpp; class Comparator { private: const Rcpp::NumericVector& ref; bool is_na(double x) const { return Rcpp::traits::is_na(x); } public: Comparator(const Rcpp::NumericVector& ref_) : ref(ref_) {} bool operator()(const int ilhs, const int irhs) const { double lhs = ref[ilhs], rhs = ref[irhs]; if (is_na(lhs)) return false; if (is_na(rhs)) return true; return lhs < rhs; } }; // [[Rcpp::export]] NumericVector avg_rank(Rcpp::NumericVector x) { R_xlen_t sz = x.size(); Rcpp::IntegerVector w = Rcpp::seq(0, sz - 1); std::sort(w.begin(), w.end(), Comparator(x)); Rcpp::NumericVector r = Rcpp::no_init_vector(sz); R_xlen_t n; #pragma omp parallel for for (int i = 0; i < sz; i += n) { n = 1; while (i + n < sz && x[w[i]] == x[w[i + n]]) ++n; #pragma omp parallel for for (R_xlen_t k = 0; k < n; k++) { r[w[i + k]] = i + (n + 1) / 2.; } } return r; } // [[Rcpp::export]] double auc_(NumericVector actual, NumericVector predicted) { double n = actual.size(); NumericVector Ranks = avg_rank(predicted); double NPos = sum(actual == 1); double NNeg = (n - NPos); double sumranks = 0; #pragma omp parallel for for(int i = 0; i < (int) 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 ; } // [[Rcpp::export]] double auc2_(NumericVector actual, NumericVector predicted) { NumericVector Ranks = avg_rank(predicted); double NPos = sum(actual == 1); double NNeg = (actual.size() - NPos); NumericVector xRanks = Ranks[actual == 1]; double sumranks = sum(xRanks); double p1 = (sumranks - NPos*( NPos + 1 ) / 2); double p2 = NPos*NNeg; double auc = p1 / p2; return auc ; } // [[Rcpp::export]] double auc3_(NumericVector actual, NumericVector predicted, NumericVector ranks) { double n = actual.size(); double NPos = sum(actual == 1); double NNeg = (n - NPos); double sumranks = 0; #pragma omp parallel for for(int i = 0; i < (int) 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; } ModelMetrics/src/error.cpp0000644000176000001440000000232013367347325015327 0ustar ripleyusers#include 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; #pragma omp parallel for for(int i = 0; i < (int) 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(msle_(actual, predicted)); return rmsle; } // [[Rcpp::export]] double rmse_(NumericVector actual, NumericVector predicted) { double rmse = sqrt(mse_(actual, predicted)); return rmse; } ModelMetrics/src/logLoss_.cpp0000644000176000001440000000160713367347325015766 0ustar ripleyusers#include 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)); #pragma omp parallel for for(int i = 0; i < (int) 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 ; } ModelMetrics/src/confusionMatrix_.cpp0000644000176000001440000000702113367347325017530 0ustar ripleyusers#include 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 fScore_(NumericVector actual, NumericVector predicted, double cutoff, double beta){ double p = ppv_(actual, predicted, cutoff); double r = recall_(actual, predicted, cutoff); double F = 0; if(p + r != 0){ F = ((beta*beta + 1)*(p * r / (beta*beta*p + r))); } return F; } // [[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; } // [[Rcpp::export]] double kappa_(NumericVector actual, NumericVector predicted, double cutoff){ // True Negatives d double TN = sum((predicted < cutoff) & (actual == 0)); // False Negatives - c double FN = sum((predicted < cutoff) & (actual == 1)); // False positives - b double FP = sum((predicted >= cutoff) & (actual == 0)); // True positives - a double TP = sum((predicted >= cutoff) & (actual == 1)); double N = (TP + FP + FN + TN); double po = (TP + TN)/N; double margin_a = ((TP + FP)*(TP + FN))/N; double margin_b = ((FN + TN)*(FP + TN))/N; double pe = (margin_a + margin_b)/N; double kappa = (po - pe)/(1 - pe); return kappa; } ModelMetrics/src/RcppExports.cpp0000644000176000001440000003461213367347325016500 0ustar ripleyusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // avg_rank NumericVector avg_rank(Rcpp::NumericVector x); RcppExport SEXP _ModelMetrics_avg_rank(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::NumericVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(avg_rank(x)); return rcpp_result_gen; END_RCPP } // auc_ double auc_(NumericVector actual, NumericVector predicted); RcppExport SEXP _ModelMetrics_auc_(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(auc_(actual, predicted)); return rcpp_result_gen; END_RCPP } // auc2_ double auc2_(NumericVector actual, NumericVector predicted); RcppExport SEXP _ModelMetrics_auc2_(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(auc2_(actual, predicted)); return rcpp_result_gen; END_RCPP } // auc3_ double auc3_(NumericVector actual, NumericVector predicted, NumericVector ranks); RcppExport SEXP _ModelMetrics_auc3_(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(auc3_(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 } // fScore_ double fScore_(NumericVector actual, NumericVector predicted, double cutoff, double beta); RcppExport SEXP _ModelMetrics_fScore_(SEXP actualSEXP, SEXP predictedSEXP, SEXP cutoffSEXP, SEXP betaSEXP) { 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::traits::input_parameter< double >::type beta(betaSEXP); rcpp_result_gen = Rcpp::wrap(fScore_(actual, predicted, cutoff, beta)); 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 } // kappa_ double kappa_(NumericVector actual, NumericVector predicted, double cutoff); RcppExport SEXP _ModelMetrics_kappa_(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(kappa_(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 } // gini_ double gini_(NumericVector actual); RcppExport SEXP _ModelMetrics_gini_(SEXP actualSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type actual(actualSEXP); rcpp_result_gen = Rcpp::wrap(gini_(actual)); 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 } static const R_CallMethodDef CallEntries[] = { {"_ModelMetrics_avg_rank", (DL_FUNC) &_ModelMetrics_avg_rank, 1}, {"_ModelMetrics_auc_", (DL_FUNC) &_ModelMetrics_auc_, 2}, {"_ModelMetrics_auc2_", (DL_FUNC) &_ModelMetrics_auc2_, 2}, {"_ModelMetrics_auc3_", (DL_FUNC) &_ModelMetrics_auc3_, 3}, {"_ModelMetrics_confusionMatrix_", (DL_FUNC) &_ModelMetrics_confusionMatrix_, 3}, {"_ModelMetrics_ppv_", (DL_FUNC) &_ModelMetrics_ppv_, 3}, {"_ModelMetrics_npv_", (DL_FUNC) &_ModelMetrics_npv_, 3}, {"_ModelMetrics_tnr_", (DL_FUNC) &_ModelMetrics_tnr_, 3}, {"_ModelMetrics_recall_", (DL_FUNC) &_ModelMetrics_recall_, 3}, {"_ModelMetrics_fScore_", (DL_FUNC) &_ModelMetrics_fScore_, 4}, {"_ModelMetrics_f1Score_", (DL_FUNC) &_ModelMetrics_f1Score_, 3}, {"_ModelMetrics_brier_", (DL_FUNC) &_ModelMetrics_brier_, 2}, {"_ModelMetrics_mcc_", (DL_FUNC) &_ModelMetrics_mcc_, 3}, {"_ModelMetrics_kappa_", (DL_FUNC) &_ModelMetrics_kappa_, 3}, {"_ModelMetrics_mae_", (DL_FUNC) &_ModelMetrics_mae_, 2}, {"_ModelMetrics_ce_", (DL_FUNC) &_ModelMetrics_ce_, 2}, {"_ModelMetrics_mse_", (DL_FUNC) &_ModelMetrics_mse_, 2}, {"_ModelMetrics_msle_", (DL_FUNC) &_ModelMetrics_msle_, 2}, {"_ModelMetrics_rmsle_", (DL_FUNC) &_ModelMetrics_rmsle_, 2}, {"_ModelMetrics_rmse_", (DL_FUNC) &_ModelMetrics_rmse_, 2}, {"_ModelMetrics_gini_", (DL_FUNC) &_ModelMetrics_gini_, 1}, {"_ModelMetrics_logLoss_", (DL_FUNC) &_ModelMetrics_logLoss_, 2}, {"_ModelMetrics_mlogLoss_", (DL_FUNC) &_ModelMetrics_mlogLoss_, 2}, {"_ModelMetrics_plogLoss_", (DL_FUNC) &_ModelMetrics_plogLoss_, 2}, {NULL, NULL, 0} }; RcppExport void R_init_ModelMetrics(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } ModelMetrics/R/0000755000176000001440000000000013607123611013072 5ustar ripleyusersModelMetrics/R/logLoss.R0000644000176000001440000000446213324437276014660 0ustar ripleyusers#' @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} #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @examples #' data(testDF) #' glmModel <- glm(y ~ ., data = testDF, family="binomial") #' Preds <- predict(glmModel, type = 'response') #' #' logLoss(testDF$y, Preds) #' # using s3 method for glm #' logLoss(glmModel) #' #' @export logLoss <- function(...){ UseMethod("logLoss") } #' @rdname logLoss #' @export logLoss.default <- 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")) } } #' @rdname logLoss #' @export logLoss.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } logLoss.default(actual, predicted, distribution = family) } #' @importFrom stats predict #' @rdname logLoss #' @export logLoss.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] logLoss.default(actual, predicted) } #' @rdname logLoss #' @export logLoss.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu logLoss.default(actual, predicted) } #' @rdname logLoss #' @export logLoss.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit logLoss.default(actual, predicted) } #' @rdname logLoss #' @export logLoss.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) logLoss.default(actual, predicted) } ModelMetrics/R/mae.R0000644000176000001440000000303513324437276013773 0ustar ripleyusers#' @title Mean absolute error #' @description Calculates the mean absolute error #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @export mae <- function(...){ UseMethod("mae") } #' @rdname mae #' @export mae.default <- function(actual, predicted, ...){ mae_(actual, predicted) } #' @rdname mae #' @export mae.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } mae.default(actual, predicted) } #' @rdname mae #' @export mae.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] mae.default(actual, predicted) } #' @rdname mae #' @export mae.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu mae.default(actual, predicted) } #' @rdname mae #' @export mae.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit mae.default(actual, predicted) } #' @rdname mae #' @export mae.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) mae.default(actual, predicted) } ModelMetrics/R/brier.R0000644000176000001440000000306513324437276014337 0ustar ripleyusers#' @title Brier Score #' @description Calculates the Brier score #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @export brier <- function(...){ UseMethod("brier") } #' @rdname brier #' @export brier.default <- function(actual, predicted, ...){ brier_(actual, predicted) } #' @rdname brier #' @export brier.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } brier.default(actual, predicted) } #' @rdname brier #' @export brier.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] brier.default(actual, predicted) } #' @rdname brier #' @export brier.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu brier.default(actual, predicted) } #' @rdname brier #' @export brier.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit brier.default(actual, predicted) } #' @rdname brier #' @export brier.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) brier.default(actual, predicted) } ModelMetrics/R/ce.R0000644000176000001440000000332113324437276013616 0ustar ripleyusers#' @title Classification error #' @description Calculates the classification error #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{lm, glm, randomForest, glmerMod, gbm, rpart} #' #' @export ce <- function(...){ UseMethod("ce") } #' @rdname ce #' @export ce.default <- function(actual, predicted, ...){ ce_(actual, predicted) } #' @rdname ce #' @export ce.lm <- function(modelObject, ...){ predicted <- modelObject$fitted.values actual <- modelObject$residuals + predicted ce.default(actual, predicted) } #' @rdname ce #' @export ce.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } ce.default(actual, predicted) } #' @rdname ce #' @export ce.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] ce.default(actual, predicted) } #' @rdname ce #' @export ce.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu ce.default(actual, predicted) } #' @rdname ce #' @export ce.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit ce.default(actual, predicted) } #' @rdname ce #' @export ce.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) msle.default(actual, predicted) } ModelMetrics/R/binaryChecks.R0000644000176000001440000000022213324437276015631 0ustar ripleyusers binaryChecks <- function(x, method){ if(length(unique(x)) > 2){ stop(paste(method, "only works for binary outcomes at this time")) } } ModelMetrics/R/gini.R0000644000176000001440000000415613324437276014164 0ustar ripleyusers#' @title GINI Coefficient #' #' @description Calculates the GINI coefficient 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 #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @examples #' data(testDF) #' glmModel <- glm(y ~ ., data = testDF, family="binomial") #' Preds <- predict(glmModel, type = 'response') #' #' gini(testDF$y, Preds) #' # using s3 method for glm #' gini(glmModel) #' #' @export gini <- function(...){ UseMethod("gini") } #' @rdname gini #' @importFrom data.table fsort #' @export gini.default <- function(actual, predicted, ...){ df1 <- data.frame(actual = actual, predicted = predicted) df2 <- data.frame(actual = actual, predicted = actual) df1 <- df1[order(-df1$predicted),] df2 <- df2[order(-df2$actual),] gini <- gini_(df1$actual)/gini_(df2$actual) return(gini) } #' @rdname gini #' @export gini.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } gini.default(actual, predicted) } #' @importFrom stats predict #' @rdname gini #' @export gini.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] gini.default(actual, predicted) } #' @rdname gini #' @export gini.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu gini.default(actual, predicted) } #' @rdname gini #' @export gini.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit gini.default(actual, predicted) } #' @rdname gini #' @export gini.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) gini.default(actual, predicted) } ModelMetrics/R/RcppExports.R0000644000176000001440000000614713324437276015531 0ustar ripleyusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 avg_rank <- function(x) { .Call('_ModelMetrics_avg_rank', PACKAGE = 'ModelMetrics', x) } auc_ <- function(actual, predicted) { .Call('_ModelMetrics_auc_', PACKAGE = 'ModelMetrics', actual, predicted) } auc2_ <- function(actual, predicted) { .Call('_ModelMetrics_auc2_', PACKAGE = 'ModelMetrics', actual, predicted) } auc3_ <- function(actual, predicted, ranks) { .Call('_ModelMetrics_auc3_', 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) } fScore_ <- function(actual, predicted, cutoff, beta) { .Call('_ModelMetrics_fScore_', PACKAGE = 'ModelMetrics', actual, predicted, cutoff, beta) } 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) } kappa_ <- function(actual, predicted, cutoff) { .Call('_ModelMetrics_kappa_', 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) } gini_ <- function(actual) { .Call('_ModelMetrics_gini_', PACKAGE = 'ModelMetrics', actual) } 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) } ModelMetrics/R/mse.R0000644000176000001440000000450513324437276014020 0ustar ripleyusers#' @title Mean Square Error #' @description Calculates the mean square error #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{lm} #' #' @examples #' data(testDF) #' glmModel <- glm(y ~ ., data = testDF, family="binomial") #' Preds <- predict(glmModel, type = 'response') #' #' mse(testDF$y, Preds) #' #' @export mse <- function(...){ UseMethod("mse") } #' @rdname mse #' @export mse.default <- function(actual, predicted, ...){ mse_(actual, predicted) } #' @rdname mse #' @export mse.lm <- function(modelObject, ...){ predicted <- modelObject$fitted.values actual <- modelObject$residuals + predicted mse.default(actual, predicted) } #' @rdname mse #' @export mse.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } mse.default(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 #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{lm} #' #' @examples #' data(testDF) #' glmModel <- glm(y ~ ., data = testDF, family="binomial") #' Preds <- predict(glmModel, type = 'response') #' #' rmse(testDF$y, Preds) #' #' @export rmse <- function(...){ UseMethod("rmse") } #' @rdname rmse #' @export rmse.default <- function(actual, predicted, ...){ rmse_(actual, predicted) } #' @rdname rmse #' @export rmse.lm <- function(modelObject, ...){ predicted <- modelObject$fitted.values actual <- modelObject$residuals + predicted rmse.default(actual, predicted) } #' @rdname rmse #' @export rmse.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } rmse.default(actual, predicted) } ModelMetrics/R/rmsle.R0000644000176000001440000000342113324437276014352 0ustar ripleyusers#' @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 #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @export rmsle <- function(...){ UseMethod("rmsle") } #' @rdname rmsle #' @export rmsle.default <- function(actual, predicted, ...){ rmsle_(actual, predicted) } #' @rdname rmsle #' @export rmsle.lm <- function(modelObject, ...){ predicted <- modelObject$fitted.values actual <- modelObject$residuals + predicted rmsle.default(actual, predicted) } #' @rdname rmsle #' @export rmsle.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } rmsle.default(actual, predicted) } #' @rdname rmsle #' @export rmsle.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] rmsle.default(actual, predicted) } #' @rdname rmsle #' @export rmsle.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu rmsle.default(actual, predicted) } #' @rdname rmsle #' @export rmsle.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit rmsle.default(actual, predicted) } #' @rdname rmsle #' @export rmsle.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) rmsle.default(actual, predicted) } ModelMetrics/R/msle.R0000644000176000001440000000336513324437276014177 0ustar ripleyusers#' @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 #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @export msle <- function(...){ UseMethod("msle") } #' @rdname msle #' @export msle.default <- function(actual, predicted, ...){ msle_(actual, predicted) } #' @rdname msle #' @export msle.lm <- function(modelObject, ...){ predicted <- modelObject$fitted.values actual <- modelObject$residuals + predicted msle.default(actual, predicted) } #' @rdname msle #' @export msle.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } msle.default(actual, predicted) } #' @rdname msle #' @export msle.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] msle.default(actual, predicted) } #' @rdname msle #' @export msle.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu msle.default(actual, predicted) } #' @rdname msle #' @export msle.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit msle.default(actual, predicted) } #' @rdname msle #' @export msle.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) msle.default(actual, predicted) } ModelMetrics/R/auc.R0000644000176000001440000000430413324437276014001 0ustar ripleyusers#' @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 #' @param \dots additional parameters to be passed the the s3 methods #' @param modelObject the model object. Currently supported \code{glm, randomForest, glmerMod, gbm} #' #' @examples #' data(testDF) #' glmModel <- glm(y ~ ., data = testDF, family="binomial") #' Preds <- predict(glmModel, type = 'response') #' #' auc(testDF$y, Preds) #' # using s3 method for glm #' auc(glmModel) #' #' #' @export auc <- function(...){ UseMethod("auc") } #' @importFrom data.table frankv #' @rdname auc #' @export auc.default <- function(actual, predicted, ...){ binaryChecks(actual, 'auc') if (inherits(actual, 'factor')) { actual <- as.integer(actual) - 1L } else if (inherits(actual, 'character')) { actual <- as.integer(as.factor(actual)) - 1L } if(length(actual > 10000)){ ranks = frankv(predicted) AUC <- auc3_(actual, predicted, ranks) } else { AUC <- auc_(actual, predicted) } return(AUC) } #' @rdname auc #' @export auc.glm <- function(modelObject, ...){ family <- family(modelObject)[[1]] if(any(family %in% c('binomial', 'poisson'))){ actual <- modelObject$y predicted <- modelObject$fitted.values } else { stop(paste0("family: ", family, " is not currently supported")) } auc.default(actual, predicted) } #' @rdname auc #' @export auc.randomForest <- function(modelObject, ...){ actual <- as.numeric(modelObject$y) - 1 predicted <- predict(modelObject, type = 'prob')[,2] auc.default(actual, predicted) } #' @rdname auc #' @export auc.glmerMod <- function(modelObject, ...){ actual <- modelObject@resp$y predicted <- modelObject@resp$mu auc.default(actual, predicted) } #' @rdname auc #' @export auc.gbm <- function(modelObject, ...){ actual <- modelObject$data$y predicted <- modelObject$fit auc.default(actual, predicted) } #' @rdname auc #' @export auc.rpart <- function(modelObject, ...){ actual <- modelObject$y predicted <- predict(modelObject) auc.default(actual, predicted) } ModelMetrics/R/ModelMetrics.R0000644000176000001440000001516113607123611015610 0ustar ripleyusers#' @useDynLib ModelMetrics #' @importFrom Rcpp sourceCpp NULL #' Test data #' #' @name testDF #' @docType data NULL #' @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(inherits(actual, c('factor', 'character'))){ actual = as.numeric(as.factor(actual)) } if(inherits(predicted, c('data.frame'))){ predicted = as.matrix(predicted) } eps <- 1e-15 predicted = pmax(pmin(predicted, 1 - eps), eps) mlogLoss_(actual, predicted) } #' @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 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 Positive Predictive Value #' #' @description True Positives / (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 F Score #' @description Calculates the F score and allows different specifications of the beta value (F0.5) #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param cutoff A cutoff for the predicted values #' @param beta the desired beta value (lower increases weight of precision over recall). Defaults to 1 #' #' @export fScore <- function(actual, predicted, cutoff = .5, beta = 1){ fScore_(actual, predicted, cutoff, beta) } #' @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) } #' @title kappa statistic #' #' @description Calculates kappa statistic. Currently build to handle binary values in \code{actual} vector. #' #' @param actual A vector of the labels #' @param predicted A vector of predicted values #' @param cutoff A cutoff for the predicted values #' #' @export kappa <- function(actual, predicted, cutoff = .5){ kappa_(actual, predicted, cutoff) } ModelMetrics/NEWS.md0000644000176000001440000000074613324437276014011 0ustar ripleyusers# ModelMetrics 1.2.0 * added kappa statistic * added s3 methods for `glm`, `lm`, `randomForest`, `merMod`, and `glmerMod` * sped up `auc` with `data.table::frankv` * added `gini` # 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 * Initializing package with basic metric functions ModelMetrics/MD50000644000176000001440000000455413634100033013202 0ustar ripleyusersf23cb2a6984ae37d2e483ef5a3434f1c *DESCRIPTION 3b431e35360f5e19d6ab80b8e1a49a8e *NAMESPACE 24c5958daf624431e315326fd9986378 *NEWS.md 4e4a1a9f3ac2dbf51a5d46f18623e400 *R/ModelMetrics.R ed3a5654d72ad2ab4c3b30f68f05cc7e *R/RcppExports.R 29ed52c149e0e39f9ac6a273800b8e44 *R/auc.R 3548331a7b2c91664e40f37dfba33898 *R/binaryChecks.R 03ae849f06ac4c8bc97e26a40d76879a *R/brier.R 22e6240e3c2e6ecd1605d367ca8d2563 *R/ce.R 1a128873f35a6c6a7a052bc44b356f46 *R/gini.R cec3f7eb0ed66186d6acc4e76e58d56e *R/logLoss.R 2cbcd4c4f99c969e0181c49e7b274421 *R/mae.R 3d5f959020142262799e0e188bf29ab7 *R/mse.R 51350cce192e966dcc8a81534e140a87 *R/msle.R f4609248a96ac700bdb722d555647f06 *R/rmsle.R 835c423f58238a9bd96e15ef5dfb05de *README.md a62499dff46c9978854d29e3571aba7f *data/testDF.rda 50b852520d70536f0a23add9fbcdea4e *man/auc.Rd e84da2b16a745588722b63987ae9b5cd *man/brier.Rd 086d0c366da32c83da92dcee4b5af0dc *man/ce.Rd be0c43ebe08a965175dd8a48e66bfeb0 *man/confusionMatrix.Rd 2b06b4bd22c3cbfd3d3b722f60740133 *man/f1Score.Rd 02eda37429263f89e7bd79a25255607e *man/fScore.Rd 1ff2ff5b70b954d63d4009c1fe1a17aa *man/gini.Rd f3d668ac828d6424a9cf715774d89f09 *man/kappa.Rd df95c140db3217da9c118e154a3d138a *man/logLoss.Rd 73ce3fc1e227206c7a25bb427db6fb0f *man/mae.Rd 1f67de37cc01707a582b0957fc554dd2 *man/mauc.Rd 9d5bf951db11bc1b228b46b12d8c072d *man/mcc.Rd df6efd9a659f999a8f2841842f667970 *man/mlogLoss.Rd 1a22853e7f59ba5a913d47e6c87b3928 *man/mse.Rd 29f17a7f0f520c7a7cd0bbb350bc89d3 *man/msle.Rd 1b11c5564d681aa5d17e5628eef3d43f *man/npv.Rd f1b452e47ec3c85fdfc73e573a4bdf88 *man/ppv.Rd 2658e7c4c53ef14f0467c0617913f67f *man/recall.Rd f2ab2cbaa4870af94d341988c72e943b *man/rmse.Rd ec1461026d6dfee0568801f16f808db2 *man/rmsle.Rd 6e69b8f36272fbc0e5978c884de0d866 *man/testDF.Rd 9681a958342e89bfa5d6444d17f8a7b4 *man/tnr.Rd 96b93d92950fb41e7299f2da310cfa22 *src/RcppExports.cpp 8e5b33b1d0bef4394769ff972656f771 *src/auc_.cpp 557f9ff45b746e964cb144d315563de2 *src/confusionMatrix_.cpp 3073dd87d3fe9cb2f942dcafea9f8669 *src/error.cpp 368705537bfeb0e789b84060da64453d *src/gini_.cpp 20cdf5e56f75693ca30f491a426d6bef *src/logLoss_.cpp bb16f91f58e82e738df1dfa6bf6f6cc6 *tests/testthat.R bf8de8742209c6f32ede83d1b7baf623 *tests/testthat/test_auc.R 6e3d0990522d937364f37356e38fbb43 *tests/testthat/test_calculations.R f131ea7bb2f8ece346adb4175152a7d1 *tests/testthat/test_errors.R 24d21592c1e411ad88930e519d47a13d *tests/testthat/test_logloss.R