We are happy to announce the release of the rules package on CRAN. rules is another “parsnip-adjacent” package that enables a specific class of models within the tidymodels infrastructure. rules currently contains three models:
-
C5_rules(): classification rule sets based on the C5.0 model. -
cubist_rules(): regression rules using Cubist. -
rule_fit(): classification or regression rules using the RuleFit model.
If you aren’t familiar with rule-based models, there is a companion blog post that summarizes how they work.
Install rules from CRAN like so:
install.packages("rules")
Then attach it for use via:
library(rules)
Here’s an example of creating Cubist regression rules via the parsnip package:
library(tidymodels)
#> ── Attaching packages ──────────────────────────────────── tidymodels 0.1.0 ──
#> ✓ broom 0.5.6 ✓ recipes 0.1.12
#> ✓ dials 0.0.6 ✓ rsample 0.0.6
#> ✓ dplyr 0.8.5 ✓ tibble 3.0.1
#> ✓ ggplot2 3.3.0 ✓ tune 0.1.0
#> ✓ infer 0.5.1 ✓ workflows 0.1.1
#> ✓ parsnip 0.1.1 ✓ yardstick 0.0.6
#> ✓ purrr 0.3.4
#> ── Conflicts ─────────────────────────────────────── tidymodels_conflicts() ──
#> x purrr::accumulate() masks foreach::accumulate()
#> x purrr::discard() masks scales::discard()
#> x dplyr::filter() masks stats::filter()
#> x dplyr::lag() masks stats::lag()
#> x ggplot2::margin() masks dials::margin()
#> x recipes::step() masks stats::step()
#> x purrr::when() masks foreach::when()
library(rules)
data(car_prices, package = "modeldata")
set.seed(9932)
car_split <- initial_split(car_prices)
car_tr <- training(car_split)
car_te <- testing(car_split)
# A single rule set:
cubist_mod <-
cubist_rules(neighbors = 7) %>%
set_engine("Cubist")
cubist_fit <-
cubist_mod %>%
fit(log10(Price) ~ ., data = car_tr)
summary(cubist_fit$fit)
#>
#> Call:
#> cubist.default(x = x, y = y, committees = 1)
#>
#>
#> Cubist [Release 2.07 GPL Edition] Wed May 20 21:39:22 2020
#> ---------------------------------
#>
#> Target attribute `outcome'
#>
#> Read 603 cases (18 attributes) from undefined.data
#>
#> Model:
#>
#> Rule 1: [210 cases, mean 4.116360, range 3.94295 to 4.2505, est err 0.030756]
#>
#> if
#> Cylinder <= 4
#> Saab <= 0
#> then
#> outcome = 4.115185 + 0.12 Saab - 3.5e-06 Mileage + 0.017 Cylinder
#> - 0.087 hatchback - 0.029 Chevy + 0.046 wagon + 0.028 Leather
#> + 0.041 Cadillac - 0.024 sedan + 0.027 convertible
#> + 0.006 Doors + 0.012 Buick
#>
#> Rule 2: [8 cases, mean 4.207121, range 4.13308 to 4.26696, est err 0.006589]
#>
#> if
#> Cylinder > 4
#> Saturn > 0
#> then
#> outcome = 3.88624 + 0.057 Cylinder + 0.2 Saab + 0.141 Cadillac
#> - 3.8e-06 Mileage - 0.054 sedan + 0.094 convertible
#> - 0.085 hatchback + 0.019 Doors + 0.04 Buick + 0.014 Cruise
#> + 0.01 Leather + 0.007 Sound + 0.007 Saturn
#>
#> Rule 3: [33 cases, mean 4.229076, range 4.16741 to 4.29184, est err 0.012903]
#>
#> if
#> Cylinder > 4
#> Cruise <= 0
#> then
#> outcome = 4.265627 - 3.7e-06 Mileage + 0.039 Chevy
#>
#> Rule 4: [94 cases, mean 4.272727, range 4.18913 to 4.4427, est err 0.034717]
#>
#> if
#> Mileage > 3946
#> Cylinder > 4
#> Doors > 2
#> Cruise > 0
#> Buick <= 0
#> Cadillac <= 0
#> Saturn <= 0
#> then
#> outcome = 4.037203 + 0.051 Cylinder - 4.3e-06 Mileage + 0.061 Saab
#> + 0.044 Cadillac - 0.016 sedan + 0.029 convertible
#> - 0.026 hatchback + 0.006 Doors - 0.009 Chevy + 0.012 Buick
#> + 0.004 Cruise
#>
#> Rule 5: [57 cases, mean 4.314541, range 4.17208 to 4.42864, est err 0.049758]
#>
#> if
#> Buick > 0
#> then
#> outcome = 4.389884 - 3e-06 Mileage
#>
#> Rule 6: [9 cases, mean 4.341528, range 4.23957 to 4.66962, est err 0.036309]
#>
#> if
#> Mileage <= 3946
#> Cylinder > 4
#> Cadillac <= 0
#> then
#> outcome = 3.439093 + 5.28e-05 Mileage + 0.129 Cylinder
#>
#> Rule 7: [43 cases, mean 4.354487, range 4.1778 to 4.60071, est err 0.031792]
#>
#> if
#> Cylinder > 4
#> Doors <= 2
#> Cruise > 0
#> convertible <= 0
#> then
#> outcome = 3.40984 + 0.13 Cylinder + 0.116 Chevy - 2.7e-06 Mileage
#> + 0.037 Sound + 0.031 Leather
#>
#> Rule 8: [85 cases, mean 4.462877, range 4.34723 to 4.58348, est err 0.023398]
#>
#> if
#> Saab > 0
#> then
#> outcome = 4.522928 - 3.4e-06 Mileage + 0.064 Saab - 0.021 Doors
#> - 0.035 sedan + 0.009 Cylinder + 0.022 Cadillac
#> - 0.024 hatchback + 0.015 convertible - 0.004 Chevy
#> + 0.006 Buick
#>
#> Rule 9: [60 cases, mean 4.592824, range 4.44778 to 4.84976, est err 0.041948]
#>
#> if
#> Cadillac > 0
#> then
#> outcome = 4.774347 - 0.103 Doors + 0.036 Cylinder - 3.4e-06 Mileage
#>
#> Rule 10: [7 cases, mean 4.625017, range 4.58911 to 4.6727, est err 0.006627]
#>
#> if
#> Cylinder > 4
#> Cadillac <= 0
#> convertible > 0
#> then
#> outcome = 4.693132 - 3.9e-06 Mileage
#>
#>
#> Evaluation on training data (603 cases):
#>
#> Average |error| 0.032526
#> Relative |error| 0.23
#> Correlation coefficient 0.97
#>
#>
#> Attribute usage:
#> Conds Model
#>
#> 67% 84% Cylinder
#> 49% 66% Saab
#> 28% 66% Cadillac
#> 28% 17% Cruise
#> 25% 66% Buick
#> 23% 75% Doors
#> 17% 100% Mileage
#> 17% 1% Saturn
#> 8% 66% convertible
#> 77% Chevy
#> 66% hatchback
#> 66% sedan
#> 43% Leather
#> 35% wagon
#> 8% Sound
#>
#>
#> Time: 0.0 secs
predict(cubist_fit, car_te %>% select(-Price))
#> # A tibble: 201 x 1
#> .pred
#> <dbl>
#> 1 4.32
#> 2 4.49
#> 3 4.54
#> 4 4.54
#> 5 4.43
#> 6 4.43
#> 7 4.46
#> 8 4.44
#> 9 4.37
#> 10 4.48
#> # … with 191 more rows
The functions also work with the tune package. To optimize our model, the number of committees (similar to boosting iterations) and the number of nearest-neighbors are the primary parameters for tuning.
cb_grid <- expand.grid(committees = 1:30, neighbors = c(1, 3, 5, 7, 9))
set.seed(8226)
car_folds <- vfold_cv(car_tr)
cubist_mod <-
cubist_rules(neighbors = tune(), committees = tune()) %>%
set_engine("Cubist")
car_tune_res <-
cubist_mod %>%
tune_grid(log10(Price) ~ ., resamples = car_folds, grid = cb_grid)
car_tune_res %>%
collect_metrics() %>%
filter(.metric == "rmse") %>%
mutate(neighbors = factor(neighbors)) %>%
ggplot(aes(x = committees, y = mean, col = neighbors)) +
geom_point() +
geom_line() +
scale_color_brewer(palette = "Dark2") +
theme(legend.position = "top")
show_best(car_tune_res, metric = "rmse")
#> # A tibble: 5 x 7
#> committees neighbors .metric .estimator mean n std_err
#> <int> <dbl> <chr> <chr> <dbl> <int> <dbl>
#> 1 9 9 rmse standard 0.0395 10 0.00133
#> 2 5 9 rmse standard 0.0395 10 0.00132
#> 3 11 9 rmse standard 0.0395 10 0.00133
#> 4 13 9 rmse standard 0.0395 10 0.00132
#> 5 8 9 rmse standard 0.0395 10 0.00131
smallest_rmse <- select_best(car_tune_res, metric = "rmse")
smallest_rmse
#> # A tibble: 1 x 2
#> committees neighbors
#> <int> <dbl>
#> 1 9 9
final_cb_mod <-
cubist_mod %>%
finalize_model(smallest_rmse) %>%
fit(log10(Price) ~ ., data = car_tr)
It appears that the benefit of using committees occurs in the first 10 iterations. The nearest-neighbor adjustment was important to obtaining good performance.
The test set results look good and are consistent with the resampling estimate of RMSE:
test_pred <-
predict(final_cb_mod, car_te) %>%
bind_cols(car_te %>% select(Price)) %>%
mutate(Price = log10(Price))
test_pred %>% rmse(Price, .pred)
#> # A tibble: 1 x 3
#> .metric .estimator .estimate
#> <chr> <chr> <dbl>
#> 1 rmse standard 0.0382
ggplot(test_pred, aes(x = .pred, y = Price)) +
geom_abline(col = "green", lty = 2) +
geom_point(alpha = 0.5) +
coord_fixed(ratio = 1)
I’d like to thank Karl Holub for making the xrf package and accepting my PRs and changes.