The R package MetricsWeighted provides weighted versions of different machine learning metrics and performance measures as well as tools to use it within a dplyr chain.
From CRAN:
install.packages("MetricsWeighted")Latest version from github:
library(devtools)
install_github("mayer79/MetricsWeighted")Currently, the following metrics and performance measures are available.
accuracy, recall, precision, f1_score, and classification_error: Typical binary performance measures derived from the confusion matrix. Require binary predictions.
AUC and gini_coefficient: Area under the receiver operating curve (ROC) and the closely related Gini coefficient. Written for binary targets but not necessarly binary predictions.
deviance_bernoulli and logLoss: Further metrics relevant for binary targets, namely the average unit deviance of the binary logistic regression model and the closely connected logLoss.
mse, mae, mape, and rmse: Typical regression metrics (mean-squared error, mean-absolute error, mean absolute percentage error and root-mean-squared error).
deviance_tweedie: (Unscaled) average unit Tweedie deviance with parameter tweedie_p.
deviance_normal, deviance_gamma, and deviance_poisson: Special cases of Tweedie. deviance_normal equals mean-squared error.
They all take four arguments:
actual: Actual observed values.
predicted: Predicted values.
w: Optional vector with case weights.
...: Further arguments.
Notable exception is deviance_tweedie that requires the Tweedie power as additional parameter. The value 0 corresponds to the Gaussian/normal deviance, the value 1 to the Poisson deviance and the value 2 to the Gamma deviance, see e.g. [1]. For fixed actual and predicted values, the Tweedie deviance is continuous with respect to this parameter.
# The data
y_num <- iris[["Sepal.Length"]]
fit_num <- lm(Sepal.Length ~ ., data = iris)
pred_num <- fit_num$fitted
weights <- seq_len(nrow(iris))
# Performance metrics
mae(y_num, pred_num) # unweighted
#> [1] 0.2428628
mae(y_num, pred_num, w = rep(1, length(y_num))) # same
#> [1] 0.2428628
mae(y_num, pred_num, w = weights) # different
#> [1] 0.2561237
rmse(y_num, pred_num)
#> [1] 0.300627# The data
y_cat <- iris[["Species"]] == "setosa"
fit_cat <- glm(y_cat ~ Sepal.Length, data = iris, family = binomial())
pred_cat <- predict(fit_cat, type = "response")
# Performance metrics
AUC(y_cat, pred_cat) # unweighted
#> [1] 0.9586
AUC(y_cat, pred_cat, w = weights) # weighted
#> [1] 0.9629734
logLoss(y_cat, pred_cat) # Logloss
#> [1] 0.2394547
deviance_bernoulli(y_cat, pred_cat) # LogLoss * 2
#> [1] 0.4789093Furthermore, we provide a generalization of R-squared, defined as the proportion of deviance explained, i.e. one minus the ratio of residual deviance and intercept-only deviance, see e.g. [2]. By default, it calculates the ordinary R-squared, i.e. proportion of normal deviance (mean-squared error) explained. However, you can specify any different deviance function, e.g. deviance_tweedie with paramter 1.5 or the deviance of the logistic regression (deviance_bernoulli).
summary(fit_num)$r.squared
#> [1] 0.8673123
# same
r_squared(y_num, pred_num)
#> [1] 0.8673123
r_squared(y_num, pred_num, deviance_function = deviance_tweedie, tweedie_p = 0)
#> [1] 0.8673123
# weighted
r_squared(y_num, pred_num, w = weights)
#> [1] 0.8300011
r_squared(y_num, pred_num, w = weights, deviance_function = deviance_gamma)
#> [1] 0.8300644
r_squared(y_num, pred_num, w = weights, deviance_function = deviance_tweedie, tweedie_p = 2)
#> [1] 0.8300644In order to facilitate the use of these metrics in a dplyr chain, you can try out the function performance: Starting from a data set with actual and predicted values (and optional case weights), it calculates one or more metrics. The resulting values are returned as a data.frame. Stratified performance calculations can e.g. be done by using do from dplyr.
require(dplyr)
# Regression with `Sepal.Length` as response
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
performance("Sepal.Length", "pred")
#> metric value
#> 1 rmse 0.300627
# Same
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
performance("Sepal.Length", "pred", metrics = rmse)
#> metric value
#> 1 rmse 0.300627
# Grouped by Species
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
group_by(Species) %>%
do(performance(data = ., actual = "Sepal.Length", predicted = "pred"))
#> # A tibble: 3 x 3
#> # Groups: Species [3]
#> Species metric value
#> <fct> <fct> <dbl>
#> 1 setosa rmse 0.254
#> 2 versicolor rmse 0.329
#> 3 virginica rmse 0.313
# Customized output
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
performance("Sepal.Length", "pred", value = "performance",
metrics = list(`root-mean-squared error` = rmse))
#> metric performance
#> 1 root-mean-squared error 0.300627
# Multiple measures
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
performance("Sepal.Length", "pred",
metrics = list(rmse = rmse, mae = mae, `R-squared` = r_squared))
#> metric value
#> 1 rmse 0.3006270
#> 2 mae 0.2428628
#> 3 R-squared 0.8673123
# Grouped by Species
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
group_by(Species) %>%
do(performance(., "Sepal.Length", "pred",
metrics = list(rmse = rmse, mae = mae, `R-squared` = r_squared)))
#> # A tibble: 9 x 3
#> # Groups: Species [3]
#> Species metric value
#> <fct> <fct> <dbl>
#> 1 setosa rmse 0.254
#> 2 setosa mae 0.201
#> 3 setosa R-squared 0.469
#> 4 versicolor rmse 0.329
#> 5 versicolor mae 0.276
#> 6 versicolor R-squared 0.585
#> 7 virginica rmse 0.313
#> 8 virginica mae 0.252
#> 9 virginica R-squared 0.752
# Passing extra argument (Tweedie p)
iris %>%
mutate(pred = predict(fit_num, data = .)) %>%
performance("Sepal.Length", "pred",
metrics = list(`normal deviance` = deviance_normal,
`Tweedie with p = 0` = deviance_tweedie),
tweedie_p = 0)
#> metric value
#> 1 normal deviance 0.09037657
#> 2 Tweedie with p = 0 0.09037657[1] Ohlsson E. and Johansson B. (2015). Non-Life Insurance Pricing with Generalized Linear Models. Springer Nature EN. ISBN 978-3642107900.
[2] Cohen, Jacob. et al. (2002). Applied Multiple Regression/Correlation Analysis for the Behavioral Sciences (3rd ed.). Routledge. ISBN 978-0805822236.