Skip to content

Commit

Permalink
Merge pull request #210 from ndphillips/issue_209/grayscale
Browse files Browse the repository at this point in the history 
Allow grayscale option for plot.FFTrees()
  • Loading branch information
@ndphillips
ndphillips committed Apr 21, 2024
2 parents 454b50c + 1615b54 commit 0cdd7e6
Show file tree
Hide file tree
Showing 5 changed files with 118 additions and 80 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
@@ -1,8 +1,8 @@
Package: FFTrees
Type: Package
Title: Generate, Visualise, and Evaluate Fast-and-Frugal Decision Trees
Version: 2.0.0.9010
Date: 2024-02-20
Version: 2.0.0.9000
Date: 2024-04-21
Authors@R: c(person("Nathaniel", "Phillips", role = c("aut"), email = "Nathaniel.D.Phillips.is@gmail.com", comment = c(ORCID = "0000-0002-8969-7013")),
person("Hansjoerg", "Neth", role = c("aut", "cre"), email = "h.neth@uni.kn", comment = c(ORCID = "0000-0001-5427-3141")),
person("Jan", "Woike", role = "aut", comment = c(ORCID = "0000-0002-6816-121X")),
Expand Down
51 changes: 3 additions & 48 deletions NEWS.md
View file
@@ -1,54 +1,9 @@
# FFTrees (development version)

# FFTrees 2.0

## 2.0.0.9009

<!-- **FFTrees** version 2.0.0 was released [on CRAN](https://CRAN.R-project.org/package=FFTrees) [on 2023-06-06]. -->

<!-- Development version: -->

This the current development version of **FFTrees**, available at <https://github.com/ndphillips/FFTrees>.
This version adds features and fixes bugs.

<!-- Log of changes: -->

Changes since last release:

<!-- Major: -->

### Major changes

<!-- Topic -->

- `plot.FFTrees()` now has a `grayscale` argument which, if TRUE, creates a grayscale plot
- Added support for handling NA values.


<!-- Minor: -->

### Minor changes

<!-- Costs: -->

- Increased value of `cost_cues_default` from 0 to 1, so that default cue costs correspond to `mcu`.


<!-- Details: -->

### Details

<!-- Topic -->

- Added `@aliases FFTrees-package` to documentation main `FFTrees()` function. <!-- due to <https://github.com/r-lib/roxygen2/issues/1491> -->


<!-- Development version: -->

The current development version of **FFTrees** is available at <https://github.com/ndphillips/FFTrees>.


------

<!-- Older versions: -->
- Added `@aliases FFTrees-package` to documentation main `FFTrees()` function.

## 2.0.0

Expand Down
134 changes: 107 additions & 27 deletions R/plotFFTrees_function.R
View file
Expand Up @@ -84,6 +84,8 @@
#' Use \code{what = "all"} to include performance statistics
#' and \code{what = "tree"} to plot only a tree diagram.
#'
#' @param grayscale logical. If \code{TRUE}, the plot is shown in grayscale.
#'
#' @param ... Graphical parameters (passed to text of panel titles,
#' to \code{\link{showcues}} when \code{what = 'cues'}, or
#' to \code{\link{title}} when \code{what = 'roc'}).
Expand Down Expand Up @@ -170,6 +172,7 @@ plot.FFTrees <- function(x = NULL,
which.tree = NULL, # deprecated: Use tree instead.
decision.names = NULL, # deprecated: Use decision.labels instead.
stats = NULL, # deprecated: Use what = "all" or what = "tree" instead.
grayscale = FALSE,
# graphical parameters:
...) {

Expand Down Expand Up @@ -719,10 +722,23 @@ plot.FFTrees <- function(x = NULL,
# col_correct_bg <- scales::alpha(correct.colfun(35), .8)
# col_correct_border <- scales::alpha(correct.colfun(65), .9)

col_error_bg <- "#FF7352CC"
if (!grayscale) {

col_error_bg <- "#FF7352CC"
col_error_border <- "#AD1A0AE6"
col_correct_bg <- "#89FF6FCC"
col_correct_border <- "#24AB18E6"
col_correct_bg <- "#89FF6FCC"
col_correct_border <- "#24AB18E6"

} else {

# Grayscale colors

col_error_bg <- gray(.1)
col_error_border <- gray(0)
col_correct_bg <- gray(1)
col_correct_border <- gray(0)

}

# max_cex <- 6 # is NOT used anywhere?
# min_cex <- 1 # is NOT used anywhere?
Expand Down Expand Up @@ -2039,9 +2055,23 @@ plot.FFTrees <- function(x = NULL,

# COMPETITIVE ALGORITHMS: ------

col_comp_gray_point_col <- scales::alpha("black", .1)
col_comp_gray_point_bg <- scales::alpha("black", .3)


if (comp == TRUE) {

# CART: ----
if (!grayscale) {

col_cart_point_col <- scales::alpha("red", .5)
col_cart_point_bg <- scales::alpha("red", .3)

} else {

col_cart_point_col <- col_comp_gray_point_col
col_cart_point_bg <- col_comp_gray_point_bg
}

if ("cart" %in% x$competition[[data]]$algorithm) {

Expand All @@ -2052,8 +2082,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + ((1 - cart_spec) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (cart_sens * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 1.75,
col = scales::alpha("red", .5),
bg = scales::alpha("red", .3), lwd = 1
col = col_cart_point_col,
bg = col_cart_point_bg, lwd = 1
)

points(final_roc_x[1] + ((1 - cart_spec) * lloc$width[lloc$element == "roc"]),
Expand All @@ -2068,8 +2098,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (roc_lbl_y[4] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5,
col = scales::alpha("red", .1),
bg = scales::alpha("red", .3)
col = col_cart_point_col,
bg = col_cart_point_bg
)

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
Expand All @@ -2091,15 +2121,26 @@ plot.FFTrees <- function(x = NULL,

if ("lr" %in% x$competition[[data]]$algorithm) {

if (!grayscale) {

col_lr_point_col <- scales::alpha("blue", .5)
col_lr_point_bg <- scales::alpha("blue", .3)

} else {

col_lr_point_col <- col_comp_gray_point_col
col_lr_point_bg <- col_comp_gray_point_bg
}

lr_spec <- x$competition[[data]]$spec[x$competition[[data]]$algorithm == "lr"]
lr_sens <- x$competition[[data]]$sens[x$competition[[data]]$algorithm == "lr"]

# Plot point:
points(final_roc_x[1] + ((1 - lr_spec) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (lr_sens * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 1.75,
col = scales::alpha("blue", .1),
bg = scales::alpha("blue", .2)
col = col_lr_point_col,
bg = col_lr_point_bg
)

points(final_roc_x[1] + ((1 - lr_spec) * lloc$width[lloc$element == "roc"]),
Expand All @@ -2113,8 +2154,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (roc_lbl_y[3] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5,
col = scales::alpha("blue", .1),
bg = scales::alpha("blue", .2)
col = col_lr_point_col,
bg = col_lr_point_bg
)

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
Expand All @@ -2136,6 +2177,18 @@ plot.FFTrees <- function(x = NULL,

if ("rf" %in% x$competition[[data]]$algorithm) {

if (!grayscale) {

col_rf_point_col <- scales::alpha("purple", .1)
col_rf_point_bg <- scales::alpha("purple", .3)

} else {

col_rf_point_col <- col_comp_gray_point_col
col_rf_point_bg <- col_comp_gray_point_bg

}

rf_spec <- x$competition[[data]]$spec[x$competition[[data]]$algorithm == "rf"]
rf_sens <- x$competition[[data]]$sens[x$competition[[data]]$algorithm == "rf"]

Expand All @@ -2150,8 +2203,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + ((1 - rf_spec) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (rf_sens * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 1.75,
col = scales::alpha("purple", .1),
bg = scales::alpha("purple", .3), lwd = 1
col = col_rf_point_col,
bg = col_rf_point_bg, lwd = 1
)

points(final_roc_x[1] + ((1 - rf_spec) * lloc$width[lloc$element == "roc"]),
Expand All @@ -2165,8 +2218,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (roc_lbl_y[2] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5,
col = scales::alpha("purple", .1),
bg = scales::alpha("purple", .3)
col = col_rf_point_col,
bg = col_rf_point_bg
)

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
Expand All @@ -2188,15 +2241,26 @@ plot.FFTrees <- function(x = NULL,

if ("svm" %in% x$competition[[data]]$algorithm) {

if (!grayscale) {

col_svm_point_col <- scales::alpha("orange", .1)
col_svm_point_bg <- scales::alpha("orange", .3)

} else {

col_svm_point_col <- col_comp_gray_point_col
col_svm_point_bg <- col_comp_gray_point_bg
}

svm_spec <- x$competition[[data]]$spec[x$competition[[data]]$algorithm == "svm"]
svm_sens <- x$competition[[data]]$sens[x$competition[[data]]$algorithm == "svm"]

# Plot point:
points(final_roc_x[1] + (1 - svm_spec) * lloc$width[lloc$element == "roc"],
final_roc_y[1] + svm_sens * lloc$height[lloc$element == "roc"],
pch = 21, cex = 1.75,
col = scales::alpha("orange", .1),
bg = scales::alpha("orange", .3), lwd = 1
col = col_svm_point_col,
bg = col_svm_point_bg, lwd = 1
)

points(final_roc_x[1] + (1 - svm_spec) * lloc$width[lloc$element == "roc"],
Expand All @@ -2211,8 +2275,8 @@ plot.FFTrees <- function(x = NULL,
points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (roc_lbl_y[1] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5,
col = scales::alpha("orange", .1),
bg = scales::alpha("orange", .3)
col = col_svm_point_col,
bg = col_svm_point_bg
)

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
Expand All @@ -2235,6 +2299,22 @@ plot.FFTrees <- function(x = NULL,
# FFTs: ----

{

if (!grayscale) {

col_fft_point_col <- scales::alpha("green", .1)
col_fft_point_bg <- scales::alpha("white", .9)
col_fft_point_bg_2 <- scales::alpha("green", .2)
col_fft_point_col_2 <- scales::alpha("green", .6)

} else {

col_fft_point_col <- gray(0)
col_fft_point_bg <- gray(1)
col_fft_point_bg_2 <- gray(1)
col_fft_point_col_2 <- gray(0)
}

roc_order <- order(fft_spec_vec, decreasing = TRUE) # from highest to lowest spec
# roc_order <- 1:x$trees$n

Expand All @@ -2255,13 +2335,13 @@ plot.FFTrees <- function(x = NULL,

points(final_roc_x[1] + ((1 - fft_spec_vec_ord[-(which(roc_order == tree))]) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (fft_sens_vec_ord[-(which(roc_order == tree))] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5, col = scales::alpha("green", .60),
bg = scales::alpha("white", .90)
pch = 21, cex = 2.5, col = col_fft_point_col_2,
bg = col_fft_point_bg
)

text(final_roc_x[1] + ((1 - fft_spec_vec_ord[-(which(roc_order == tree))]) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (fft_sens_vec_ord[-(which(roc_order == tree))] * lloc$height[lloc$element == "roc"]),
labels = roc_order[which(roc_order != tree)], cex = 1, col = gray(.20)
labels = roc_order[which(roc_order != tree)], cex = 1, col = gray(.50)
)

}
Expand All @@ -2271,15 +2351,15 @@ plot.FFTrees <- function(x = NULL,
# white point (to hide point from above):
points(final_roc_x[1] + ((1 - fft_spec_vec[tree]) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (fft_sens_vec[tree] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 3, col = gray(1), # col = scales::alpha("green", .30),
pch = 21, cex = 3, col = col_fft_point_col_2, # col = scales::alpha("green", .30),
bg = scales::alpha("white", 1), lwd = 1
)

# green point:
points(final_roc_x[1] + ((1 - fft_spec_vec[tree]) * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (fft_sens_vec[tree] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 3, col = gray(1), # col = scales::alpha("green", .30),
bg = scales::alpha("green", .30), lwd = 1
pch = 21, cex = 3, col = col_fft_point_col_2, # col = scales::alpha("green", .30),
bg = col_fft_point_bg_2, lwd = 1
)

text(final_roc_x[1] + ((1 - fft_spec_vec[tree]) * lloc$width[lloc$element == "roc"]),
Expand All @@ -2301,8 +2381,8 @@ plot.FFTrees <- function(x = NULL,

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
final_roc_y[1] + (roc_lbl_y[5] * lloc$height[lloc$element == "roc"]),
pch = 21, cex = 2.5, col = scales::alpha("green", .3),
bg = scales::alpha("green", .67)
pch = 21, cex = 2.5, col = col_fft_point_col,
bg = col_fft_point_bg
)

points(final_roc_x[1] + (1.10 * lloc$width[lloc$element == "roc"]),
Expand Down
6 changes: 3 additions & 3 deletions README.md
View file
Expand Up @@ -2,7 +2,7 @@
<!-- README.md is generated from README.Rmd. Please only edit the .Rmd file! -->
<!-- Title, version and logo: -->

# FFTrees 2.0.0.9010 <img src = "./inst/logo.png" align = "right" alt = "FFTrees" width = "160" />
# FFTrees 2.0.0.9000 <img src = "./inst/logo.png" align = "right" alt = "FFTrees" width = "160" />

<!-- Devel badges start: -->

Expand Down Expand Up @@ -205,7 +205,7 @@ heart_fft$competition$test
#> 1 fftrees 153 64 19 9 61 0.877 0.762 0.238 0.771 0.871 0.817
#> 2 lr 153 55 13 18 67 0.753 0.838 0.162 0.809 0.788 0.797
#> 3 cart 153 50 19 23 61 0.685 0.762 0.238 0.725 0.726 0.725
#> 4 rf 153 59 8 14 72 0.808 0.9 0.1 0.881 0.837 0.856
#> 4 rf 153 59 5 14 75 0.808 0.938 0.0625 0.922 0.843 0.876
#> 5 svm 153 55 7 18 73 0.753 0.912 0.0875 0.887 0.802 0.837
#> # ℹ 6 more variables: bacc <dbl>, wacc <dbl>, dprime <dbl>, cost_dec <dbl>,
#> # cost_cue <dbl>, cost <dbl>
Expand Down Expand Up @@ -340,6 +340,6 @@ for the full list). Examples include:

------------------------------------------------------------------------

\[File `README.Rmd` last updated on 2024-02-20.\]
\[File `README.Rmd` last updated on 2024-04-21.\]

<!-- eof. -->
3 changes: 3 additions & 0 deletions man/plot.FFTrees.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 0cdd7e6

Please sign in to comment.