Skip to content

Commit

Permalink
Merge pull request #100 from hneth/master
Browse files Browse the repository at this point in the history 
Increase efficiency of `add_level()` helper
  • Loading branch information
@hneth
hneth committed Sep 14, 2022
2 parents 5e8dc37 + 496f690 commit b130fea
Show file tree
Hide file tree
Showing 3 changed files with 38 additions and 49 deletions.
32 changes: 15 additions & 17 deletions R/helper_plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,6 @@
# (1) General plotting helpers: ------




# num_space: ------

# \code{num_space} computes the width of a representation of \code{x}
Expand Down Expand Up @@ -256,7 +254,7 @@ transparent <- function(col_orig = "red",
col_final[i] <- rgb(col_orig[1, i], col_orig[2, i], col_orig[
3,
i
], alpha = (1 - trans.val) * 255, maxColorValue = 255)
], alpha = (1 - trans.val) * 255, maxColorValue = 255)
}

return(col_final)
Expand Down Expand Up @@ -286,7 +284,7 @@ add_balls <- function(x.lim = c(-10, 0),
upper.text = "",
upper.text.cex = 1,
upper.text.adj = 0,
rev.order = F,
rev.order = FALSE,
box.col = NULL,
box.bg = NULL,
n.per.icon = NULL) {
Expand Down Expand Up @@ -442,7 +440,7 @@ get_label_cex <- function(i, label.box.text.cex = 2) {

# add_level: Add level display to a plot ----

# df_lloc: Data frame with labels, values, and locations.
# lloc_row: Data frame with labels, values, and locations.

add_level <- function(name,
sub = "",
Expand All @@ -452,25 +450,25 @@ add_level <- function(name,
bottom.text = "",
level.type = "line",
# needed from plot:
df_lloc = NULL,
lloc_row = NULL, # element == name row (of df)
header_y = NULL,
header_cex = NULL) {

# Parameters:
rect.center.x <- df_lloc$center.x[df_lloc$element == name]
rect.center.y <- df_lloc$center.y[df_lloc$element == name]
rect.height <- df_lloc$height[df_lloc$element == name]
rect.width <- df_lloc$width[df_lloc$element == name]
rect.center.x <- lloc_row$center.x
rect.center.y <- lloc_row$center.y
rect.height <- lloc_row$height
rect.width <- lloc_row$width

rect.bottom.y <- rect.center.y - rect.height / 2
rect.top.y <- rect.center.y + rect.height / 2

rect.left.x <- rect.center.x - rect.width / 2
rect.right.x <- rect.center.x + rect.width / 2

long.name <- df_lloc$long.name[df_lloc$element == name]
value <- df_lloc$value[df_lloc$element == name]
value.name <- df_lloc$value.name[df_lloc$element == name]
long.name <- lloc_row$long.name
value <- lloc_row$value
value.name <- lloc_row$value.name

#
# level.col.fun <- circlize::colorRamp2(c(min.val, ok.val, max.val),
Expand All @@ -479,7 +477,7 @@ add_level <- function(name,


text(x = rect.center.x, y = header_y,
labels = long.name, pos = 1, cex = header_cex
labels = long.name, pos = 1, cex = header_cex
)

# text_outline(x = rect.center.x,
Expand Down Expand Up @@ -513,14 +511,14 @@ add_level <- function(name,
value.height,
# col = level.col.fun(value.s),
col = value.col,
# col = spec.level.fun(df_lloc$value[df_lloc$element == name]),
# col = spec.level.fun(lloc_row$value),
border = "black"
)

text_outline(
x = rect.center.x,
y = value.height,
labels = df_lloc$value.name[df_lloc$element == name],
labels = lloc_row$value.name,
cex = 1.5, r = .008, pos = 3
)

Expand Down Expand Up @@ -558,7 +556,7 @@ add_level <- function(name,
text_outline(
x = rect.center.x,
y = value.height,
labels = df_lloc$value.name[df_lloc$element == name],
labels = lloc_row$value.name,
cex = 1.5, r = 0, pos = 3
)

Expand Down
38 changes: 19 additions & 19 deletions R/plotFFTrees_function.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1487,24 +1487,24 @@ plot.FFTrees <- function(x = NULL,
# Get either bacc OR wacc (based on sens.w):
sens.w <- x$params$sens.w
bacc_wacc <- get_bacc_wacc(sens = final.stats$sens, spec = final.stats$spec, sens.w = sens.w)
bacc_wacc_name <- names(bacc_wacc)

# Set labels, values, and locations (as df):
lloc <- data.frame(
element = c("classtable", "mcu", "pci", "sens", "spec", "acc", names(bacc_wacc), "roc"),
long.name = c("Classification Table", "mcu", "pci", "sens", "spec", "acc", names(bacc_wacc), "ROC"),
element = c("classtable", "mcu", "pci", "sens", "spec", "acc", bacc_wacc_name, "roc"),
long.name = c("Classification Table", "mcu", "pci", "sens", "spec", "acc", bacc_wacc_name, "ROC"),
center.x = c(.18, seq(.35, .65, length.out = 6), .85),
center.y = rep(level.center.y, 8),
width = c(.2, rep(level.width, 6), .20),
height = c(.65, rep(level.max.height, 6), .65),
value = c(
NA,
abs(final.stats$mcu - 5) / (abs(1 - 5)),
final.stats$pci, final.stats$sens, final.stats$spec, with(final.stats, (cr + hi) / n), bacc_wacc, NA
),
value.name = c(
NA, round(final.stats$mcu, 1), pretty_dec(final.stats$pci), pretty_dec(final.stats$sens), pretty_dec(final.stats$spec), pretty_dec(final.stats$acc),
pretty_dec(bacc_wacc), NA
)
value = c(NA,
abs(final.stats$mcu - 5) / (abs(1 - 5)), final.stats$pci,
final.stats$sens, final.stats$spec,
with(final.stats, (cr + hi) / n), bacc_wacc, NA),
value.name = c(NA,
round(final.stats$mcu, 1), pretty_dec(final.stats$pci),
pretty_dec(final.stats$sens), pretty_dec(final.stats$spec),
pretty_dec(final.stats$acc), pretty_dec(bacc_wacc), NA)
)


Expand Down Expand Up @@ -1677,14 +1677,14 @@ plot.FFTrees <- function(x = NULL,
# mcu level: ----

add_level("mcu", ok.val = .75, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "mcu", ],
header_y = header.y.loc, header_cex = header.cex) # , sub = paste(c(final.stats$cr, "/", final.stats$cr + final.stats$fa), collapse = ""))


# pci level: ----

add_level("pci", ok.val = .75, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "pci", ],
header_y = header.y.loc, header_cex = header.cex) # , sub = paste(c(final.stats$cr, "/", final.stats$cr + final.stats$fa), collapse = ""))

# text(lloc$center.x[lloc$element == "pci"],
Expand All @@ -1695,14 +1695,14 @@ plot.FFTrees <- function(x = NULL,
# spec level: ----

add_level("spec", ok.val = .75, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "spec", ],
header_y = header.y.loc, header_cex = header.cex) # , sub = paste(c(final.stats$cr, "/", final.stats$cr + final.stats$fa), collapse = ""))


# sens level: ----

add_level("sens", ok.val = .75, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "sens", ],
header_y = header.y.loc, header_cex = header.cex) # , sub = paste(c(final.stats$hi, "/", final.stats$hi + final.stats$mi), collapse = ""))


Expand All @@ -1711,7 +1711,7 @@ plot.FFTrees <- function(x = NULL,
min.acc <- max(crit.br, 1 - crit.br)

add_level("acc", ok.val = .50, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "acc", ],
header_y = header.y.loc, header_cex = header.cex) # , sub = paste(c(final.stats$hi + final.stats$cr, "/", final.stats$n), collapse = ""))

# Add baseline to acc level:
Expand All @@ -1737,15 +1737,15 @@ plot.FFTrees <- function(x = NULL,
if (names(bacc_wacc) == "bacc"){ # show bacc level:

add_level("bacc", ok.val = .50, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "bacc", ],
header_y = header.y.loc, header_cex = header.cex)

} else { # default: show wacc level (with sens.w value):
} else { # show wacc level (and sens.w value):

sens.w_lbl <- paste0("sens.w = .", pretty_dec(sens.w))

add_level("wacc", ok.val = .50, min.val = 0, max.val = 1,
level.type = level.type, df_lloc = lloc,
level.type = level.type, lloc_row = lloc[lloc$element == "wacc", ],
header_y = header.y.loc,
bottom.text = sens.w_lbl, header_cex = header.cex)

Expand Down
17 changes: 4 additions & 13 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 b130fea

Please sign in to comment.