Nothing
## plot_prism.R | riskyr
## 2022 08 09
## Plot prism: Plot a network diagram of
## frequencies (nodes) and probabilities (edges).
## -----------------------------------------------
# This function replaces the older functions
# - plot_tree.R: plot single tree
# - plot_fnet.R: plot double tree
# (and removes dependency on 'diagram' pkg).
## plot_prism: Documentation ----------
#' Plot prism diagram of frequencies and probabilities.
#'
#' \code{plot_prism} plots a network diagram of
#' from a sufficient and valid set of 3 essential probabilities
#' (\code{\link{prev}}, and
#' \code{\link{sens}} or its complement \code{\link{mirt}}, and
#' \code{\link{spec}} or its complement \code{\link{fart}})
#' or existing frequency information \code{\link{freq}}
#' and a population size of \code{\link{N}} individuals.
#'
#' \code{plot_prism} generalizes and replaces \code{\link{plot_fnet}}
#' by removing the dependency on the R package \code{diagram}
#' and providing many additional options.
#'
#' @param prev The condition's prevalence \code{\link{prev}}
#' (i.e., the probability of condition being \code{TRUE}).
#'
#' @param sens The decision's sensitivity \code{\link{sens}}
#' (i.e., the conditional probability of a positive decision
#' provided that the condition is \code{TRUE}).
#' \code{sens} is optional when its complement \code{mirt} is provided.
#'
#' @param mirt The decision's miss rate \code{\link{mirt}}
#' (i.e., the conditional probability of a negative decision
#' provided that the condition is \code{TRUE}).
#' \code{mirt} is optional when its complement \code{sens} is provided.
#'
#' @param spec The decision's specificity value \code{\link{spec}}
#' (i.e., the conditional probability
#' of a negative decision provided that the condition is \code{FALSE}).
#' \code{spec} is optional when its complement \code{fart} is provided.
#'
#' @param fart The decision's false alarm rate \code{\link{fart}}
#' (i.e., the conditional probability
#' of a positive decision provided that the condition is \code{FALSE}).
#' \code{fart} is optional when its complement \code{spec} is provided.
#'
#' @param N The number of individuals in the population.
#' A suitable value of \code{\link{N}} is computed, if not provided.
#' Note that a population size \code{\link{N}} is not needed
#' for computing current probability information \code{\link{prob}},
#' but is needed for computing frequency information
#' \code{\link{freq}} from current probabilities \code{\link{prob}}.
#'
#' @param by A character code specifying 1 or 2 perspective(s)
#' that split(s) the population into 2 subsets.
#' Specifying 1 perspective plots a frequency tree (single tree)
#' with 3 options:
#' \enumerate{
#' \item \code{"cd"}: by condition only;
#' \item \code{"dc"}: by decision only;
#' \item \code{"ac"}: by accuracy only.
#' }
#' Specifying 2 perspectives plots a frequency prism (double tree)
#' with 6 options:
#' \enumerate{
#' \item \code{"cddc"}: by condition (cd) and by decision (dc) (default);
#' \item \code{"cdac"}: by condition (cd) and by accuracy (ac);
#' \item \code{"dccd"}: by decision (dc) and by condition (cd);
#' \item \code{"dcac"}: by decision (dc) and by accuracy (ac);
#' \item \code{"accd"}: by accuracy (ac) and by condition (cd);
#' \item \code{"acdc"}: by accuracy (ac) and by decision (dc).
#' }
#'
#' @param area A character code specifying the shapes of the frequency boxes,
#' with 3 options:
#' \enumerate{
#' \item \code{"no"}: rectangular frequency boxes, not scaled (default);
#' \item \code{"hr"}: frequency boxes are horizontal rectangles (scaled relative to N).
#' \item \code{"sq"}: frequency boxes are squares (scaled relative to N).
#' }
#'
#' @param scale Scale probabilities and corresponding node dimensions either by
#' exact probability or by (rounded or non-rounded) frequency, with 2 options:
#' \enumerate{
#' \item \code{"p"}: scale node dimensions by exact probability (default);
#' \item \code{"f"}: re-compute probabilities from (rounded or non-rounded) frequencies
#' and scale node dimensions by their frequency.
#' }
#' Note: \code{scale} setting matters for the display of probability values and for
#' area plots with small population sizes \code{\link{N}} when \code{round = TRUE}.
#'
#' @param round Boolean option specifying whether computed frequencies
#' are rounded to integers. Default: \code{round = TRUE}.
#'
#' @param sample Boolean value that determines whether frequency values
#' are sampled from \code{N}, given the probability values of
#' \code{prev}, \code{sens}, and \code{spec}.
#' Default: \code{sample = FALSE}.
#'
#' @param f_lbl Type of label for showing frequency values in nodes,
#' with 6 options:
#' \enumerate{
#' \item \code{"def"}: abbreviated names and frequency values;
#' \item \code{"abb"}: abbreviated frequency names only (as specified in code);
#' \item \code{"nam"}: names only (as specified in \code{lbl_txt = txt});
#' \item \code{"num"}: numeric frequency values only (default);
#' \item \code{"namnum"}: names (as specified in \code{lbl_txt = txt}) and numeric values;
#' \item \code{"no"}: no frequency labels (same for \code{f_lbl = NA} or \code{NULL}).
#' }
#'
#' @param f_lbl_sep Separator for frequency labels
#' (used for \code{f_lbl = "def" OR "namnum"}).
#' Use \code{f_lbl_sep = ":\n"} to add a line break between name and numeric value.
#' Default: \code{f_lbl_sep = NA} (set to \code{" = "} or \code{":\n"} based on \code{f_lbl}).
#'
#' @param f_lwd Line width of areas.
#' Default: \code{f_lwd = 0}.
#'
#' @param p_lwd Line width of probability links.
#' Default: \code{p_lwd = 1}, but consider increasing when setting \code{p_scale = TRUE}.
#'
#' @param p_scale Boolean option for scaling current widths of probability links
#' (as set by \code{p_lwd}) by the current probability values.
#' Default: \code{p_scale = FALSE}.
#'
#' @param p_lbl Type of label for showing 3 key probability links and values,
#' with many options:
#' \enumerate{
#' \item \code{"abb"}: show links and abbreviated probability names;
#' \item \code{"def"}: show links and abbreviated probability names and values;
#' \item \code{"min"}: show links and minimum (prominent) probability names;
#' \item \code{"mix"}: show links and prominent probability names and all values (default);
#' \item \code{"nam"}: show links and probability names (as specified in code);
#' \item \code{"num"}: show links and numeric probability values;
#' \item \code{"namnum"}: show links with names and numeric probability values;
#' \item \code{"no"}: show links with no labels (same for \code{p_lbl = NA} or \code{NULL}).
#' }
#'
#' @param arr_c Arrow code for symbols at ends of probability links
#' (as a numeric value \code{-3 <= arr_c <= +6}),
#' with the following options:
#' \itemize{
#' \item \code{-1} to \code{-3}: points at one/other/both end/s;
#' \item \code{0}: no symbols;
#' \item \code{+1} to \code{+3}: V-arrow at one/other/both end/s;
#' \item \code{+4} to \code{+6}: T-arrow at one/other/both end/s.
#' }
#' Default: \code{arr_c = NA}, but adjusted by \code{area}.
#'
#'
#' @param lbl_txt Default label set for text elements.
#' Default: \code{lbl_txt = \link{txt}}.
#'
#' @param main Text label for main plot title.
#' Default: \code{main = txt$scen_lbl}.
#'
#' @param sub Text label for plot subtitle (on 2nd line).
#' Default: \code{sub = "type"} shows information on current plot type.
#'
#' @param title_lbl \strong{Deprecated} text label for current plot title.
#' Replaced by \code{main}.
#'
#' @param cex_lbl Scaling factor for text labels (frequencies and headers).
#' Default: \code{cex_lbl = .90}.
#'
#' @param cex_p_lbl Scaling factor for text labels (probabilities).
#' Default: \code{cex_p_lbl = cex_lbl - .05}.
#'
#' @param col_pal Color palette.
#' Default: \code{col_pal = \link{pal}}.
#'
#' @param mar_notes Boolean option for showing margin notes.
#' Default: \code{mar_notes = FALSE}.
#'
#' @param ... Other (graphical) parameters.
#'
#'
#' @return Nothing (NULL).
#'
#' @examples
#' ## Basics:
#' # (1) Using global prob and freq values:
#' plot_prism() # default prism plot,
#' # same as:
#' # plot_prism(by = "cddc", area = "no", scale = "p",
#' # f_lbl = "num", f_lwd = 0, cex_lbl = .90,
#' # p_lbl = "mix", arr_c = -2, cex_p_lbl = NA)
#'
#' # (2) Providing values:
#' plot_prism(N = 10, prev = 1/3, sens = 3/5, spec = 4/5, area = "hr")
#' plot_prism(N = 10, prev = 1/4, sens = 3/5, spec = 2/5, area = "sq", mar_notes = TRUE)
#'
#' # (3) Rounding and sampling:
#' plot_prism(N = 100, prev = 1/3, sens = 2/3, spec = 6/7, area = "hr", round = FALSE)
#' plot_prism(N = 100, prev = 1/3, sens = 2/3, spec = 6/7, area = "hr", sample = TRUE, scale = "freq")
#'
#' # (4) Custom colors and text:
#' plot_prism(col_pal = pal_bw, f_lwd = .5, p_lwd = .5, lty = 2, # custom fbox color, prob links,
#' font = 3, cex_p_lbl = .75) # and text labels
#'
#' my_txt <- init_txt(cond_lbl = "The Truth", cond_true_lbl = "so true", cond_false_lbl = "so false",
#' hi_lbl = "TP", mi_lbl = "FN", fa_lbl = "FP", cr_lbl = "TN")
#' my_col <- init_pal(N_col = rgb(0, 169, 224, max = 255), # seeblau
#' hi_col = "gold", mi_col = "firebrick1", fa_col = "firebrick2", cr_col = "orange")
#' plot_prism(f_lbl = "nam", lbl_txt = my_txt,
#' col_pal = my_col, f_lwd = .5)
#'
#' ## Local values and custom color/txt settings:
#' plot_prism(N = 7, prev = 1/2, sens = 3/5, spec = 4/5, round = FALSE,
#' by = "cdac", lbl_txt = txt_org, f_lbl = "namnum", f_lbl_sep = ":\n",
#' f_lwd = 1, col_pal = pal_rgb) # custom colors
#'
#' plot_prism(N = 5, prev = 1/2, sens = .8, spec = .5, scale = "p", # note scale!
#' by = "cddc", area = "hr", col_pal = pal_bw, f_lwd = 1) # custom colors
#'
#' plot_prism(N = 3, prev = .50, sens = .50, spec = .50, scale = "p", # note scale!
#' area = "sq", lbl_txt = txt_org, f_lbl = "namnum", f_lbl_sep = ":\n", # custom text
#' col_pal = pal_kn, f_lwd = .5) # custom colors
#'
#' ## Plot versions:
#' # (A) tree/single tree (nchar(by) == 2):
#' # 3 versions:
#' plot_prism(by = "cd", f_lbl = "def", col_pal = pal_mod) # by condition (freq boxes: hi mi fa cr)
#' plot_prism(by = "dc", f_lbl = "def", col_pal = pal_mod) # by decision (freq boxes: hi fa mi cr)
#' plot_prism(by = "ac", f_lbl = "def", col_pal = pal_mod) # by accuracy (freq boxes: hi cr mi fa)
#'
#' # (B) prism/double tree (nchar(by) == 4):
#' # 6 (3 x 2) versions (+ 3 redundant ones):
#' plot_prism(by = "cddc") # v01 (default)
#' plot_prism(by = "cdac") # v02
#' # plot_prism(by = "cdcd") # (+) Message
#'
#' plot_prism(by = "dccd") # v03
#' plot_prism(by = "dcac") # v04
#' # plot_prism(by = "dcdc") # (+) Message
#'
#' plot_prism(by = "accd") # v05
#' plot_prism(by = "acdc") # v06
#' # plot_prism(by = "acac") # (+) Message
#'
#' ## Other options:
#'
#' # area:
#' # plot_prism(area = "no") # rectangular boxes (default): (same if area = NA/NULL)
#' plot_prism(area = "hr") # horizontal rectangles (widths on each level sum to N)
#' plot_prism(area = "sq") # squares (areas on each level sum to N)
#'
#' # scale (matters for scaled areas and small N):
#' plot_prism(N = 5, prev = .3, sens = .8, spec = .6,
#' area = "hr", scale = "p") # widths scaled by prob
#' plot_prism(N = 5, prev = .3, sens = .8, spec = .6,
#' area = "hr", scale = "f") # widths scaled by (rounded or non-rounded) freq
#' plot_prism(N = 4, prev = .2, sens = .7, spec = .8,
#' area = "sq", scale = "p") # areas scaled by prob
#' plot_prism(N = 4, prev = .2, sens = .7, spec = .8,
#' area = "sq", scale = "f") # areas scaled by (rounded or non-rounded) freq
#'
#' ## Frequency boxes:
#' # f_lbl:
#' plot_prism(f_lbl = "abb") # abbreviated freq names (variable names)
#' plot_prism(f_lbl = "nam") # only freq names
#' plot_prism(f_lbl = "num") # only numeric freq values (default)
#' plot_prism(f_lbl = "namnum") # names and numeric freq values
#' # plot_prism(f_lbl = "namnum", cex_lbl = .75) # smaller freq labels
#' # plot_prism(f_lbl = NA) # no freq labels
#' # plot_prism(f_lbl = "def") # informative default: short name and numeric value (abb = num)
#'
#' # f_lwd:
#' # plot_prism(f_lwd = 0) # no lines (default), set to tiny_lwd = .001, lty = 0 (same if NA/NULL)
#' plot_prism(f_lwd = 1) # basic lines
#' plot_prism(f_lwd = 3) # thicker lines
#' # plot_prism(f_lwd = .5) # thinner lines
#'
#' ## Probability links:
#' # Scale link widths (p_lwd & p_scale):
#' plot_prism(p_lwd = 6, p_scale = TRUE)
#' plot_prism(area = "sq", f_lbl = "num", p_lbl = NA, col_pal = pal_bw, p_lwd = 6, p_scale = TRUE)
#'
#' # p_lbl:
#' plot_prism(p_lbl = "mix") # abbreviated names with numeric values (abb = num)
#' plot_prism(p_lbl = "min") # minimal names (of key probabilities)
#' # plot_prism(p_lbl = NA) # no prob labels (NA/NULL/"none")
#' plot_prism(p_lbl = "nam") # only prob names
#' plot_prism(p_lbl = "num") # only numeric prob values
#' plot_prism(p_lbl = "namnum") # names and numeric prob values
#' # plot_prism(p_lbl = "namnum", cex_p_lbl = .70) # smaller prob labels
#' # plot_prism(by = "cddc", p_lbl = "min") # minimal labels
#' # plot_prism(by = "cdac", p_lbl = "min")
#' # plot_prism(by = "cddc", p_lbl = "mix") # mix abbreviated names and numeric values
#' # plot_prism(by = "cdac", p_lbl = "mix")
#' # plot_prism(by = "cddc", p_lbl = "abb") # abbreviated names
#' # plot_prism(by = "cdac", p_lbl = "abb")
#' # plot_prism(p_lbl = "any") # short name and value (abb = num)
#'
#' # arr_c:
#' plot_prism(arr_c = 0) # acc_c = 0: no arrows
#' plot_prism(arr_c = -3) # arr_c = -1 to -3: points at both ends
#' plot_prism(arr_c = -2) # point at far end
#' plot_prism(arr_c = +2) # crr_c = 1-3: V-shape arrows at far end
#' # plot_prism(arr_c = +3) # V-shape arrows at both ends
#' # plot_prism(arr_c = +6) # arr_c = 4-6: T-shape arrows
#'
#' ## Plain plot versions:
#' plot_prism(area = "no", f_lbl = "def", p_lbl = "num", col_pal = pal_mod, f_lwd = 1,
#' main = NA, sub = NA, mar_notes = FALSE) # remove titles and margin notes
#' plot_prism(area = "no", f_lbl = "nam", p_lbl = "min",
#' main = NA, sub = "My subtitle", col_pal = pal_rgb) # only subtitle
#' plot_prism(area = "no", f_lbl = "num", p_lbl = "num", col_pal = pal_kn) # default title & subtitle
#'
#' plot_prism(area = "hr", f_lbl = "nam", f_lwd = .5, p_lwd = .5, col_pal = pal_bwp)
#' plot_prism(area = "hr", f_lbl = "nam", f_lwd = .5, p_lbl = "num", main = NA, sub = NA)
#'
#' # plot_prism(area = "sq", f_lbl = "nam", p_lbl = NA, col_pal = pal_rgb)
#' plot_prism(area = "sq", f_lbl = "def", f_lbl_sep = ":\n", p_lbl = NA, f_lwd = 1, col_pal = pal_kn)
#'
#' ## Suggested combinations:
#' plot_prism(f_lbl = "nam", p_lbl = "mix", col_pal = pal_mod) # basic plot
#' plot_prism(f_lbl = "namnum", p_lbl = "num", cex_lbl = .80, cex_p_lbl = .75)
#' # plot_prism(area = "no", f_lbl = "def", p_lbl = "abb", # def/abb labels
#' # f_lwd = .8, p_lwd = .8, lty = 3, col_pal = pal_bwp) # black-&-white
#'
#' plot_prism(area = "hr", f_lbl = "num", p_lbl = "mix", f_lwd = 1, cex_p_lbl = .75)
#' plot_prism(area = "hr", f_lbl = "nam", p_lbl = "num", p_lwd = 6, p_scale = TRUE)
#' plot_prism(area = "hr", f_lbl = "abb", p_lbl = "abb", f_lwd = 1, col_pal = pal_kn)
#'
#' # plot_prism(area = "sq", f_lbl = "nam", p_lbl = "abb", lbl_txt = txt_TF)
#' plot_prism(area = "sq", f_lbl = "num", p_lbl = "num", f_lwd = 1, col_pal = pal_rgb)
#' plot_prism(area = "sq", f_lbl = "namnum", p_lbl = "mix", f_lwd = .5, col_pal = pal_kn)
#'
#' @importFrom graphics par
#' @importFrom graphics plot
#' @importFrom graphics box
#' @importFrom graphics axis
#' @importFrom graphics grid
#' @importFrom graphics abline
#' @importFrom graphics rect
#' @importFrom graphics arrows
#' @importFrom graphics points
#' @importFrom graphics text
#' @importFrom graphics title
#' @importFrom graphics mtext
#' @importFrom graphics legend
#' @importFrom graphics lines
#' @importFrom grDevices dev.size
#'
#' @family visualization functions
#'
#' @seealso
#' \code{\link{plot_fnet}} for older (obsolete) version;
#' \code{\link{plot_area}} for plotting mosaic plot (scaling area dimensions);
#' \code{\link{plot_bar}} for plotting frequencies as vertical bars;
#' \code{\link{plot_tab}} for plotting table (without scaling area dimensions);
#' \code{\link{pal}} contains current color settings;
#' \code{\link{txt}} contains current text settings.
#'
#' @export
## plot_prism: Definition ----------
plot_prism <- function(prev = num$prev, # probabilities
sens = num$sens, mirt = NA,
spec = num$spec, fart = NA,
N = num$N, # population size N
# Plot options:
by = "cddc", # 2 perspectives (rows 2 and 4): each by = "cd"/"dc"/"ac" (default: "cddc")
area = "no", # "no" (default = NA, NULL, "fix") vs: "hr", "sq"
scale = "p", # "f" vs. "p" (default)
round = TRUE, # round freq values to integers? When not rounded: n_digits = 2 (currently fixed).
sample = FALSE, # sample freq values from probabilities?
# Freq boxes:
f_lbl = "num", # freq labels: "def", "nam"/"num"/"namnum", "abb", or NA/NULL/"no" to hide freq labels.
f_lbl_sep = NA, # freq label separator (default: " = ", use ":\n" to add an extra line break)
f_lwd = 0, # lwd of freq boxes: 0 (set to tiny_lwd, lty = 0) vs. 1 (numeric), or NULL/NA (set to 0).
# f_lty = 0, # lty of freq boxes: 1 ("solid") vs. 0 ("blank"), etc. (currently not used)
# Prob links:
p_lwd = 1, # lwd of prob links: Default p_lwd = 1 (and used as p_lwd_max when p_scale = TRUE).
p_scale = FALSE, # scale widths of probability links (set by p_lwd) by current p_val?
p_lbl = "mix", # prob labels: "def", "nam"/"num"/"namnum", "abb"/"mix"/"min", or NA/NULL/"no" to hide prob labels.
# p_lty, # lty of prob links: set to default = 1 (currently not used)
arr_c = NA, # arrow code (-3 to +6). Set to defaults of -2 or 0 (by area, below).
# Text and color:
lbl_txt = txt, # labels and text elements
main = txt$scen_lbl, # main title
sub = "type", # subtitle ("type" shows generic plot type info)
title_lbl = NULL, # DEPRECATED plot title, replaced by main
cex_lbl = .90, # size of freq & text labels.
cex_p_lbl = NA, # size of prob labels (set to cex_lbl - .05 by default).
col_pal = pal, # color palette
# Generic options:
mar_notes = FALSE, # show margin notes?
... # other (graphical) parameters (passed to plot_link and plot_ftype_label)
) {
## (0) Compute new freq and prob objects (based on probability inputs): --------
## (A) If a valid set of probabilities was provided:
if (is_valid_prob_set(prev = prev, sens = sens, mirt = mirt, spec = spec, fart = fart, tol = .01)) {
# (a) Compute the complete quintet of probabilities:
prob_quintet <- comp_complete_prob_set(prev = prev, sens = sens, mirt = mirt, spec = spec, fart = fart)
sens <- prob_quintet[2] # gets sens (if not provided)
mirt <- prob_quintet[3] # gets mirt (if not provided)
spec <- prob_quintet[4] # gets spec (if not provided)
fart <- prob_quintet[5] # gets fart (if not provided)
# (b) Compute LOCAL freq and prob based on current parameters (N and probabilities):
freq <- comp_freq(prev = prev, sens = sens, spec = spec, N = N,
round = round, sample = sample) # key freq
prob <- comp_prob_prob(prev = prev, sens = sens, spec = spec) # key prob
# message("Computed local freq and prob to plot prism.")
# (c) Compute cur.popu from computed frequencies (not needed):
# cur.popu <- comp_popu(hi = freq$hi, mi = freq$mi, fa = freq$fa, cr = freq$cr) # compute cur.popu (from 4 essential frequencies)
# message("Generated new population (cur.popu) to plot.")
} else { # (B) NO valid set of probabilities was provided:
message("No valid set of probabilities provided: Using global freq & prob to plot prism.")
} # if (is_valid_prob_set)
## (1) Prepare parameters: ----------
opar <- par(no.readonly = TRUE) # all par settings that can be changed.
on.exit(par(opar)) # par(opar) # restore original settings
## (2) Key options and parameters: ----------
## 1. by Perspective: ----
# by:
by_vec <- read_by(by = by) # helper function returns vector with 3 elements:
by_top <- by_vec[1]
by_bot <- by_vec[2]
by <- by_vec[3] # updates original by to (possibly changed) by_now
## 2. Freq boxes: ----
# area:
if (is.null(area) || is.na(area) || tolower(area) == "none" || tolower(area) == "fix") { area <- "no" }
if ( !is.null(area) && !is.na(area) ) { area <- tolower(area) } # area in lowercase
if ( area == "horizontal" || area == "hrect" || area == "hbar" || area == "h" || area == "bar" || area == "bars" ) { area <- "hr" }
if ( area == "square" || area == "squares" ) { area <- "sq" }
# scale:
if ( is.null(scale) || is.na(scale) ) { scale <- "f" } # default
if ( !is.null(scale) && !is.na(scale) ) { scale <- tolower(scale) } # scale in lowercase
if (scale == "freq" || scale == "f") { scale <- "f" }
if (scale == "prob" || scale == "p") { scale <- "p" }
# use scale input:
if (scale == "f") {
## (A) Use scale for area dimensions:
## Recompute specific probabilities from current (4 essential) freq
## which may be rounded or not rounded:
prob_from_freq <- comp_prob_freq(hi = freq$hi, mi = freq$mi, fa = freq$fa, cr = freq$cr)
## Adjusting width of boxes in comp_lx_fbox (by scale argument) below!
## (B) Use scale for area dimensions AND prob values:
## A more radical type of scale (i.e., re-defining prob based on current freq)
## also changes the prob values displayed in links and margins:
prob <- prob_from_freq # use re-computed values for all prob values!
}
# f_lwd & lty:
tiny_lwd <- .001 # initialize tiny, invisible width
if ( is.null(f_lwd) || is.na(f_lwd) || f_lwd <= 0 ) {
f_lwd <- tiny_lwd # to avoid error (for lwd = 0)
lty <- 0 # "blank" (no lines) [only when f_lty and p_lty are NOT used]
}
# f_lbl_sep: Set smart default:
if ( !is.null(f_lbl) && !is.na(f_lbl) ) {
if (is.na(f_lbl_sep)) {
if (f_lbl == "def" || f_lbl == "namnum" || f_lbl == "namval" || f_lbl == "abbnum" || f_lbl == "abbval") {
f_lbl_sep <- ":\n" # add an extra line break
} else {
f_lbl_sep <- " = " # use default
}
}
}
## 3. Prob links: ----
# No probability labels: Detect special strings:
if (!is.null(p_lbl)) {
if (is.na(p_lbl) ||
p_lbl == "" || tolower(p_lbl) == "null" | tolower(p_lbl) == "na") {
p_lbl <- NA # set to NA or NULL
}
}
# arr_c:
# Note that arr_c <- NA by default:
if ( is.null(arr_c) ) { arr_c <- 0 } # sensible zero
# sensible default (based on p_scale):
if (p_scale && is.na(arr_c)) { arr_c <- 0 } # default for p_scale (unless arr_c was set)
# sensible defaults (based on area):
if ( is.na(arr_c) ) {
if (area == "no") { arr_c <- -2 } # point at far end
if (area == "hr") { arr_c <- -2 } # point at far end
if (area == "sq") { arr_c <- 0 } # no arrows
}
## 4. Text labels: ----
# Default main and subtitle labels:
if (is.null(main)) { main <- txt$scen_lbl }
if (is.na(main)) { main <- "" }
if (is.null(sub) || is.na(sub)) { sub <- "" }
# Label sizes:
if ( is.null(cex_lbl) ) { cex_lbl <- .001 } # sensible zero
if ( is.na(cex_lbl) ) { cex_lbl <- .90 } # default size of cex
if ( cex_lbl == 0 ) { cex_lbl <- .001 } # other sensible zero
if ( is.null(cex_p_lbl) ) { cex_p_lbl <- .001 } # sensible zero
if ( is.na(cex_p_lbl) ) { cex_p_lbl <- (cex_lbl - .05) } # default size of cex
if ( cex_p_lbl == 0 ) { cex_p_lbl <- .001 } # other sensible zero
## 5. Colors / color palettes: ----
# (a) Set plot background color:
par(bg = col_pal[["bg"]]) # col_pal[["bg"]] / "white" / NA (for transparent background)
# (b) Detect and handle special cases of color equality (e.g., pal_bwp):
if ( (par("bg") %in% col_pal[1:11]) && # if bg is equal to ANY fbox color AND
(f_lwd <= tiny_lwd) ) { # f_lwd is tiny_lwd (default):
f_lwd <- 1
# lty <- 1
}
## 6. Additional parameters (currently fixed): ----
lty <- 1
ftype_x <- -5.5 # x-value of ftype labels
ftype_pos <- 4 # pos of ftype labels (NULL: centered, 2: right justified, or 4: left justified)
## (3) Define plot and margin areas: ----------
## (A) Define margin areas:
if (nchar(main) > 0 | nchar(sub) > 0) { n_lines_top <- 2 } else { n_lines_top <- 0 }
if (mar_notes) { n_lines_bot <- 3 } else { n_lines_bot <- 0 }
par(mar = c(n_lines_bot, 1, n_lines_top, 1) + 0.1) # margins; default: par("mar") = 5.1 4.1 4.1 2.1.
par(oma = c(0, 0, 0, 0) + 0.1) # outer margins; default: par("oma") = 0 0 0 0.
# Axis label locations:
par(mgp = c(3, 1, 0)) # default: c(3, 1, 0)
# Orientation of the tick mark labels (and corresponding mtext captions below):
par(las = 0) # Options: parallel to the axis (0 = default), horizontal (1), perpendicular to the axis (2), vertical (3).
## (B) Plot setup:
# Levels to plot with objects:
y_levels <- 5
x_levels <- 9
x_ctr <- 0 # vertical middle / center
y_ctr <- 0 # horizontal middle / center
# Dimensions:
x_min <- -5
x_max <- +5
if ( !is.na(by_bot) ) {
y_min <- -5
} else { # is.na(by_bot):
y_min <- -1
} # if ( !is.na(by_bot) ) etc.
y_max <- +5
# Plot empty canvas:
plot(0:1, 0:1, type = "n",
xlab = "", ylab = "",
xlim = c(x_min, x_max), ylim = c(y_min, y_max),
axes = FALSE)
## Plot empty canvas:
# plot(0, 0, type = "n", bty = "n", xaxt = "n", yaxt = "n",
# xlab = "", ylab = "", xlim = c(0, x_max), ylim = c(0, y_max))
## Plot with points:
# plot(rep(0:x_max, y_max + 1), rep(0:y_max, each = x_max + 1),
# xlab = "x-axis", ylab = "y-axis")
## (C) Mark plot areas:
# (a) Mark plot area:
# col.plot <- "firebrick3"
# box("plot", col = col.plot)
# text(x_max/2, y_max/2, "Plot area", col = col.plot, cex = 1, font = 2) ## plot text
# (b) Mark margin area:
# mar.col <- "forestgreen"
# box("figure", col = mar.col)
# mtext("Margin area", side = 3, line = 2, cex = 1, font = 2, col = mar.col)
# mtext("side 1, line 3, adj 0", side = 1, line = 3, adj = 0.0, cex = cex_lbl, col = mar.col)
# mtext("side 1, line 3, adj 1", side = 1, line = 3, adj = 1.0, cex = cex_lbl, col = mar.col)
# mtext("side 3, line 0, adj 0", side = 3, line = 0, adj = 0.0, cex = cex_lbl, col = mar.col)
# mtext("side 3, line 0, adj 1", side = 3, line = 0, adj = 1.0, cex = cex_lbl, col = mar.col)
# (c) Mark outer margin area (oma):
# oma.col <- "steelblue4"
# box("outer", col = oma.col)
# mtext("Outer margin area", side = 1, line = 1, cex = 1, font = 2, col = oma.col, outer = TRUE)
# mtext("side 1, line 0, adj 0", side = 1, line = 0, adj = 0.0, cex = cex_lbl, col = oma.col, outer = TRUE)
# mtext("side 1, line 0, adj 1", side = 1, line = 0, adj = 1.0, cex = cex_lbl, col = oma.col, outer = TRUE)
# (d) Draw a grid of plot points:
# points(0, 0, pch = 1, col = grey(.66, .50), cex = 1) # mark origin
## Plot grid of points:
# grid_x <- rep(seq(x_min, x_max, by = 1), times = length(seq(y_min, y_max, by = 1))) # x/horizontal
# grid_y <- rep(seq(y_min, y_max, by = 1), each = length(seq(x_min, x_max, by = 1))) # y/vertical
# points(grid_x, grid_y, pch = 3, col = grey(.66, .50), cex = 3/4) # plot grid points
## (4) Define graphical parameters: --------
## (A) Aspect ratio of current plot:
plot_xy <- par("pin") # use par("pin") OR dev.size("in")
plot_ratio <- plot_xy[1]/plot_xy[2] # current aspect ratio
scale_x <- 1/plot_ratio # multiplicative correction factor (for x-widths)
## (B) Box parameters:
## Box dimensions: ------
## Box areas with fixed size:
# (a) rectangular box (area == "no", i.e., default):
if ( !is.na(by_bot) ) {
b_h_scale <- 1.15 # optional scaling factor (for larger box heights)
b_h <- (1 * b_h_scale) # basic box height
# gold_ratio <- 1.618 # a. golden ratio (= approx. 1.6180339887)
# wide_screen <- 16/9 # b. 1.778
compromise <- 1.66 # c. 1.66
# wider <- 1.88 # d. 1.88 (wider than wide_screen)
# b_w <- comp_lx(b_h, mf = gold_ratio, corf = scale_x) # a. gold_ratio + corrected for aspect ratio
# b_w <- comp_lx(b_h, mf = wide_screen, corf = scale_x) # b. wide_screen + corrected
b_w <- comp_lx(b_h, mf = compromise, corf = scale_x) # c. compromise + corrected
# b_w <- comp_lx(b_h, mf = wider, corf = scale_x) # d. wider + corrected
# b_w <- comp_lx(b_h, mf = 2, corf = scale_x) # x. customized width
} else { # is.na(by_bot), (i.e., single tree):
b_h <- 1
# two_to_one <- 2.0
# b_w <- comp_lx(b_h, mf = two_to_one, corf = scale_x) # a. two_to_one + corrected for aspect ratio
b_w <- comp_lx(b_h, mf = 1.9, corf = scale_x) # x. customized width
} # if ( !is.na(by_bot) ) etc.
# (b) Square box:
if (area == "sq") {
# Scale correction factor for showing 3 (single tree) instead of 5 levels (prism, double tree):
if ( !is.na(by_bot) ) { corr_3 <- 1.00 } else { corr_3 <- 1.60 } # if ( !is.na(by_bot) ) etc.
b_w <- comp_lx(b_h, mf = corr_3, corf = scale_x) # same as b_h + corrected for aspect ratio
}
## (B) Other graphical parameters:
## Dimensions:
# x_range <- x_max - 2 # range in x direction
# t_w <- x_range + b_w # total width = range + width of center box
## (5) Main fnet/ftree/prism diagram: --------
## (A) Define and plot objects: ------
# Row-by-row strategy:
# For each row (y):
# - Determine desired perspective (by "xx") of current row.
# - For each perspective:
# - define all boxes of current row (dimensions => x-pos)
# - plot all boxes of current row (from largest to smallest)
## 1st and 5th rows (top/bot: y = +4/-4): population size N ------
# box 1 dimensions:
if (area == "hr") {
# N area as horizontal rectangle:
N_l <- (x_max - 1) - (x_min + 1) # x-range of N
box_1_w <- N_l
box_1_h <- b_h # default: 1
} else if (area == "sq") {
# N area as square:
N_scale <- 3/2 # optional scaling factor (for larger N squares)
N_l <- b_h * N_scale
N_area <- N_l^2
box_1_h <- N_l
box_1_w <- comp_lx(box_1_h, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} else { # default: area == "no" and all others:
# N area fixed:
box_1_w <- b_w
box_1_h <- b_h
}
# box 1:
box_1_x <- 0 # center
box_1_y <- +4 # top row
box_1 <- make_box("N", box_1_x, box_1_y, box_1_w, box_1_h)
# plot(box_1, lbl_type = "namnum", cex = cex_lbl, lwd = f_lwd, lbl_sep = ":\nN = ") # N (top)
row_1_boxes <- list(box_1) # list of boxes (lists)
# plot label:
plot_ftype_label("N", ftype_x, box_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
if ( !is.na(by_bot) ) {
# box 5:
box_5_x <- 0 # center
box_5_y <- -4 # bottom row
box_5 <- make_box("N", box_5_x, box_5_y, box_1_w, box_1_h)
# plot(box_5, lbl_type = f_lbl, cex = cex_lbl, lwd = 1.0, density = 20) # N (bot): illustrate diagonal lines (via density)
row_1_boxes <- list(box_1, box_5) # list of boxes (lists)
# plot label:
plot_ftype_label("N", ftype_x, box_5_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} # if ( !is.na(by_bot) ) etc.
# plot list of fboxes:
# plot_fbox_list(row_1_boxes, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd) # plot list of boxes
## 3rd row (y = 0, center): SDT cases/cells as 4 boxes: ------
# dimensions lx:
if (area == "hr") { # Scale SDT cases/cells as horizontal rectangles:
# Compute lx for current scale (and current freq and prob values):
hi_lx <- comp_lx_fbox("hi", len_N = N_l, cur_freq = freq, cur_prob = prob, scale = scale)
mi_lx <- comp_lx_fbox("mi", len_N = N_l, cur_freq = freq, cur_prob = prob, scale = scale)
fa_lx <- comp_lx_fbox("fa", len_N = N_l, cur_freq = freq, cur_prob = prob, scale = scale)
cr_lx <- comp_lx_fbox("cr", len_N = N_l, cur_freq = freq, cur_prob = prob, scale = scale)
# Set ly: fixed & all equal:
hi_ly <- b_h
mi_ly <- b_h
fa_ly <- b_h
cr_ly <- b_h
} else if (area == "sq") { # Scale SDT case/cell areas as squares:
# Compute ly for current scale:
hi_ly <- comp_ly_fsqr("hi", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale)
mi_ly <- comp_ly_fsqr("mi", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale)
fa_ly <- comp_ly_fsqr("fa", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale)
cr_ly <- comp_ly_fsqr("cr", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale)
# Compute lx corresponding to ly:
hi_lx <- comp_lx(hi_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
mi_lx <- comp_lx(mi_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
fa_lx <- comp_lx(fa_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
cr_lx <- comp_lx(cr_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} else { # default: area == "no" and all others:
# Set lx: fixed & all equal:
hi_lx <- b_w
mi_lx <- b_w
fa_lx <- b_w
cr_lx <- b_w
# Set ly: fixed & all equal:
hi_ly <- b_h
mi_ly <- b_h
fa_ly <- b_h
cr_ly <- b_h
} # if (area == etc.)
# coordinates:
box_3_y <- 0 # y in center
if (area == "hr") {
# adjust x-coordinates to scaled dimensions:
if (by_top == "cd") {
# by cd: hi mi fa cr
hi_x <- (x_min + 1) + (hi_lx)/2
mi_x <- (x_min + 1) + (hi_lx) + (mi_lx)/2
fa_x <- (x_min + 1) + (hi_lx) + (mi_lx) + (fa_lx)/2
cr_x <- (x_min + 1) + (hi_lx) + (mi_lx) + (fa_lx) + (cr_lx)/2
} else if (by_top == "dc") {
# by dc: hi fa mi cr
hi_x <- (x_min + 1) + (hi_lx)/2
fa_x <- (x_min + 1) + (hi_lx) + (fa_lx)/2
mi_x <- (x_min + 1) + (hi_lx) + (fa_lx) + (mi_lx)/2
cr_x <- (x_min + 1) + (hi_lx) + (fa_lx) + (mi_lx) + (cr_lx)/2
} else if (by_top == "ac") {
# by ac: hi cr mi fa
hi_x <- (x_min + 1) + (hi_lx)/2
cr_x <- (x_min + 1) + (hi_lx) + (cr_lx)/2
mi_x <- (x_min + 1) + (hi_lx) + (cr_lx) + (mi_lx)/2
fa_x <- (x_min + 1) + (hi_lx) + (cr_lx) + (mi_lx) + (fa_lx)/2
} else {
message(paste0("Unknown primary perspective: by_top = ", by_top))
} # if (by_top == etc.)
} else { # area == "no" OR "sq":
# fixed x-coordinates:
if (by_top == "cd") {
# by cd: hi mi fa cr
hi_x <- -3
mi_x <- -1
fa_x <- +1
cr_x <- +3
} else if (by_top == "dc") {
# by dc: hi fa mi cr
hi_x <- -3
fa_x <- -1
mi_x <- +1
cr_x <- +3
} else if (by_top == "ac") {
# by ac: hi cr mi fa
hi_x <- -3
cr_x <- -1
mi_x <- +1
fa_x <- +3
} else {
message(paste0("Unknown primary perspective: by_top = ", by_top))
} # if (by_top == etc.)
} # if (area == etc.)
# define boxes:
box_hi <- make_box("hi", hi_x, box_3_y, hi_lx, hi_ly) # hi
box_mi <- make_box("mi", mi_x, box_3_y, mi_lx, mi_ly) # mi
box_fa <- make_box("fa", fa_x, box_3_y, fa_lx, fa_ly) # fa
box_cr <- make_box("cr", cr_x, box_3_y, cr_lx, cr_ly) # cr
## plot boxes: 4 SDT cases/cells
## OLD: Plot boxes:
# plot(box_hi, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd)
# plot(box_mi, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd)
# plot(box_fa, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd)
# plot(box_cr, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd)
## NEW: Plot boxes by decreasing freq/prob (to prevent occlusion of box labels).
## See comp_freq_fbox + plot_fbox_list in plot_util.R.
row_3_boxes <- list(box_hi, box_mi, box_fa, box_cr) # list of boxes (lists)
# plot_fbox_list(row_3_boxes, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd) # plot list of boxes
# plot label:
plot_ftype_label("hi", ftype_x, box_3_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
## 2nd row (y = +2): by_top perspective ------
# Note: Express all widths of compound frequencies
# as sums of hi_lx mi_lx fa_lx cr_lx!
# box dimensions (w and h):
box_2_1_lx <- b_w # default box width
box_2_2_lx <- b_w
box_2_1_ly <- b_h # default box height
box_2_2_ly <- b_h
# default box coordindates (x and y):
box_2_1_x <- -2 # left of center
box_2_2_x <- +2 # right of center
box_2_1_y <- +2 # above center
box_2_2_y <- +2 # above center
# Define boxes and labels by perspective:
if (by_top == "cd") {
# (a) by condition:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_2_1_lx <- (hi_lx + mi_lx) # lx of cond_true
box_2_2_lx <- (fa_lx + cr_lx) # lx of cond_true
# adjust x-coordinates to scaled dimensions:
box_2_1_x <- (x_min + 1) + box_2_1_lx/2
box_2_2_x <- (x_min + 1) + box_2_1_lx + box_2_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_2_1_ly <- comp_ly_fsqr("cond_true", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_true
box_2_2_ly <- comp_ly_fsqr("cond_false", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_false
# Compute lx corresponding to ly:
box_2_1_lx <- comp_lx(box_2_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_2_2_lx <- comp_lx(box_2_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_2_1 <- make_box("cond_true", box_2_1_x, box_2_1_y, box_2_1_lx, box_2_1_ly)
box_2_2 <- make_box("cond_false", box_2_2_x, box_2_2_y, box_2_2_lx, box_2_2_ly)
# plot label:
plot_ftype_label("cond_true", ftype_x, box_2_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else if (by_top == "dc") {
# (b) by decision:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_2_1_lx <- (hi_lx + fa_lx) # lx of dec_pos
box_2_2_lx <- (mi_lx + cr_lx) # lx of dec_neg
# adjust x-coordinates to scaled dimensions:
box_2_1_x <- (x_min + 1) + box_2_1_lx/2
box_2_2_x <- (x_min + 1) + box_2_1_lx + box_2_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_2_1_ly <- comp_ly_fsqr("dec_pos", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_pos
box_2_2_ly <- comp_ly_fsqr("dec_neg", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_neg
# Compute lx corresponding to ly:
box_2_1_lx <- comp_lx(box_2_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_2_2_lx <- comp_lx(box_2_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_2_1 <- make_box("dec_pos", box_2_1_x, box_2_1_y, box_2_1_lx, box_2_1_ly)
box_2_2 <- make_box("dec_neg", box_2_2_x, box_2_2_y, box_2_2_lx, box_2_2_ly)
# plot label:
plot_ftype_label("dec_pos", ftype_x, box_2_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else if (by_top == "ac") {
# (c) by accuracy:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_2_1_lx <- (hi_lx + cr_lx) # lx of dec_cor
box_2_2_lx <- (mi_lx + fa_lx) # lx of dec_err
# adjust x-coordinates to scaled dimensions:
box_2_1_x <- (x_min + 1) + box_2_1_lx/2
box_2_2_x <- (x_min + 1) + box_2_1_lx + box_2_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_2_1_ly <- comp_ly_fsqr("dec_cor", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_cor
box_2_2_ly <- comp_ly_fsqr("dec_err", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_err
# Compute lx corresponding to ly:
box_2_1_lx <- comp_lx(box_2_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_2_2_lx <- comp_lx(box_2_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_2_1 <- make_box("dec_cor", box_2_1_x, box_2_1_y, box_2_1_lx, box_2_1_ly)
box_2_2 <- make_box("dec_err", box_2_2_x, box_2_2_y, box_2_2_lx, box_2_2_ly)
# plot label:
plot_ftype_label("dec_cor", ftype_x, box_2_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else { # default on top: same as (by_top == "cd")
# (+) by condition:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_2_1_lx <- (hi_lx + mi_lx) # lx of cond_true
box_2_2_lx <- (fa_lx + cr_lx) # lx of cond_true
# adjust x-coordinates to scaled dimensions:
box_2_1_x <- (x_min + 1) + box_2_1_lx/2
box_2_2_x <- (x_min + 1) + box_2_1_lx + box_2_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_2_1_ly <- comp_ly_fsqr("cond_true", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_true
box_2_2_ly <- comp_ly_fsqr("cond_false", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_false
# Compute lx corresponding to ly:
box_2_1_lx <- comp_lx(box_2_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_2_2_lx <- comp_lx(box_2_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_2_1 <- make_box("cond_true", box_2_1_x, box_2_1_y, box_2_1_lx, box_2_1_ly)
box_2_2 <- make_box("cond_false", box_2_2_x, box_2_2_y, box_2_2_lx, box_2_2_ly)
# plot label:
plot_ftype_label("cond_true", ftype_x, box_2_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
}
## OLD: plot boxes:
# plot(box_2_1, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd, lbl_sep = ":\n")
# plot(box_2_2, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd, lbl_sep = ":\n")
# NEW:
row_2_boxes <- list(box_2_1, box_2_2) # list of boxes (lists)
# plot_fbox_list(row_2_boxes, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd) # plot list of boxes
## 4th row (y = -2): by perspective ------
if ( !is.na(by_bot) ) {
## Note: Repeat code of 2nd row above (with 4 changes:
## mirrored y-values, "by_bot" for "by_top", "box_4_" for "box_2_", default on top/bot):
# box dimensions (w and h):
box_4_1_lx <- b_w # default box width
box_4_2_lx <- b_w
box_4_1_ly <- b_h # default box height
box_4_2_ly <- b_h
# fixed box coordindates (x and y):
box_4_1_x <- -2 # left of center
box_4_2_x <- +2 # right of center
box_4_1_y <- -2 # BELOW center
box_4_2_y <- -2 # BELOW center
# Define boxes and labels by perspective:
if (by_bot == "cd") {
# (a) by condition:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_4_1_lx <- (hi_lx + mi_lx) # lx of cond_true
box_4_2_lx <- (fa_lx + cr_lx) # lx of cond_true
# adjust x-coordinates to scaled dimensions:
box_4_1_x <- (x_min + 1) + box_4_1_lx/2
box_4_2_x <- (x_min + 1) + box_4_1_lx + box_4_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_4_1_ly <- comp_ly_fsqr("cond_true", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_true
box_4_2_ly <- comp_ly_fsqr("cond_false", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # cond_false
# Compute lx corresponding to ly:
box_4_1_lx <- comp_lx(box_4_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_4_2_lx <- comp_lx(box_4_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_4_1 <- make_box("cond_true", box_4_1_x, box_4_1_y, box_4_1_lx, box_4_1_ly)
box_4_2 <- make_box("cond_false", box_4_2_x, box_4_2_y, box_4_2_lx, box_4_2_ly)
# plot label:
plot_ftype_label("cond_true", ftype_x, box_4_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else if (by_bot == "dc") {
# (b) by decision:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_4_1_lx <- (hi_lx + fa_lx) # lx of dec_pos
box_4_2_lx <- (mi_lx + cr_lx) # lx of dec_neg
# adjust x-coordinates to scaled dimensions:
box_4_1_x <- (x_min + 1) + box_4_1_lx/2
box_4_2_x <- (x_min + 1) + box_4_1_lx + box_4_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_4_1_ly <- comp_ly_fsqr("dec_pos", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_pos
box_4_2_ly <- comp_ly_fsqr("dec_neg", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_neg
# Compute lx corresponding to ly:
box_4_1_lx <- comp_lx(box_4_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_4_2_lx <- comp_lx(box_4_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_4_1 <- make_box("dec_pos", box_4_1_x, box_4_1_y, box_4_1_lx, box_4_1_ly)
box_4_2 <- make_box("dec_neg", box_4_2_x, box_4_2_y, box_4_2_lx, box_4_2_ly)
# plot label:
plot_ftype_label("dec_pos", ftype_x, box_4_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else if (by_bot == "ac") {
# (c) by accuracy:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_4_1_lx <- (hi_lx + cr_lx) # lx of dec_cor
box_4_2_lx <- (mi_lx + fa_lx) # lx of dec_err
# adjust x-coordinates to scaled dimensions:
box_4_1_x <- (x_min + 1) + box_4_1_lx/2
box_4_2_x <- (x_min + 1) + box_4_1_lx + box_4_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_4_1_ly <- comp_ly_fsqr("dec_cor", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_cor
box_4_2_ly <- comp_ly_fsqr("dec_err", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_err
# Compute lx corresponding to ly:
box_4_1_lx <- comp_lx(box_4_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_4_2_lx <- comp_lx(box_4_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_4_1 <- make_box("dec_cor", box_4_1_x, box_4_1_y, box_4_1_lx, box_4_1_ly)
box_4_2 <- make_box("dec_err", box_4_2_x, box_4_2_y, box_4_2_lx, box_4_2_ly)
# plot label:
plot_ftype_label("dec_cor", ftype_x, box_4_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
} else { # default on bot: same as (by_bot == "dc")
# (+) by decision:
if (area == "hr") {
# scale dimensions (as sums of SDT dimensions):
box_4_1_lx <- (hi_lx + fa_lx) # lx of dec_pos
box_4_2_lx <- (mi_lx + cr_lx) # lx of dec_neg
# adjust x-coordinates to scaled dimensions:
box_4_1_x <- (x_min + 1) + box_4_1_lx/2
box_4_2_x <- (x_min + 1) + box_4_1_lx + box_4_2_lx/2
} else if (area == "sq") { # Scale area as square:
# Compute ly for current scale:
box_4_1_ly <- comp_ly_fsqr("dec_pos", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_pos
box_4_2_ly <- comp_ly_fsqr("dec_neg", area_N = N_area, cur_freq = freq, cur_prob = prob, scale = scale) # dec_neg
# Compute lx corresponding to ly:
box_4_1_lx <- comp_lx(box_4_1_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
box_4_2_lx <- comp_lx(box_4_2_ly, mf = corr_3, corf = scale_x) # same, but corrected for aspect ratio
} # if (area == etc.)
# define boxes:
box_4_1 <- make_box("dec_pos", box_4_1_x, box_4_1_y, box_4_1_lx, box_4_1_ly)
box_4_2 <- make_box("dec_neg", box_4_2_x, box_4_2_y, box_4_2_lx, box_4_2_ly)
# plot label:
plot_ftype_label("dec_pos", ftype_x, box_4_1_y, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
}
## OLD: plot boxes:
# plot(box_4_1, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd, lbl_sep = ":\n")
# plot(box_4_2, lbl_type = f_lbl, cex = cex_lbl, lwd = f_lwd, lbl_sep = ":\n")
# NEW:
row_4_boxes <- list(box_4_1, box_4_2) # list of boxes (lists)
} # if ( !is.na(by_bot) ) etc.
## Combine ALL boxes:
if ( !is.na(by_bot) ) {
all_boxes <- c(row_1_boxes, row_2_boxes, row_3_boxes, row_4_boxes)
} else {
all_boxes <- c(row_1_boxes, row_2_boxes, row_3_boxes)
} # if ( !is.na(by_bot) ) etc.
## Plot ALL boxes at once:
# plot_fbox_list(all_boxes, lbl_type = f_lbl, lbl_sep = ":\n", cex = cex_lbl, lwd = f_lwd, density = NA) # plot list of boxes
plot_fbox_list(all_boxes, # plot list of boxes
cur_freq = freq, lbl_txt = lbl_txt, col_pal = col_pal, # PASS current freq/txt/pal arguments!
lbl_type = f_lbl, lbl_sep = f_lbl_sep,
cex = cex_lbl, lwd = f_lwd, lty = lty) # no ...!
## (B) Plot probabilities as links: ------
## parameters:
## from top:
## row 1 to 2: ----
plot_link(box_1, box_2_1, 1, 3, cur_prob = prob, arr_code = arr_c,
lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...!
plot_link(box_1, box_2_2, 1, 3, cur_prob = prob, arr_code = arr_c,
lbl_type = p_lbl, lbl_pos = 4, lbl_off = 1, cex = cex_p_lbl,
lbl_sep = "\n = ", # special case: cprev label !!!
col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...! # link label in 2 lines
## row 2 to 3: ----
# Links depend on perspectives/box types:
if (by_top == "cd") { # row 2: by condition (cond_true vs. cond_false)
## (a) by condition:
plot_link(box_2_1, box_hi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - hi
plot_link(box_2_1, box_mi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - mi
plot_link(box_2_2, box_fa, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - fa
plot_link(box_2_2, box_cr, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - cr
} else if (by_top == "dc") { # row 2: by decision (dec_pos vs. dec_neg)
## (b) by decision:
plot_link(box_2_1, box_hi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - hi
plot_link(box_2_1, box_fa, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - fa !
plot_link(box_2_2, box_mi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - mi !
plot_link(box_2_2, box_cr, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - cr
} else if (by_top == "ac") { # row 2: by accuracy (dec_cor vs. dec_err)
## (c) by accuracy:
plot_link(box_2_1, box_hi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - hi: acc_hi
plot_link(box_2_1, box_cr, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - cr: acc_cr
plot_link(box_2_2, box_mi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - mi: err_mi
plot_link(box_2_2, box_fa, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - fa: err_fa
} else { # default on top: same as (by_top == "cd")
## (+) by condition:
plot_link(box_2_1, box_hi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - hi
plot_link(box_2_1, box_mi, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - mi
plot_link(box_2_2, box_fa, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - fa
plot_link(box_2_2, box_cr, 1, 3, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - cr
}
## from bottom:
if ( !is.na(by_bot) ) {
## row 4 to 3: ----
# Links depend on perspectives/box types:
if (by_bot == "cd") { # row 4: by condition (cond_true vs. cond_false)
# (a) by condition:
plot_link(box_4_1, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - hi
plot_link(box_4_1, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_true - mi
plot_link(box_4_2, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - fa
plot_link(box_4_2, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # cond_false - cr
} else if (by_bot == "dc") { # row 4: by decision (dec_pos vs. dec_neg)
# (b) by decision:
plot_link(box_4_1, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - hi
plot_link(box_4_1, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - fa !
plot_link(box_4_2, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - mi !
plot_link(box_4_2, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - cr
} else if (by_bot == "ac") { # row 4: by accuracy (dec_cor vs. dec_err)
# (c) by accuracy:
plot_link(box_4_1, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - hi: acc_hi
plot_link(box_4_1, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - cr: acc_cr
plot_link(box_4_2, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - mi: err_mi
plot_link(box_4_2, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - fa: err_fa
} else { # default on bot: same as (by_bot == "dc")
# (+) by decision:
plot_link(box_4_1, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - hi
plot_link(box_4_1, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - fa !
plot_link(box_4_2, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - mi !
plot_link(box_4_2, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - cr
## OLDER default: show 4 boxes (dec_pos / dec_neg) vs. (dec_cor / dec_err):
# # 2 default boxes:
# plot_link(box_4_1, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = NULL, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - hi / PPV
# plot_link(box_4_1, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = NULL, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_pos - fa
# plot_link(box_4_2, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = 3, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - mi
# plot_link(box_4_2, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 3, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_neg - cr / NPV
#
# # 2 additional boxes:
# plot_link(box_4_3, box_hi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - hi
# plot_link(box_4_3, box_cr, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_cor - cr
# plot_link(box_4_4, box_mi, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = NULL, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - mi
# plot_link(box_4_4, box_fa, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = NULL, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...! # dec_err - fa
}
## row 5 to 4: ----
if (by_bot == "cd" || by_bot == "dc" || by_bot == "ac" ) {
# link to 2 default boxes:
plot_link(box_5, box_4_1, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...!
plot_link(box_5, box_4_2, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, lbl_off = 4/4, cex = cex_p_lbl, col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...!
} else { # link to 4 boxes (dec_pos / dec_neg) vs. (dec_cor / dec_err):
# link to 2 default boxes:
plot_link(box_5, box_4_1, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, cex = cex_p_lbl, col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...!
plot_link(box_5, box_4_2, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 2, lbl_off = 4/4, cex = cex_p_lbl, col_pal = col_pal,
p_lwd = p_lwd, p_scale = p_scale,
...) # Allow ...!
## OLDER: link to 2 additional boxes:
# plot_link(box_5, box_4_3, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = p_lbl, lbl_pos = 4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...!
# plot_link(box_5, box_4_4, 3, 1, cur_prob = prob, arr_code = arr_c, lbl_type = "num", lbl_pos = 4, lbl_off = 4/4, cex = cex_p_lbl, col_pal = col_pal, p_lwd = p_lwd, p_scale = p_scale, ...) # Allow ...!
}
} # if ( !is.na(by_bot) ) etc.
## (C) Plot other stuff: ------
# box_else <- make_box("else_box", 9, -2, b_w, b_h) # define some arbitrary box
# plot(box_else, col = "firebrick1", cex = 1/2, font = 2) # plot box
## ftype labels:
# plot_ftype_label("N", ftype_x, 4, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
# plot_ftype_label("cond_true", ftype_x, 2, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
# plot_ftype_label("hi", ftype_x, 0, lbl_txt = lbl_txt, suffix = ":", pos = ftype_pos, col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
# plot_ftype_label("N", ftype_x, -4, pos = ftype_pos, lbl_txt = lbl_txt, suffix = ":", col = pal["txt"], cex = cex_lbl, ...) # Allow ...!
## (6) Title: ------
# Main title: Handle deprecated "title_lbl" argument: ----
if (is.null(title_lbl) == FALSE){
message("Argument 'title_lbl' is deprecated. Please use 'main' instead.")
main <- title_lbl
}
# Subtitle (2nd line): ----
if (sub == "type"){ # show default plot type info:
if ( !is.na(by_bot) ) {
sub <- paste0(lbl["plot_prism_lbl"], " (by ", as.character(by), ")") # plot name: prism/network/double tree.
} else {
sub <- paste0(lbl["plot_tree_lbl"], " (by ", as.character(by), ")") # plot name: tree/double tree.
} # if ( !is.na(by_bot) )
}
# Combine title + subtitle: ----
if ( (main != "") & (sub == "") ){ # only main title:
cur_title_lbl <- main
} else if ( (main == "") & (sub != "") ){ # only subtitle:
cur_title_lbl <- sub
} else { # combine both:
cur_title_lbl <- paste0(main, ":\n", sub) # add ":" and line break
}
# Plot title: ----
title(cur_title_lbl, adj = 0, line = 0, font.main = 1, cex.main = 1.2) # (left, NOT raised (by +1), normal font)
## (7) Margins: ------
if (mar_notes) {
# Note:
note_lbl <- "" # initialize
if ( (area != "no") && (scale == "f") ) { # Note area type and scaling by f:
note_lbl <- label_note(area = area, scale = scale)
}
plot_mar(show_freq = TRUE, show_cond = TRUE, show_dec = TRUE,
show_accu = TRUE, accu_from_freq = FALSE,
note = note_lbl,
cur_freq = freq, cur_prob = prob, lbl_txt = lbl_txt)
} # if (mar_notes)
## Finish: ---------
# on.exit(par(opar)) # par(opar) # restore original settings
invisible() # restores par(opar)
} # plot_prism().
## Check: ------
# ## Basics:
#
# ## Global freq and prob objects:
# plot_prism() # default, same as:
# plot_prism(by = "cddc", area = "no", scale = "f",
# f_lbl = "default", f_lwd = 0, cex_lbl = .90,
# p_lbl = "mix", arr_c = -2, cex_p_lbl = NA)
#
# ## Locally computed values:
# plot_prism(N = 10, prev = 1/2, sens = 4/5, spec = 3/5)
# plot_prism(N = 10, prev = 1/3, sens = 3/5, spec = 4/5, area = "hr")
# plot_prism(N = 10, prev = 1/4, sens = 3/5, spec = 2/5, area = "sq", mar_notes = TRUE)
#
# ## Custom text and color settings:
# my_txt <- init_txt(cond_lbl = "The Truth", cond_true_lbl = "so true", cond_false_lbl = "so false",
# hi_lbl = "TP", mi_lbl = "FN", fa_lbl = "FP", cr_lbl = "TN")
# my_col <- init_pal(N_col = rgb(0, 169, 224, max = 255), # seeblau
# hi_col = "gold", mi_col = "firebrick1", fa_col = "firebrick2", cr_col = "orange")
# plot_prism(f_lbl = "nam", lbl_txt = my_txt, col_pal = my_col)
#
# ## Local values and custom color and text settings:
# plot_prism(N = 7, prev = 1/2, sens = 3/5, spec = 4/5, round = FALSE,
# by = "cdac", lbl_txt = txt_org, f_lbl = "namnum", f_lbl_sep = ":\n",
# col_pal = pal_rgb) # custom colors
#
# plot_prism(N = 5, prev = 1/2, sens = .8, spec = .5, scale = "p", # note scale!
# by = "cddc", area = "hr", col_pal = pal_bw, f_lwd = 1) # custom colors
#
# plot_prism(N = 3, prev = .50, sens = .50, spec = .50, scale = "p", # note scale!
# area = "sq", lbl_txt = txt_org, f_lbl = "namnum", f_lbl_sep = ":\n", # custom text
# col_pal = pal_kn, f_lwd = .5) # custom colors
#
# ## Plot versions:
# # (a) single tree (nchar(by) == 2):
# plot_prism(by = "cd", f_lbl = "def") # by condition (freq boxes: hi mi fa cr)
# plot_prism(by = "dc", f_lbl = "def") # by decision (freq boxes: hi fa mi cr)
# plot_prism(by = "ac", f_lbl = "def") # by decision (freq boxes: hi cr mi fa)
#
# # (b) double tree (nchar(by) == 4):
# # (3 x 2) = 6 versions (+ 3 redundant ones):
# plot_prism(by = "cddc") # v01 (default)
# plot_prism(by = "cdac") # v02
# plot_prism(by = "cdcd") # (+) Message
#
# plot_prism(by = "dccd") # v03
# plot_prism(by = "dcac") # v04
# plot_prism(by = "dcdc") # (+) Message
#
# plot_prism(by = "accd") # v05
# plot_prism(by = "acdc") # v06
# plot_prism(by = "acac") # (+) Message
#
# ## Plot options:
# # area:
# plot_prism(area = "no") # rectangular boxes (default): (same if area = NA/NULL)
# plot_prism(area = "hr") # horizontal rectangles (widths on each level sum to N)
# plot_prism(area = "sq") # squares (areas on each level sum to N)
#
# # scale (matters for scaled areas and small N):
# plot_prism(area = "hr", scale = "f") # widths scaled by (rounded or non-rounded) freq
# plot_prism(area = "hr", scale = "p") # widths scaled by prob
# plot_prism(area = "sq", scale = "f") # areas scaled by (rounded or non-rounded) freq
# plot_prism(area = "sq", scale = "p") # areas scaled by prob
#
# ## Freq (as boxes):
#
# # f_lbl:
# plot_prism(f_lbl = "default") # default: short name and numeric value (abb = num)
# plot_prism(f_lbl = "abb") # abbreviated freq names (variable names)
# plot_prism(f_lbl = "nam") # only freq names
# plot_prism(f_lbl = "num") # only numeric freq values
# plot_prism(f_lbl = "namnum") # names and numeric freq values
# plot_prism(f_lbl = "namnum", cex_lbl = .75) # smaller freq labels
# plot_prism(f_lbl = NA) # no freq labels
# plot_prism(f_lbl = "any") # short name and value (abb = num)
#
# # f_lwd:
# plot_prism(f_lwd = 0) # no lines (default), set to tiny_lwd = .001, lty = 0 (same if NA/NULL)
# plot_prism(f_lwd = 1) # basic lines
# plot_prism(f_lwd = 3) # thicker lines
# plot_prism(f_lwd = .5) # thinner lines
#
# ## Prob (as links):
# # p_lbl: Label types
# plot_prism(p_lbl = "mix") # abbreviated names with numeric values (abb = num)
# plot_prism(p_lbl = NA) # no prob labels (NA/NULL/"none")
# plot_prism(p_lbl = "nam") # only prob names
# plot_prism(p_lbl = "num") # only numeric prob values
# plot_prism(p_lbl = "namnum") # names and numeric prob values
# plot_prism(p_lbl = "namnum", cex_p_lbl = .70) # smaller prob labels
# plot_prism(by = "cddc", p_lbl = "min") # minimal labels
# plot_prism(by = "cdac", p_lbl = "min")
# plot_prism(by = "cddc", p_lbl = "mix") # mix abbreviated names and numeric values
# plot_prism(by = "cdac", p_lbl = "mix")
# plot_prism(by = "cddc", p_lbl = "abb") # abbreviated names
# plot_prism(by = "cdac", p_lbl = "abb")
# plot_prism(p_lbl = "any") # short name and value (abb = num)
#
# # arr_c:
# plot_prism(arr_c = 0) # acc_c = 0: no arrows
# plot_prism(arr_c = -3) # arr_c = -1 to -3: points at both ends
# plot_prism(arr_c = -2) # point at far end
# plot_prism(arr_c = +2) # crr_c = 1-3: V-shape arrows at far end
# plot_prism(arr_c = +3) # V-shape arrows at both ends
# plot_prism(arr_c = +6) # arr_c = 4-6: T-shape arrows
#
#
# ## Plain plot versions:
# plot_prism(area = "no", f_lbl = "nam", p_lbl = NA, col_pal = pal_rgb)
# plot_prism(area = "no", f_lbl = "abb", p_lbl = "abb", col_pal = pal_bw)
# plot_prism(area = "no", f_lbl = "num", p_lbl = "num", col_pal = pal_kn)
#
# plot_prism(area = "hr", f_lbl = "abb", p_lbl = NA, arr_c = 0, col_pal = pal_rgb)
# plot_prism(area = "hr", f_lbl = "num", p_lbl = NA, arr_c = 0)
# plot_prism(area = "hr", f_lbl = "abb", p_lbl = "num", arr_c = 0)
#
# plot_prism(area = "sq", f_lbl = "abb", p_lbl = NA, col_pal = pal_rgb)
# plot_prism(area = "sq", f_lbl = "num", p_lbl = NA, f_lwd = 1, col_pal = pal_bw)
# plot_prism(area = "sq", f_lbl = "def", p_lbl = NA, f_lwd = 1, col_pal = pal_kn)
#
# ## Suggested combinations:
# plot_prism(f_lbl = "def", p_lbl = "mix")
# plot_prism(f_lbl = "namnum", p_lbl = "mix", cex_lbl = .80, cex_p_lbl = .75)
#
# plot_prism(area = "hr", f_lbl = "nam", p_lbl = NA, arr_c = 0, lbl_txt = txt_TF)
# plot_prism(area = "hr", f_lbl = "abb", p_lbl = "abb", f_lwd = 1, col_pal = pal_bw)
# plot_prism(area = "hr", f_lbl = "num", p_lbl = "num", col_pal = pal_rgb)
#
# plot_prism(area = "sq", f_lbl = "nam", p_lbl = "abb", lbl_txt = txt_TF)
# plot_prism(area = "sq", f_lbl = "num", p_lbl = "num", f_lwd = 1, col_pal = pal_rgb)
# plot_prism(area = "sq", f_lbl = "def", p_lbl = "mix", f_lwd = 1, col_pal = pal_kn)
read_by <- function(by){
# Helper function with
# - input: by argument and
# - output: vector of by_top, by_bot, and (possibly different) by_now:
# Initialize outputs:
by_top <- NULL
by_bot <- NULL
by_now <- NULL
# Interpret inputs:
if ( !is.null(by) && !is.na(by) ) { by <- tolower(by) } # by in lowercase
if ( is.null(by) || is.na(by) ) { by <- "cddc" } # use default
if (by == "any" || by == "all" || by == "default" || by == "def" || by == "no" ) { by <- "cddc" } # use default
# Use by input:
# Case 1: Plot 2 perspectives (prism, double tree):
if (nchar(by) >= 4) {
by_top <- substr(by, 1, 2) # top perspective (row 2): by = "cd" "dc" "ac"
by_bot <- substr(by, 3, 4) # bottom perspective (row 4): by = "cd" "dc" "ac"
# Catch & correct invalid entries:
if (by_top == by_bot) {
message("Specified 2 identical perspectives.")
}
# Invalid perspectives:
if ((by_top %in% c("cd", "dc", "ac")) == FALSE) {
message("Invalid 1st perspective! Valid by = {'cddc', 'cdac', 'dccd', 'dcac', 'accd', 'acdc'}.\nUsing by = 'cd..'.")
by_top <- "cd" # default
}
if ((by_bot %in% c("cd", "dc", "ac")) == FALSE) {
message("Invalid 2nd perspective! Valid by = {'cddc', 'cdac', 'dccd', 'dcac', 'accd', 'acdc'}.\nUsing by = '..dc'.")
by_bot <- "dc" # default
}
# Valid 1st but invalid 2nd perspective:
if ((by_top == "cd") && (by_bot != ("dc") & by_bot != ("ac") & by_bot != ("cd"))) {
message("If 1st perspective by = 'cd', 2nd perspective should be 'dc' or 'ac'.\nUsing by = 'cddc'.")
by_bot <- "dc" # default 1
}
if ((by_top == "dc") && (by_bot != ("cd") & by_bot != ("ac") & by_bot != ("dc"))) {
message("If 1st perspective by = 'dc', 2nd perspective should be 'cd' or 'ac'.\nUsing by = 'dccd'.")
by_bot <- "cd" # default 2
}
if ((by_top == "ac") && (by_bot != ("cd") & by_bot != ("dc") & by_bot != ("ac"))) {
message("If 1st perspective by = 'ac', 2nd perspective should be 'cd' or 'dc'.\nUsing by = 'accd'.")
by_bot <- "cd" # default 3
}
}
# Case 2: Plot 1 perspective (single tree):
if (nchar(by) <= 2) {
by_top <- substr(by, 1, 2) # top perspective (row 2): by = "cd" "dc" "ac"
if ((by_top %in% c("cd", "dc", "ac")) == FALSE) {
message("Invalid perspective! Valid by = {'cd', 'dc', 'ac'}.\nUsing by = 'cd'.")
by_top <- "cd" # default
}
# by_bot <- "dc" # Temporary HACK (to allow testing Case 2 with plot code requiring 2 perspectives)!
by_bot <- NA # signal absence of 2nd perspective
}
# Determine current version of by (by_now, which may be different from original by):
if ( !is.na(by_bot) ) {
by_now <- paste0(by_top, by_bot)
} else {
by_now <- by_top
} # if ( !is.na(by_bot) ) etc.
# print(by_now)
# Finish:
return(c(by_top, by_bot, by_now))
} # read_by() end.
## Check:
# read_by(by = "cd")
# read_by(by = "cddc")
# read_by(by = "xx")
# read_by(by = "cdxx")
# read_by(by = "xxxxxx")
## Done: ------
## (0) Design as function plot_prism (generalizing plot_fnet).
## (1) Rather than not computing anything (only using global objects freq & prob)
## this version computes local freq & prob lists when possible.
## (2) Add lbl_txt and col_pal as arguments to customize txt and pal options.
## (3) Strategy/rationale:
##
## (a) Always compute _dimensions_ (width and height) of boxes first.
## 1. with fixed width & height
## 2. widths scaled horizontally (sums = N)
## 3. area as squares (area = freq/prob)
##
## (b) Distinguish 2 basic variants for all scaling operations and
## 2 corresponding geometric layout versions:
## Compute current dimensions (locations of 4 boxes: hi mi fa cr) based on
## 1. current freq (rounded or non-rounded)
## 2. current prob ( == non-rounded frequencies ): always show ALL areas > 0.
##
## (c) Compute _positions_ of boxes from current layout,
## plus box dimensions (width and height).
## (4) Plot sets/lists of boxes by their freq/prob values (from large to small,
## to prevent occlusion of freq labels of smaller boxes) => plot_util.R
## (5) Add better options for box and link labels
## (e.g., analog to previous "mix" and "min".) => plot_util.R
## (6) Add documentation and integrate in current riskyr package (./R)
## with sensible defaults.
## (7) Now scaling prob by freq when scale == "f" (as in plot_area, plot_tab)!
## (8) Add ftype_pos parameter and adjust ftype_x and x_min
## to control ftype labels on left.
## (9) Allow ... to pass graphical parameters (to plot_link & plot_ftype_label, but NOT plot_fbox_list).
## (10) Interpret by argument in separate read_by helper function.
## (11) Generalise from 2 perspectives (prism, double tree) to
## only showing 1 perspective (by_top: single tree).
## (12) Re-shuffle x positions of 4 SDT boxes by 1st perspective (by_top)
## so that prob-links from level 2 to 3 do not cross.
## Done: ------
# - Deprecated title_lbl and replaced by main
# - Allowed setting (and removing) subtitle
## ToDo: ------
# etc.
## eof. ----------
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.