Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Allow grayscale option for plot.FFTrees() #210

Merged
merged 5 commits into from
Apr 21, 2024
Merged

Allow grayscale option for plot.FFTrees() #210

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
07d7a71
added grayscale argument to plot.FFTrees. Some refactoring
ndphillips Apr 14, 2024
bb09abd
more progress
ndphillips Apr 14, 2024
a97cad3
updated docs"
ndphillips Apr 14, 2024
96928c7
minor color fixes
ndphillips Apr 18, 2024
1615b54
updated news, rebuilt readme
ndphillips Apr 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Open in desktop
Original file line number Diff line number Diff line change
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
Open in desktop
Original file line number Diff line number Diff line change
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
Open in desktop

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