R/nested_chart.R
In NilsPetras/IPV: Item Pool Visualization
Defines functions
nested_chart
Documented in
nested_chart
#'Nested Chart
#'
#'Creates a nested chart, showing several tests and their facets.
#'
#'@param data Object of class IPV as created by the function 'ipv_est'
#'@param cd_method character; method to summarize center distances, either
#' "mean" or "aggregate", see details; defaults to "aggregate".
#'@param test_order character; vector of test names in desired order
#' (counter-clockwise); defaults to NULL, in which case the order is based on
#' the correlation matrix columns in 'data'.
#'@param facet_order character; vector of all facet names of all tests in
#' desired order (counter-clockwise); defaults to NULL, in which case the order
#' is based on the correlation matrix columns in 'data'.
#'@param xarrows logical; should arrows between tests be displayed?; defaults to
#' TRUE.
#'@param subradius integer; same unit as center distances; radius of the facet
#' circles; defaults to 0, in which case an appropriate value is estimated.
#'@param file_name character; name of the file to save. Supported formats are:
#' "pdf" (highest quality and smallest file size), "png", "jpeg"; defaults to
#' "none".
#'@param size integer; changes the size of most chart objects simultaneously.
#'@param relative_scaling integer; relative size of the global chart scale
#' compared to the nested facet chart scales; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param font character; text font, use extrafonts to access additional fonts;
#' defaults to "sans", which is "Helvetica".
#'@param rotate_radians integer; radian angle to rotate the chart
#' counter-clockwise by; use fractions of pi (e.g. pi/2 = 90 degrees).
#'@param rotate_degrees integer; angle in degrees to rotate the chart
#' counter-clockwise by.
#'@param subrotate_radians integer; radian angle or vector of radian angles to
#' rotate the nested facet charts counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param subrotate_degrees integer; angle or vector of angles in degrees to
#' rotate the nested facet charts counter-clockwise by.
#'@param zoom_x integer; vector with two values, the edges of the zoomed section
#' on the x-axis; defaults to NULL.
#'@param zoom_y integer; vector with two values, the edges of the zoomed section
#' on the y-axis; defaults to NULL.
#'@param file_width integer; file width in inches; defaults to 10.
#'@param file_height integer; file height in inches; defaults to 10.
#'@param dpi integer; resolution in dots per inch for "png" and "jpeg" files;
#' defaults to 500.
#'@param color_global global accent color; defaults to light blue ("#11C1FF").
#'@param color_nested nested accent color; defaults to blue ("#007AD6").
#'@param fade integer; brightness of the gray tones between 0 (black) and 100
#' (white) in steps of 1; defaults to 85.
#'@param cor_spacing integer; if \code{correlations = TRUE}: width of the ring,
#' the correlations between tests are drawn in; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param tick numeric; axis tick position; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param rotate_tick_label numeric; number of positions to move the tick label
#' (counter-clockwise); defaults to 0.
#'@param dist_construct_label integer; position of the construct label relative
#' to the surrounding circle; defaults to 10, in which case an appropriate
#' value is estimated; a value of .5 would position the label halfway between
#' the center and the surrounding circle.
#'@param rotate_construct_label_radians integer; radian angle to rotate the
#' construct label counter-clockwise by; use fractions of pi (e.g. pi/2 = 90
#' degrees).
#'@param rotate_construct_label_degrees integer; angle in degrees to rotate the
#' construct label counter-clockwise by.
#'@param dist_test_labels integer; position of the test labels relative to the
#' surrounding circle; defaults to 2/3, in which case the test labels are
#' displayed 2/3 of the way from the centers to the surrounding circles.
#'@param rotate_test_labels_radians integer; radian angle or vector of radian
#' angles to rotate the test labels counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param rotate_test_labels_degrees integer; angle or vector of angle in degrees
#' to rotate the test labels counter-clockwise by.
#'@param cor_labels_tests logical; if \code{TRUE}, shows the correlations
#' between tests as text.
#'@param cor_labels_facets logical; if \code{TRUE}, shows the correlations
#' between facets as text.
#'@param title character; overall chart title; defaults to NULL.
#'@param size_title integer; title font size relative to default.
#'@param size_construct_label integer; construct label font size relative to
#' default.
#'@param size_test_labels integer; test label font size relative to default.
#'@param size_facet_labels integer; facet label font size relative to default.
#'@param width_axes integer; global radial axis width relative to default.
#'@param width_axes_inner integer; nested radial axis width relative to default.
#'@param width_circles integer; global circle outline width relative to default.
#'@param width_circles_inner integer; nested circle outline width relative to
#' default.
#'@param width_tick integer; global axis tick line width relative to default.
#'@param width_tick_inner integer; nested axis tick line width relative to
#' default.
#'@param size_tick_label integer; axis tick label font size relative to default.
#'@param size_cor_labels integer; font size of the correlations between tests
#' relative to default.
#'@param size_cor_labels_inner integer; font size of the correlations between
#' facets relative to default.
#'@param width_xarrows integer; extra arrow line width relative to default.
#'@param size_xarrow_heads integer; extra arrow head length relative to default.
#'@param size_xarrow_labels integer; font size of the correlations indicated by
#' extra arrows relative to default.
#'@param size_marker integer; size (in inches) of the value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .1
#'@param size_marker_inner integer; size (in inches) of the nested value marker
#' at the circle border that indicates the center distance, a value of 0 omits
#' the marker; defaults to .05
#'
#'@details To summarize center distances (\code{cd_method}), the "mean" method
#' computes the average center distance (compute cds first, summarize across
#' items second), while the "aggregate" method computes a center distance based
#' on the sum of the squared loadings (summarize across items first, compute
#' cds second). "Aggregate" (default) is recommended, because it is more
#' meaningful in cases with heterogeneous factor loadings, while "mean" is the
#' originally proposed method.
#'
#' To get tidy results, it is often required to use \code{rotate_} and
#' \code{subrotate_} for better alignment.
#'
#' If you set \code{subrotate_} to a single value, all nested facet charts will
#' be rotated by the same amount. If you use a vector of values, the nested
#' facet charts will be rotated one by one by the values from that vector.
#'
#' Increase \code{relative_scaling} to avoid circle overlap. Decrease it to
#' make small chart objects more visible.
#'
#' \code{correlations} and \code{cor_spacing} add larger circles around the
#' nested facet charts, but do not change these facet charts.
#'
#' When changing the size of objects, consider the \code{size} parameter first
#' and make specific adjustments with the other \code{size_} and \code{width_}
#' parameters after.
#'
#' Pdf files will be vector based and can be scaled arbitrarily. For other
#' formats use \code{file_width}, \code{file_height}, and \code{dpi} to avoid
#' later rescaling and loss of quality.
#'
#' Instead of using screenshots to crop the chart, it is highly recommendable
#' to use \code{zoom_x} and \code{zoom_y}. This allows for vector-based
#' graphics quality when showing sections of the chart. With this cropping
#' method, use \code{file_width} to set the overall size of the file output,
#' \code{file_height} will automatically adjust to retain the correct aspect
#' ratio, if both \code{zoom_x} and \code{zoom_y} are provided.
#'
#' If \code{facet1} or \code{facet2} is \code{NA} for a given xarrow, the arrow
#' will end on the test's circle. Note: this correlation is usually not part of
#' the model.
#'
#' Consider adding title and caption in your typesetting software (LaTeX, MS
#' Word, ...), not here. The option to add a title is only a quick and dirty
#' shurtcut. It reduces chart size and is inflexible. Adding the title manually
#' will provide additional options, but requires you to save to a file
#' manually. To manually add a title or caption use
#' \code{\link[ggplot2]{labs}}.
#'
#'@return Object of the class "ggplot".
#'
#'@seealso \code{\link{item_chart}} \code{\link{facet_chart}}
#'
#' @examples
#' # as simple as that
#' nested_chart(self_confidence)
#'
#' # rotating the nested facet charts one by one
#' nested_chart(self_confidence,
#' subrotate_radians = c(0, pi/2, 0))
#'
#' # test without facets
#'
#' global <- system.file(
#' "extdata", "IPV_global.xlsx", package = "IPV", mustWork = TRUE)
#' tests <- c(
#' system.file("extdata", "IPV_DSSEI.xlsx", package = "IPV", mustWork = TRUE),
#' system.file("extdata", "IPV_SMTQ.xlsx", package = "IPV", mustWork = TRUE),
#' NA)
#' x <- input_excel(global = global, tests = tests)
#' nested_chart(x)
#'
#'@export
nested_chart <- function(
data,
cd_method = "aggregate",
test_order = NULL,
facet_order = NULL,
xarrows = TRUE,
subradius = 0,
file_name = "none",
size = 1,
relative_scaling = 0,
font = "sans",
rotate_radians = 0,
rotate_degrees = 0,
subrotate_radians = 0,
subrotate_degrees = 0,
file_width = 10,
file_height = 10,
zoom_x = NULL,
zoom_y = NULL,
dpi = 500,
color_global = "#11C1FF",
color_nested = "#007AD6",
fade = 85,
cor_spacing = 0,
tick = 0,
rotate_tick_label = 0,
dist_construct_label = 10,
rotate_construct_label_radians = 0,
rotate_construct_label_degrees = 0,
dist_test_labels = 2/ 3,
rotate_test_labels_radians = 0,
rotate_test_labels_degrees = 0,
cor_labels_tests = TRUE,
cor_labels_facets = TRUE,
title = NULL,
size_title = 1,
size_construct_label = 1,
size_test_labels = 1,
size_facet_labels = 1,
width_axes = 1,
width_axes_inner = 1,
width_circles = 1,
width_circles_inner = 1,
width_tick = 1,
width_tick_inner = 1,
size_tick_label = 1,
size_cor_labels = 1,
size_cor_labels_inner = 1,
width_xarrows = 1,
size_xarrow_heads = 1,
size_xarrow_labels = 1,
size_marker = .1,
size_marker_inner = .05){
if(length(names(data$est$tests)) == 1) {
stop("The model is simple, not nested. Try facet_chart or item_chart.")
}
coord <- coord_nested(
data = data,
cd_method = cd_method,
test_order = test_order,
facet_order = facet_order,
subradius = subradius,
tick = tick,
rotate_tick_label = rotate_tick_label,
rotate_radians = rotate_radians,
rotate_degrees = rotate_degrees,
subrotate_radians = subrotate_radians,
subrotate_degrees = subrotate_degrees,
dist_construct_label = dist_construct_label,
rotate_construct_label_radians = rotate_construct_label_radians,
rotate_construct_label_degrees = rotate_construct_label_degrees,
dist_test_labels = dist_test_labels,
rotate_test_labels_radians = rotate_test_labels_radians,
rotate_test_labels_degrees = rotate_test_labels_degrees,
prepare_item_charts = FALSE,
correlations = cor_labels_tests,
cor_spacing = cor_spacing,
relative_scaling = relative_scaling,
xarrows = xarrows)
myipv <- plot_nested(
coord = coord,
size = size,
file_name = file_name,
zoom_x = zoom_x,
zoom_y = zoom_y,
file_width = file_width,
file_height = file_height,
dpi = dpi,
cor_labels_tests = cor_labels_tests,
cor_labels_facets = cor_labels_facets,
color_global = color_global,
color_nested = color_nested,
fade = fade,
font = font,
size_construct_label = size_construct_label,
size_test_labels = size_test_labels,
size_facet_labels = size_facet_labels,
width_axes = width_axes,
width_axes_inner = width_axes_inner,
width_circles = width_circles,
width_circles_inner = width_circles_inner,
width_tick = width_tick,
width_tick_inner = width_tick_inner,
title = title,
size_title = size_title,
size_tick_label = size_tick_label,
size_cor_labels = size_cor_labels,
size_cor_labels_inner = size_cor_labels_inner,
width_xarrows = width_xarrows,
size_xarrow_heads = size_xarrow_heads,
size_xarrow_labels = size_xarrow_labels,
size_marker = size_marker,
size_marker_inner = size_marker_inner)
return(myipv)
}
#'Coord Nested
#'
#'Generates the coordinates for a nested chart and all other charts.
#'
#'@param data Object of class IPV as created by the function 'ipv_est'
#'@param cd_method character; method to summarize center distances, either
#' "mean" or "aggregate", see details; defaults to "aggregate".
#'@param test_order character; vector of test names in desired order
#' (counter-clockwise); defaults to NULL, in which case the order is based on
#' the correlation matrix columns in 'data'.
#'@param facet_order character; vector of all facet names of all tests in
#' desired order (counter-clockwise); defaults to NULL, in which case the order
#' is based on the correlation matrix columns in 'data'.
#'@param subradius integer; same unit as center distances; radius of the facet
#' circles; defaults to 0, in which case an appropriate value is estimated.
#'@param tick numeric; axis tick position; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param rotate_tick_label numeric; number of positions to move the tick label
#' (counter-clockwise); defaults to 0.
#'@param rotate_radians integer; radian angle to rotate the chart
#' counter-clockwise by; use fractions of pi (e.g. pi/2 = 90 degrees).
#'@param rotate_degrees integer; angle in degrees to rotate the chart
#' counter-clockwise by.
#'@param subrotate_radians integer; radian angle or vector of radian angles to
#' rotate the nested facet charts counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param subrotate_degrees integer; angle in degrees or vector of angles in
#' degrees to rotate the nested facet charts counter-clockwise by.
#'@param dist_construct_label integer; position of the construct label relative
#' to the surrounding circle; defaults to 10, in which case an appropriate
#' value is estimated; a value of .5 would position the label halfway between
#' the center and the surrounding circle.
#'@param rotate_construct_label_radians integer; radian angle to rotate the
#' construct label counter-clockwise by; use fractions of pi (e.g. pi/2 = 90
#' degrees).
#'@param rotate_construct_label_degrees integer; angle in degrees to rotate the
#' construct label counter-clockwise by.
#'@param dist_test_labels integer; position of the test labels relative to the
#' surrounding circle; defaults to 2/3, in which case the test labels are
#' displayed 2/3 of the way from the centers to the surrounding circles.
#'@param rotate_test_labels_radians integer; radian angle or vector of radian
#' angles to rotate the test labels counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param rotate_test_labels_degrees integer; angle or vector of angle in degrees
#' to rotate the test labels counter-clockwise by.
#'@param prepare_item_charts logical; if \code{TRUE}, generates the item chart
#' coordinates for all factors by calling \code{\link{coord_items}}.
#'@param correlations logical; if \code{TRUE}, generates the coordinates for the
#' latent correlations between tests. Sets up a ring to draw them in. If
#' \code{FALSE}, the ring and the correlations are omitted, simplifying the
#' chart significantly.
#'@param cor_spacing integer; if \code{correlations = TRUE}: width of the ring,
#' the latent correlations between tests are drawn in; defaults to 0, in which
#' case an appropriate value is estimated.
#'@param relative_scaling integer; relative size of the global chart scale
#' compared to the nested facet chart scales; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param xarrows logical; should arrows between tests be displayed?; defaults to TRUE.
#'
#'@details Use \code{\link{nested_chart}} to create nested charts.
#'
#'@return List containing coordinates of chart objects.
#'
#'@seealso \code{\link{plot_nested}} \code{\link{nested_chart}}
coord_nested <- function (
data,
cd_method = "aggregate",
test_order = NULL,
facet_order = NULL,
subradius = 0,
tick = 0,
rotate_tick_label = 0,
rotate_radians = 0,
rotate_degrees = 0,
subrotate_radians = 0,
subrotate_degrees = 0,
dist_construct_label = 10,
rotate_construct_label_radians = 0,
rotate_construct_label_degrees = 0,
dist_test_labels = 2 / 3,
rotate_test_labels_radians = 0,
rotate_test_labels_degrees = 0,
prepare_item_charts = FALSE,
correlations = TRUE,
cor_spacing = 0,
relative_scaling = 0,
xarrows = TRUE) {
# helper variables -----------------------------------------------------------
cplx <- length(colnames(data$est$g$cors))
# a vector of subrotation values can be given,
# to allign the nested facet charts
subrotate <- subrotate_radians + subrotate_degrees * pi / 180
if (length(subrotate) == 1) subrotate <- rep(subrotate, cplx)
if (length(dist_test_labels) == 1) {
dist_test_labels <- rep(dist_test_labels, cplx)
}
rotate_test_labels <- rotate_test_labels_radians +
rotate_test_labels_degrees * pi / 180
if (length(rotate_test_labels) == 1) {
rotate_test_labels <- rep(rotate_test_labels, cplx)
}
# default subradius needs to scale with the data to avoid messy results
def_subradius <- function (x) {
cplx <- length(colnames(x$cors))
if (cd_method == "aggregate") mcd <- x$cds$aggregate_cd
if (cd_method == "mean") mcd <- x$cds$mean_cd
subradius <- max(mean(mcd), .25 * max(mcd)) *
(5 / (3 + cplx)) *
(.25 + .25 * (min(max(mean(mcd), .25 * max(mcd)) / stats::sd(mcd), 3)))
}
if (subradius == 0) {
subradius <- min(unlist(lapply(
data$est$tests[!is.na(data$est$tests)],
def_subradius)))
message(paste("Facet circle radius set to ",
signif(subradius, digits = 3),
" based on the data.",
sep = ""))
}
# nested facet charts --------------------------------------------------------
factorcoords <- list()
for (i in seq_along(data$est$tests)) {
factorcoords[[i]] <- suppressMessages(coord_facets(
data$est$tests[[i]],
cd_method = cd_method,
facet_order = facet_order,
subradius = subradius,
rotate_radians = subrotate[i],
rotate_test_label_radians = rotate_test_labels[i],
dist_test_label = dist_test_labels[i]))
if (is.na(factorcoords[[i]][["p_axes"]][1,"rho0"])) {
x <- names(data$est$tests)[i]
row.names(factorcoords[[i]][["p_circs"]]) <- x
row.names(factorcoords[[i]][["c_circs"]]) <- x
factorcoords[[i]][["test_label"]]["label"] <- x
}
}
names(factorcoords) <- names(data$est$tests)
# # this could be used for bulk processing of item charts in a future build
# if (prepare_item_charts == TRUE) {
# itemcoords <- list()
# for (i in 1:length(data$est$tests)) {
# itemcoords[[i]] <- coord_items(data$est$tests[[i]],
# rotate_radians = subrotate[i])
# }
# names(itemcoords) <- names(data$est$tests)
# }
# helper variables -----------------------------------------------------------
if (is.null(test_order)) {
test_order <- colnames(data$est$g$cors)
}
nam <- test_order
rotate <- rotate_radians + rotate_degrees * pi / 180
rotate_construct_label <- rotate_construct_label_radians +
rotate_construct_label_degrees * pi / 180
# test circle size needed to allign objects
getcircsize <- function (x) {
polcircs <- get(x = "p_circs", envir = as.environment(x))
polcircs <- polcircs[1, "radius"]
}
circsize <- unlist(lapply(factorcoords, getcircsize))
if (cor_spacing == 0 & correlations == TRUE) {
cor_spacing <- .15 * max(circsize)
message(paste("cor_spacing set to ",
signif(cor_spacing, digits = 3),
" based on the data.",
sep = ""))
}
circsize <- circsize + correlations * cor_spacing
if (cd_method == "aggregate") {
g_cds <- data.frame(lapply(split(data$est$g$cds, data$est$g$cds$subfactor),
function (x) y <- x$aggregate_cd[1]))
}
if (cd_method == "mean") {
g_cds <- data.frame(lapply(split(data$est$g$cds, data$est$g$cds$subfactor),
function (x) y <- x$mean_cd[1]))
}
g_cds <- t(g_cds)
g_cds <- data.frame(g_cds)
# default relative scaling needs to scale with the data to avoid messy results
rs <- relative_scaling
if (rs == 0) {
rs <- mean(circsize) / mean(g_cds$g_cds) * 3 * (cplx + 3) / (20 - cplx / 2)
message(paste("Relative scaling set to ",
signif(rs, digits = 3),
" based on the data.",
sep = ""))
}
# default axis tick also scales with the data, selected from a set of possible
# ticks to avoid odd values
if (cd_method == "aggregate") tot_cd <- data$est$g$cds$aggregate_cd
if (cd_method == "mean") tot_cd <- data$est$g$cds$mean_cd
if (tick == 0){
tick <- signif(
max(.15 * max(tot_cd),
.3 * min(tot_cd)) *
rs ^ .25,
1)
if (rs < 3 * (cplx + 3) / 200){
tick <- signif(tick * rs, 1)
}
if (rs > 1.5 * (cplx + 3)) {
tick <- signif(10 * tick / rs, 1)
}
sc <- rep(c(1, 2, 5), 5) * 10 ^ rep(-3:1, each = 3)
tick <- sc[which.min(abs(tick - sc))]
message(paste("Axis tick set to ", tick," based on the data.", sep = ""))
}
# default distance of the construct label from the center needs to scale with
# the number of tests, to account for the reduction in space
if (dist_construct_label == 10) {
dist_construct_label <- (1 - 2 / (1 + cplx))
message(paste("dist_construct_label set to ",
signif(dist_construct_label, digits = 3),
" based on the data.",
sep = ""))
}
# global chart objects -------------------------------------------------------
## circles ------------------------
# polar for calculation, carthesian for application
p_circs <- data.frame(phi = rep(NA, cplx + 1),
rho = 0,
radius = NA)
row.names(p_circs) <- c(levels(data$est$g$cds$factor), nam)
p_circs[names(circsize), "radius"] <- circsize
p_circs$radius[1] <- max(g_cds[nam, ] * rs + circsize[nam] * 2)
p_circs[nam, "rho"] <- c(g_cds[nam, ] * rs + circsize[nam])
p_circs$phi <- c(0, 2 * pi / cplx * c(1:cplx)) + rotate
p_circs$phi[p_circs$phi > 2 * pi] <-
p_circs$phi[p_circs$phi > 2 * pi] - 2 * pi
# reminder:
# x=cos(phi)*rho
# y=sin(phi)*rho
c_circs <- p_circs
# rounded values to decrease display length in console
c_circs[ ,1] <- round(cos(p_circs$phi) * p_circs$rho, digits = 7)
c_circs[ ,2] <- round(sin(p_circs$phi) * p_circs$rho, digits = 7)
names(c_circs) <- c("x", "y", "radius")
row.names(c_circs)[1] <- ""
# add rings for correlation values, so they have enough space to be displayed
if(correlations == TRUE) {
p_ring <- data.frame(
phi = rep(NA, cplx + 1),
rho = NA,
radius = NA)
row.names(p_ring) <- c(levels(data$est$g$cds$factor), nam)
p_ring[names(circsize), "radius"] <- circsize - correlations * cor_spacing
p_ring[nam, "rho"] <- c(g_cds[nam, ] * rs + circsize[nam])
p_ring$phi <- c(0, 2 * pi / cplx * c(1:cplx)) + rotate
p_ring$rho[-1] <- p_ring$rho[-1]
p_ring <- p_ring[-1, ]
c_ring <- p_ring
c_ring[,1] <- round(cos(p_ring$phi) * p_ring$rho, digits = 7)
c_ring[,2] <- round(sin(p_ring$phi) * p_ring$rho, digits = 7)
names(c_ring) <- c("x", "y", "radius")
} else {
c_ring <- NULL
p_ring <- NULL
}
## axes ---------------------------
p_axes <- data.frame(
rho0 = rep(0, cplx),
rho1 = NA,
rho2 = NA,
rho3 = NA,
phi = NA)
row.names(p_axes) <- nam
p_axes$phi <- utils::tail(p_circs$phi, cplx)
p_axes$rho1 <- utils::tail(p_circs$rho, cplx) -
utils::tail(p_circs$radius, cplx)
p_axes$rho2 <- p_axes$rho1 + 2 * utils::tail(p_circs$radius, cplx)
p_axes$rho3 <- rep(p_circs$radius[1])
c_axes <- data.frame(
x0 = rep(NA, cplx), y0 = NA,
x1 = NA, y1 = NA,
x2 = NA, y2 = NA,
x3 = NA, y3 = NA)
row.names(c_axes) <- nam
c_axes$x0 <- round(cos(p_axes$phi) * p_axes$rho0, digits = 7)
c_axes$x1 <- round(cos(p_axes$phi) * p_axes$rho1, digits = 7)
c_axes$x2 <- round(cos(p_axes$phi) * p_axes$rho2, digits = 7)
c_axes$x3 <- round(cos(p_axes$phi) * p_axes$rho3, digits = 7)
c_axes$y0 <- round(sin(p_axes$phi) * p_axes$rho0, digits = 7)
c_axes$y1 <- round(sin(p_axes$phi) * p_axes$rho1, digits = 7)
c_axes$y2 <- round(sin(p_axes$phi) * p_axes$rho2, digits = 7)
c_axes$y3 <- round(sin(p_axes$phi) * p_axes$rho3, digits = 7)
axis_tick <- data.frame(tick = tick, rho = tick, phi = NA, x = NA, y = NA)
axis_tick$phi <- min(p_circs$phi) + (pi + 2 * pi * rotate_tick_label) / cplx
axis_tick$x <- round(cos(axis_tick$phi) *
max(axis_tick$rho, .1 * max(g_cds)),
digits = 7)
axis_tick$y <- round(sin(axis_tick$phi) *
max(axis_tick$rho, .1 * max(g_cds)),
digits = 7)
## construct label ----------------
# coordinates of construct name
# guesses where space is (next to lowest center distance)
construct_label <- data.frame(
x = NA,
y = NA,
label = row.names(p_circs)[1],
phi=NA,
rho=NA)
construct_label$phi <- p_circs[which.min(p_circs$radius), "phi"] +
pi / cplx + rotate_construct_label
construct_label$rho <- dist_construct_label * max(p_circs$radius)
construct_label$x <- round(
cos(construct_label$phi) * construct_label$rho, digits = 7)
construct_label$y <- round(
sin(construct_label$phi) * construct_label$rho, digits = 7)
## correlations -------------------
n <- cplx * (cplx - 1)
cors <- data.frame(x = rep(NA, n),
y = NA,
V1 = NA,
V2 = NA,
label = NA,
xnew = NA,
ynew = NA)
a <- nam
a <- c(a, a[1])
b <- NULL
for (k in 1:cplx) {
b <- c(b, a[-c(1, cplx + 1)])
a <- a[-1]
a <- c(a, a[1])
}
cors$V1 <- b
cors$V2 <- unlist(lapply(nam, rep, times = cplx - 1))
for (k in 1:n) {
cors$label[k] <- data$est$g$cors[cors$V1[k], cors$V2[k]]
}
cors$label <- as.character(cors$label)
# exclude leading 0's for aesthetic reasons
cors$label[cors$label < 0] <-
paste("-", substr(cors$label[cors$label < 0], 3, 5), sep = "")
cors$label[cors$label != 1 & cors$label > 0] <-
substr(cors$label[cors$label != 1 & cors$label > 0], 2, 4)
cors$x <- c_circs[cors$V2, "x"]
cors$y <- c_circs[cors$V2, "y"]
# scatter labels for readability, position indicates partner variable
scatter <- rep(seq(from = (-pi + 2 * pi / cplx) / 2,
to = (pi - 2 * pi / cplx) / 2,
by = (pi - 2 * pi / cplx) / (cplx - 2)),
cplx)
rho <- p_circs[cors$V2, "radius"]
phi <- p_circs[cors$V2, "phi"]
cors$xnew <- cors$x +
round(cos(phi + pi + scatter), digits = 7) *
(rho - correlations * .5 * cor_spacing)
cors$ynew <- cors$y +
round(sin(phi + pi + scatter), digits = 7) *
(rho - correlations * .5 * cor_spacing)
cors$x <- cors$xnew
cors$y <- cors$ynew
cors[6:7] <- list(NULL)
# nested chart objects -------------------------------------------------------
## shifted facet charts -----------
subcircles <- list()
shift_factor <- function (data, x, y) {
# stripping off superfluous information
d <- data[c("c_circs",
"c_axes",
"test_label",
"cors")]
d$axis_tick[1:2] <- list(NULL) # polar coordinates not needed anymore
d$c_circs$x <- d$c_circs$x + x
d$c_axes$x0 <- d$c_axes$x0 + x
d$c_axes$x1 <- d$c_axes$x1 + x
d$c_axes$x2 <- d$c_axes$x2 + x
d$c_axes$x3 <- d$c_axes$x3 + x
d$axis_tick$x <- d$axis_tick$x + x
d$test_label$x <- d$test_label$x + x
d$cors$x <- d$cors$x + x
d$c_circs$y <- d$c_circs$y + y
d$c_axes$y0 <- d$c_axes$y0 + y
d$c_axes$y1 <- d$c_axes$y1 + y
d$c_axes$y2 <- d$c_axes$y2 + y
d$c_axes$y3 <- d$c_axes$y3 + y
d$test_label$y <- d$test_label$y + y
d$cors$y <- d$cors$y + y
return(d)
}
for(i in 1:cplx) {
subcircles[[nam[i]]] <- shift_factor(factorcoords[[nam[i]]],
c_circs[nam[i], "x"],
c_circs[nam[i], "y"])
}
# bunched processing for these ones:
nested <- list(circles = NULL,
axes = NULL,
test_label = NULL,
cors = NULL)
## chart objects ------------------
# circles
for (i in 1:cplx) nested$circles[[nam[i]]] <- subcircles[[c(i, 1)]]
nested$circles <- lapply(nested$circles, utils::tail, n = -1)
nested$circles <- do.call("rbind", nested$circles)
# cutting superfluous test names from labels
nested$circles$label <- substr(
row.names(nested$circles),
unlist(gregexpr(pattern = "\\.", row.names(nested$circles))) + 1,
nchar(row.names(nested$circles)))
# axes
for (i in 1:cplx) nested$axes[[nam[i]]] <- subcircles[[c(i, 2)]]
nested$axes <- do.call("rbind", nested$axes)
# test labels
for (i in 1:cplx) nested$test_label[[nam[i]]] <- subcircles[[c(i, 3)]]
nested$test_label <- do.call("rbind", nested$test_label)
# correlations
for (i in 1:cplx) nested$cors[[nam[i]]] <- subcircles[[c(i,4)]]
nested$cors <- do.call("rbind", nested$cors)
# extra arrows ---------------------------------------------------------------
## arrows -------------------------
if (xarrows & !all(is.na(data$xarrow))) {
n <- dim(data$xarrow)[1]
arrows <- data.frame(x1 = rep(NA, n),
x2 = NA,
y1 = NA,
y2 = NA,
label = NA,
xlabel = NA,
ylabel = NA)
arrows$label <- data$xarrow$value
# facet circles are named as 'test.facet' within nested$circles
# arrow ends on facets
arrows$x1 <- nested$circles[paste(data$xarrow$test1,
data$xarrow$facet1,
sep = "."),
"x"]
arrows$y1 <- nested$circles[paste(data$xarrow$test1,
data$xarrow$facet1,
sep = "."),
"y"]
arrows$x2 <- nested$circles[paste(data$xarrow$test2,
data$xarrow$facet2,
sep = "."),
"x"]
arrows$y2 <- nested$circles[paste(data$xarrow$test2,
data$xarrow$facet2,
sep = "."),
"y"]
# arrow ends on tests
arrows[is.na(data$xarrow$facet1), c("x1", "y1")] <-
c_circs[
data$xarrow[is.na(data$xarrow$facet1),"test1"],
c("x", "y")]
arrows[is.na(data$xarrow$facet2), c("x2", "y2")] <-
c_circs[
data$xarrow[is.na(data$xarrow$facet2),"test2"],
c("x", "y")]
## labels -----------------------
# labels are placed on the intersection between the arrow
# and an imaginary line halfway between the test circles
# to avoid overlap with any other chart objects
# x- and y-distances between the centers of the big and
# the small circles involved
xdist_big <- NULL
ydist_big <- NULL
for (i in 1:n) {
xdist_big[i] <- c_circs[data$xarrow$test2[i], "x"] -
c_circs[data$xarrow$test1[i], "x"]
ydist_big[i] <- c_circs[data$xarrow$test2[i], "y"] -
c_circs[data$xarrow$test1[i], "y"]
}
xdist_small <- arrows$x2 - arrows$x1
ydist_small <- arrows$y2 - arrows$y1
# total distances between the centers of the big and
# the small circles involved
dist_big <- sqrt(xdist_big ^ 2 + ydist_big ^ 2)
dist_small <- sqrt(xdist_small ^ 2 + ydist_small ^ 2)
# points halfway between the big circles
halfwaypoint <- data.frame(x = rep(NA, n), y = NA)
for (i in 1:n) {
halfwaypoint$x[i] <- (c_circs[data$xarrow$test1[i], "x"] +
c_circs[data$xarrow$test2[i], "x"]) / 2 +
xdist_big[i] / dist_big[i] /
2 * (c_circs[data$xarrow$test1[i], "radius"] -
c_circs[data$xarrow$test2[i], "radius"])
halfwaypoint$y[i] <- (c_circs[data$xarrow$test1[i], "y"] +
c_circs[data$xarrow$test2[i], "y"]) / 2 +
ydist_big[i] / dist_big[i] /
2 * (c_circs[data$xarrow$test1[i], "radius"] -
c_circs[data$xarrow$test2[i], "radius"])
}
# placing the labels alongside the arrow on their final positions
d <- NULL
for(i in 1:n){
d[i] <- dist_small[i] *
(((arrows$x1[i] - halfwaypoint$x[i]) * -xdist_big[i]) -
((arrows$y1[i] - halfwaypoint$y[i]) * ydist_big[i])) /
(ydist_small[i] * ydist_big[i] - xdist_small[i] * -xdist_big[i])
}
arrows$xlabel <- arrows$x1 + d / dist_small * xdist_small
arrows$ylabel <- arrows$y1 + d / dist_small * ydist_small
# letting the correlation labels dodge their arrow by .1 sideways
# to avoid overlap
arrows$xlabel <- arrows$xlabel + .1 / dist_small * ydist_small
arrows$ylabel <- arrows$ylabel + .1 / dist_small * -xdist_small
## arrows again -----------------
arrows$radius1 <- subradius
arrows$radius2 <- subradius
# overwrite in case of arrows ending in test (instead of facet)
arrows[is.na(data$xarrow$facet1), "radius1"] <-
c_circs[data$xarrow[is.na(data$xarrow$facet1), "test1"],
"radius"]
arrows[is.na(data$xarrow$facet2), "radius2"] <-
c_circs[data$xarrow[is.na(data$xarrow$facet2), "test2"],
"radius"]
arrows$x1new <- arrows$x1 + arrows$radius1 / dist_small * xdist_small
arrows$x2new <- arrows$x2 + arrows$radius2 / dist_small * -xdist_small
arrows$y1new <- arrows$y1 + arrows$radius1 / dist_small * ydist_small
arrows$y2new <- arrows$y2 + arrows$radius2 / dist_small * -ydist_small
arrows$x1 <- arrows$x1new
arrows$x2 <- arrows$x2new
arrows$y1 <- arrows$y1new
arrows$y2 <- arrows$y2new
arrows[8:13] <- list(NULL)
rm(n)
} else arrows <- NULL
rm(nam,cplx)
# return ---------------------------------------------------------------------
global <- list(p_circs = p_circs,
c_circs = c_circs,
p_ring = p_ring,
c_ring = c_ring,
p_axes = p_axes,
c_axes = c_axes,
axis_tick = axis_tick,
construct_label = construct_label,
cors = cors,
nested = nested,
rs = rs,
cor_spacing = cor_spacing,
arrows = arrows)
coord <- list(factor = factorcoords,
global = global,
rs = rs)
# if (prepare_item_charts == TRUE) coord$items <- itemcoords
return(coord)
}
#'Plot Nested
#'
#'Generates a nested chart from coordinates.
#'
#'@param coord list generated by \code{\link{coord_nested}}.
#'@param size integer; changes the size of most chart objects simultaneously.
#'@param file_name character; name of the file to save. Supported formats are:
#' "pdf" (highest quality and smallest file size), "png", "jpeg"; defaults to
#' "none".
#'@param zoom_x integer; vector with two values, the edges of the zoomed section
#' on the x-axis; defaults to NULL.
#'@param zoom_y integer; vector with two values, the edges of the zoomed section
#' on the y-axis; defaults to NULL.
#'@param file_width integer; file width in inches; defaults to 10.
#'@param file_height integer; file height in inches; defaults to 10.
#'@param dpi integer; resolution in dots per inch for "png" and "jpeg" files;
#' defaults to 500.
#'@param cor_labels_tests logical; if \code{TRUE}, shows the correlations
#' between tests as text.
#'@param cor_labels_facets logical; if \code{TRUE}, shows the correlations
#' between facets as text.
#'@param color_global global accent color; defaults to "black".
#'@param color_nested nested accent color; defaults to "black".
#'@param fade integer; brightness of the gray tones between 0 (black) and 100
#' (white) in steps of 1; defaults to 85.
#'@param font character; text font, use extrafonts to access additional fonts;
#' defaults to "sans", which is "Helvetica".
#'@param size_construct_label integer; construct label font size relative to
#' default.
#'@param size_test_labels integer; test label font size relative to default.
#'@param size_facet_labels integer; facet label font size relative to default.
#'@param width_axes integer; global radial axis width relative to default.
#'@param width_axes_inner integer; nested radial axis width relative to default.
#'@param width_circles integer; global circle outline width relative to default.
#'@param width_circles_inner integer; nested circle outline width relative to
#' default.
#'@param width_tick integer; global axis tick line width relative to default.
#'@param width_tick_inner integer; nested axis tick line width relative to
#' default.
#'@param title character; overall chart title; defaults to NULL.
#'@param size_title integer; title font size relative to default.
#'@param size_tick_label integer; axis tick label font size relative to default.
#'@param size_cor_labels integer; font size of the correlations between tests
#' relative to default.
#'@param size_cor_labels_inner integer; font size of the correlations between
#' facets relative to default.
#'@param width_xarrows integer; extra arrow line width relative to default.
#'@param size_xarrow_heads integer; extra arrow head length relative to default.
#'@param size_xarrow_labels integer; font size of the correlations indicated by
#' extra arrows relative to default.
#'@param size_marker integer; size (in inches) of the value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .1
#'@param size_marker_inner integer; size (in inches) of the nested value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .05
#'
#'@details Use \code{\link{nested_chart}} to create nested charts
#'
#'@return Object of the class "ggplot" and, by default, the same object saved as
#' a file.
#'
#'@seealso \code{\link{coord_nested}} \code{\link{nested_chart}}
plot_nested <- function (
coord,
size = 1,
file_name = "none",
file_width = 10,
file_height = 10,
zoom_x = NULL,
zoom_y = NULL,
dpi = 500,
cor_labels_tests = TRUE,
cor_labels_facets = TRUE,
color_global = "black",
color_nested = "black",
fade = 85,
font = "sans",
size_construct_label = 1,
size_test_labels = 1,
size_facet_labels = 1,
width_axes = 1,
width_axes_inner = 1,
width_circles = 1,
width_circles_inner = 1,
width_tick = 1,
width_tick_inner = 1,
title = NULL,
size_title = 1,
size_tick_label = 1,
size_cor_labels = 1,
size_cor_labels_inner = 1,
width_xarrows = 1,
size_xarrow_heads = 1,
size_xarrow_labels = 1,
size_marker = .1,
size_marker_inner = .05) {
# preparation ----------------------------------------------------------------
if (cor_labels_tests == TRUE) {
cors <- coord$g$cors
} else cors <- NULL
if (cor_labels_facets == TRUE) {
cors_inner <- coord$g$nested$cors
} else cors_inner <- NULL
# delete empty elements
facetless <- c(
"pLaCeHoLdEr",
row.names(coord$g$nested$axes)[is.na(coord$g$nested$axes$x0)])
has_facets <- setdiff(names(coord$factor), facetless)
coord$global$nested$cors <-
coord$g$n$cors[which(!row.names(coord$g$n$cors) %in% facetless), ]
coord$global$nested$axes <-
coord$g$n$axes[which(!row.names(coord$g$n$axes) %in% facetless), ]
cors_inner <- cors_inner[which(!row.names(cors_inner) %in% facetless), ]
# some calculations are not possible within aes_string(), so aesthetics are
# prepared here
tick <- coord$g$axis_tick$tick
tick_label_x <- coord$g$rs * coord$g$axis_tick$x +
0.03 * size * size_tick_label *
cos(coord$g$axis_tick$phi) * coord$g$p_circs[1, "radius"]
tick_label_y <- coord$g$rs * coord$g$axis_tick$y +
0.03 * size * size_tick_label *
sin(coord$g$axis_tick$phi) * coord$g$p_circs[1, "radius"]
tick_label_label <- as.character(formatC(tick, format = "fg"))
# aspect ratio correction (to manage zoomed cases)
if(!is.null(zoom_x) & !is.null(zoom_y)) {
asp <- diff(zoom_y) / diff(zoom_x)
file_height <- asp * file_width
}
# scale zoom_x and zoom_y properly (messed up by relative_scaling)
if (!is.null(zoom_x)) zoom_x <- zoom_x * coord$rs
if (!is.null(zoom_y)) zoom_y <- zoom_y * coord$rs
# chart ----------------------------------------------------------------------
myipv <- ggplot2::ggplot(coord$g$c_circs) +
## initializing -----------------
ggplot2::coord_fixed() +
ggplot2::theme(
axis.line = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.title.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
legend.position = "none",
panel.background = ggplot2::element_blank(),
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
plot.background = ggplot2::element_blank(),
text = ggplot2::element_text(size = 16, family = font),
plot.margin = ggplot2::margin(0, 0, 0, 0, "in"),
plot.title = ggplot2::element_text(
hjust = .5,
vjust = -3,
size = 16 * size * size_title)) +
ggplot2::aes() +
## layers -----------------------
# ordered from bottom to top for correct overlap
# tick label
ggplot2::geom_text(
data = coord$g$axis_tick,
ggplot2::aes(x = tick_label_x,
y = tick_label_y,
label = tick_label_label),
angle = (coord$g$axis_tick$phi - pi / 48 - pi / 2) * 180 / pi,
family = font,
size = 3 * size * size_tick_label) +
# global tick
ggforce::geom_circle(
ggplot2::aes(x0 = 0, y0 = 0, r = coord$g$rs * tick),
linetype = "dotted",
size = .5 * min(size, 1) * width_tick) +
# test circle background
ggforce::geom_circle(
data = coord$g$c_circs[-1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .5 * size * width_circles,
color = color_global,
fill = "white") +
# global outer axis segments
ggplot2::geom_segment(
data = coord$g$c_axes,
ggplot2::aes_string(x = "x2", y = "y2", xend = "x3", yend = "y3"),
size = .5 * size * width_axes,
color = paste("gray", fade, sep = "")) +
# global circle
ggforce::geom_circle(
data = coord$g$c_circs[1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .5 * size * width_axes,
color = paste("gray", fade, sep = "")) +
# global center dot
ggplot2::geom_point(
ggplot2::aes(x = 0, y = 0),
size = 2 * size * width_axes) +
# nested outer axis segments
ggplot2::geom_segment(
data = coord$g$nested$axes,
ggplot2::aes_string(x = "x2", y = "y2", xend = "x3", yend = "y3"),
size = .25 * size * width_axes_inner,
color = paste("gray", fade, sep = "")) +
# nested center dots
ggplot2::geom_point(
data = coord$g$c_circs[has_facets, ],
ggplot2::aes_string(x = "x", y = "y"),
size = 1 * size * width_axes_inner) +
# test circles
ggforce::geom_circle(
data = coord$g$c_circs[-1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .6 * size * width_circles,
color = color_global) +
# nested tick
ggforce::geom_circle(
data = coord$g$c_circs[has_facets, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "tick"),
size = .5 * min(size, .5) * width_tick_inner,
linetype = "dotted") +
# facet circle background
ggforce::geom_circle(
data = coord$g$nested$circles,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .3 * size * width_circles_inner,
color = color_nested,
fill = "white") +
# global inner axis segments
ggplot2::geom_segment(
data = coord$g$c_axes,
ggplot2::aes_string(x = "x0", y = "y0", xend = "x1", yend = "y1"),
size = 1.5 * size * width_axes,
arrow = ggplot2::arrow(
angle = 90,
ends = "last",
length = ggplot2::unit(size_marker, "inches")),
color = "black") +
# facet circles
ggforce::geom_circle(
data = coord$g$nested$circles,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .3 * size * width_circles_inner,
color = color_nested) +
# facet labels
ggplot2::geom_text(
data = coord$g$nested$circles,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 2 * size * size_facet_labels) +
# nested inner axis segments
ggplot2::geom_segment(
data = coord$g$nested$axes,
ggplot2::aes_string(x = "x0", y = "y0", xend = "x1", yend = "y1"),
size = .75 * size * width_axes_inner,
arrow = ggplot2::arrow(
angle = 90,
ends = "last",
length = ggplot2::unit(size_marker_inner, "inches")),
color = "black") +
# construct label
ggplot2::geom_text(
data = coord$g$construct_label,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 5 * size * size_construct_label,
fontface = "bold",
color = "black") +
# test labels
ggplot2::geom_text(
data = coord$g$nested$test_label,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 3.5 * size * size_test_labels,
fontface = "bold",
color = "black")
## optional layers ----------------
# facet correlations
if (!is.null(cors_inner)) {
myipv <- myipv +
ggplot2::geom_text(
data = cors_inner,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 1.5 * size * size_cor_labels_inner)
}
# test correlations
if (!is.null(cors)) {
# rings
# c() enables putting layer on the bottom, by listing the layer first
myipv$layers <- append(
myipv$layers,
ggforce::geom_circle(
data = coord$g$c_ring,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .25 * size * width_axes_inner,
color = paste("gray", fade, sep = "")),
after = 3
)
# labels
myipv <- myipv +
ggplot2::geom_text(
data = cors,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 3 * size * size_cor_labels,
fontface = "bold")
}
# extra arrows
if (!is.null(coord$global$arrows)) {
myipv <- myipv +
# arrows
ggplot2::geom_segment(
data = coord$g$arrows,
ggplot2::aes_string(x = "x1", y = "y1", xend = "x2", yend = "y2"),
arrow = ggplot2::arrow(
ends = "both",
length = ggplot2::unit(.003 * size * size_xarrow_heads,
"native"),
type = "closed"),
size = .25 * size * width_xarrows,
linetype = "dotted",
color = "gray20") +
# labels
ggplot2::geom_text(
data = coord$g$arrows,
ggplot2::aes_string(x = "xlabel", y = "ylabel", label = "label"),
size = 2.25 * size * size_xarrow_labels,
family = font,
color = "gray20")
}
# title
if (!is.null(title)) {
myipv <- myipv +
ggplot2::ggtitle(label = title)
}
# section
if (!is.null(c(zoom_x, zoom_y))) {
myipv <- myipv +
ggplot2::coord_cartesian(
xlim = zoom_x,
ylim = zoom_y,
expand = FALSE)
if(!is.null(zoom_x) & !is.null(zoom_y) & file_name != "none") {
message(paste(
"file_height was set to ",
signif(asp, 4),
" times the file_width, to retain the aspect ratio.",
sep = ""))
}
}
# optional file save ---------------------------------------------------------
## .pdf ---------------------------
if (substring(file_name, nchar(file_name)-3+1) == "pdf") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
## .png ---------------------------
if (substring(file_name, nchar(file_name)-3+1) == "png") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
## .jpeg --------------------------
if (substring(file_name, nchar(file_name)-3+1) == "peg") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
# return ---------------------------------------------------------------------
return(myipv)
}
NilsPetras/IPV documentation built on July 19, 2023, 9:12 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions nested_chart
Documented in nested_chart
#'Nested Chart
#'
#'Creates a nested chart, showing several tests and their facets.
#'
#'@param data Object of class IPV as created by the function 'ipv_est'
#'@param cd_method character; method to summarize center distances, either
#' "mean" or "aggregate", see details; defaults to "aggregate".
#'@param test_order character; vector of test names in desired order
#' (counter-clockwise); defaults to NULL, in which case the order is based on
#' the correlation matrix columns in 'data'.
#'@param facet_order character; vector of all facet names of all tests in
#' desired order (counter-clockwise); defaults to NULL, in which case the order
#' is based on the correlation matrix columns in 'data'.
#'@param xarrows logical; should arrows between tests be displayed?; defaults to
#' TRUE.
#'@param subradius integer; same unit as center distances; radius of the facet
#' circles; defaults to 0, in which case an appropriate value is estimated.
#'@param file_name character; name of the file to save. Supported formats are:
#' "pdf" (highest quality and smallest file size), "png", "jpeg"; defaults to
#' "none".
#'@param size integer; changes the size of most chart objects simultaneously.
#'@param relative_scaling integer; relative size of the global chart scale
#' compared to the nested facet chart scales; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param font character; text font, use extrafonts to access additional fonts;
#' defaults to "sans", which is "Helvetica".
#'@param rotate_radians integer; radian angle to rotate the chart
#' counter-clockwise by; use fractions of pi (e.g. pi/2 = 90 degrees).
#'@param rotate_degrees integer; angle in degrees to rotate the chart
#' counter-clockwise by.
#'@param subrotate_radians integer; radian angle or vector of radian angles to
#' rotate the nested facet charts counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param subrotate_degrees integer; angle or vector of angles in degrees to
#' rotate the nested facet charts counter-clockwise by.
#'@param zoom_x integer; vector with two values, the edges of the zoomed section
#' on the x-axis; defaults to NULL.
#'@param zoom_y integer; vector with two values, the edges of the zoomed section
#' on the y-axis; defaults to NULL.
#'@param file_width integer; file width in inches; defaults to 10.
#'@param file_height integer; file height in inches; defaults to 10.
#'@param dpi integer; resolution in dots per inch for "png" and "jpeg" files;
#' defaults to 500.
#'@param color_global global accent color; defaults to light blue ("#11C1FF").
#'@param color_nested nested accent color; defaults to blue ("#007AD6").
#'@param fade integer; brightness of the gray tones between 0 (black) and 100
#' (white) in steps of 1; defaults to 85.
#'@param cor_spacing integer; if \code{correlations = TRUE}: width of the ring,
#' the correlations between tests are drawn in; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param tick numeric; axis tick position; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param rotate_tick_label numeric; number of positions to move the tick label
#' (counter-clockwise); defaults to 0.
#'@param dist_construct_label integer; position of the construct label relative
#' to the surrounding circle; defaults to 10, in which case an appropriate
#' value is estimated; a value of .5 would position the label halfway between
#' the center and the surrounding circle.
#'@param rotate_construct_label_radians integer; radian angle to rotate the
#' construct label counter-clockwise by; use fractions of pi (e.g. pi/2 = 90
#' degrees).
#'@param rotate_construct_label_degrees integer; angle in degrees to rotate the
#' construct label counter-clockwise by.
#'@param dist_test_labels integer; position of the test labels relative to the
#' surrounding circle; defaults to 2/3, in which case the test labels are
#' displayed 2/3 of the way from the centers to the surrounding circles.
#'@param rotate_test_labels_radians integer; radian angle or vector of radian
#' angles to rotate the test labels counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param rotate_test_labels_degrees integer; angle or vector of angle in degrees
#' to rotate the test labels counter-clockwise by.
#'@param cor_labels_tests logical; if \code{TRUE}, shows the correlations
#' between tests as text.
#'@param cor_labels_facets logical; if \code{TRUE}, shows the correlations
#' between facets as text.
#'@param title character; overall chart title; defaults to NULL.
#'@param size_title integer; title font size relative to default.
#'@param size_construct_label integer; construct label font size relative to
#' default.
#'@param size_test_labels integer; test label font size relative to default.
#'@param size_facet_labels integer; facet label font size relative to default.
#'@param width_axes integer; global radial axis width relative to default.
#'@param width_axes_inner integer; nested radial axis width relative to default.
#'@param width_circles integer; global circle outline width relative to default.
#'@param width_circles_inner integer; nested circle outline width relative to
#' default.
#'@param width_tick integer; global axis tick line width relative to default.
#'@param width_tick_inner integer; nested axis tick line width relative to
#' default.
#'@param size_tick_label integer; axis tick label font size relative to default.
#'@param size_cor_labels integer; font size of the correlations between tests
#' relative to default.
#'@param size_cor_labels_inner integer; font size of the correlations between
#' facets relative to default.
#'@param width_xarrows integer; extra arrow line width relative to default.
#'@param size_xarrow_heads integer; extra arrow head length relative to default.
#'@param size_xarrow_labels integer; font size of the correlations indicated by
#' extra arrows relative to default.
#'@param size_marker integer; size (in inches) of the value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .1
#'@param size_marker_inner integer; size (in inches) of the nested value marker
#' at the circle border that indicates the center distance, a value of 0 omits
#' the marker; defaults to .05
#'
#'@details To summarize center distances (\code{cd_method}), the "mean" method
#' computes the average center distance (compute cds first, summarize across
#' items second), while the "aggregate" method computes a center distance based
#' on the sum of the squared loadings (summarize across items first, compute
#' cds second). "Aggregate" (default) is recommended, because it is more
#' meaningful in cases with heterogeneous factor loadings, while "mean" is the
#' originally proposed method.
#'
#' To get tidy results, it is often required to use \code{rotate_} and
#' \code{subrotate_} for better alignment.
#'
#' If you set \code{subrotate_} to a single value, all nested facet charts will
#' be rotated by the same amount. If you use a vector of values, the nested
#' facet charts will be rotated one by one by the values from that vector.
#'
#' Increase \code{relative_scaling} to avoid circle overlap. Decrease it to
#' make small chart objects more visible.
#'
#' \code{correlations} and \code{cor_spacing} add larger circles around the
#' nested facet charts, but do not change these facet charts.
#'
#' When changing the size of objects, consider the \code{size} parameter first
#' and make specific adjustments with the other \code{size_} and \code{width_}
#' parameters after.
#'
#' Pdf files will be vector based and can be scaled arbitrarily. For other
#' formats use \code{file_width}, \code{file_height}, and \code{dpi} to avoid
#' later rescaling and loss of quality.
#'
#' Instead of using screenshots to crop the chart, it is highly recommendable
#' to use \code{zoom_x} and \code{zoom_y}. This allows for vector-based
#' graphics quality when showing sections of the chart. With this cropping
#' method, use \code{file_width} to set the overall size of the file output,
#' \code{file_height} will automatically adjust to retain the correct aspect
#' ratio, if both \code{zoom_x} and \code{zoom_y} are provided.
#'
#' If \code{facet1} or \code{facet2} is \code{NA} for a given xarrow, the arrow
#' will end on the test's circle. Note: this correlation is usually not part of
#' the model.
#'
#' Consider adding title and caption in your typesetting software (LaTeX, MS
#' Word, ...), not here. The option to add a title is only a quick and dirty
#' shurtcut. It reduces chart size and is inflexible. Adding the title manually
#' will provide additional options, but requires you to save to a file
#' manually. To manually add a title or caption use
#' \code{\link[ggplot2]{labs}}.
#'
#'@return Object of the class "ggplot".
#'
#'@seealso \code{\link{item_chart}} \code{\link{facet_chart}}
#'
#' @examples
#' # as simple as that
#' nested_chart(self_confidence)
#'
#' # rotating the nested facet charts one by one
#' nested_chart(self_confidence,
#' subrotate_radians = c(0, pi/2, 0))
#'
#' # test without facets
#'
#' global <- system.file(
#' "extdata", "IPV_global.xlsx", package = "IPV", mustWork = TRUE)
#' tests <- c(
#' system.file("extdata", "IPV_DSSEI.xlsx", package = "IPV", mustWork = TRUE),
#' system.file("extdata", "IPV_SMTQ.xlsx", package = "IPV", mustWork = TRUE),
#' NA)
#' x <- input_excel(global = global, tests = tests)
#' nested_chart(x)
#'
#'@export
nested_chart <- function(
data,
cd_method = "aggregate",
test_order = NULL,
facet_order = NULL,
xarrows = TRUE,
subradius = 0,
file_name = "none",
size = 1,
relative_scaling = 0,
font = "sans",
rotate_radians = 0,
rotate_degrees = 0,
subrotate_radians = 0,
subrotate_degrees = 0,
file_width = 10,
file_height = 10,
zoom_x = NULL,
zoom_y = NULL,
dpi = 500,
color_global = "#11C1FF",
color_nested = "#007AD6",
fade = 85,
cor_spacing = 0,
tick = 0,
rotate_tick_label = 0,
dist_construct_label = 10,
rotate_construct_label_radians = 0,
rotate_construct_label_degrees = 0,
dist_test_labels = 2/ 3,
rotate_test_labels_radians = 0,
rotate_test_labels_degrees = 0,
cor_labels_tests = TRUE,
cor_labels_facets = TRUE,
title = NULL,
size_title = 1,
size_construct_label = 1,
size_test_labels = 1,
size_facet_labels = 1,
width_axes = 1,
width_axes_inner = 1,
width_circles = 1,
width_circles_inner = 1,
width_tick = 1,
width_tick_inner = 1,
size_tick_label = 1,
size_cor_labels = 1,
size_cor_labels_inner = 1,
width_xarrows = 1,
size_xarrow_heads = 1,
size_xarrow_labels = 1,
size_marker = .1,
size_marker_inner = .05){
if(length(names(data$est$tests)) == 1) {
stop("The model is simple, not nested. Try facet_chart or item_chart.")
}
coord <- coord_nested(
data = data,
cd_method = cd_method,
test_order = test_order,
facet_order = facet_order,
subradius = subradius,
tick = tick,
rotate_tick_label = rotate_tick_label,
rotate_radians = rotate_radians,
rotate_degrees = rotate_degrees,
subrotate_radians = subrotate_radians,
subrotate_degrees = subrotate_degrees,
dist_construct_label = dist_construct_label,
rotate_construct_label_radians = rotate_construct_label_radians,
rotate_construct_label_degrees = rotate_construct_label_degrees,
dist_test_labels = dist_test_labels,
rotate_test_labels_radians = rotate_test_labels_radians,
rotate_test_labels_degrees = rotate_test_labels_degrees,
prepare_item_charts = FALSE,
correlations = cor_labels_tests,
cor_spacing = cor_spacing,
relative_scaling = relative_scaling,
xarrows = xarrows)
myipv <- plot_nested(
coord = coord,
size = size,
file_name = file_name,
zoom_x = zoom_x,
zoom_y = zoom_y,
file_width = file_width,
file_height = file_height,
dpi = dpi,
cor_labels_tests = cor_labels_tests,
cor_labels_facets = cor_labels_facets,
color_global = color_global,
color_nested = color_nested,
fade = fade,
font = font,
size_construct_label = size_construct_label,
size_test_labels = size_test_labels,
size_facet_labels = size_facet_labels,
width_axes = width_axes,
width_axes_inner = width_axes_inner,
width_circles = width_circles,
width_circles_inner = width_circles_inner,
width_tick = width_tick,
width_tick_inner = width_tick_inner,
title = title,
size_title = size_title,
size_tick_label = size_tick_label,
size_cor_labels = size_cor_labels,
size_cor_labels_inner = size_cor_labels_inner,
width_xarrows = width_xarrows,
size_xarrow_heads = size_xarrow_heads,
size_xarrow_labels = size_xarrow_labels,
size_marker = size_marker,
size_marker_inner = size_marker_inner)
return(myipv)
}
#'Coord Nested
#'
#'Generates the coordinates for a nested chart and all other charts.
#'
#'@param data Object of class IPV as created by the function 'ipv_est'
#'@param cd_method character; method to summarize center distances, either
#' "mean" or "aggregate", see details; defaults to "aggregate".
#'@param test_order character; vector of test names in desired order
#' (counter-clockwise); defaults to NULL, in which case the order is based on
#' the correlation matrix columns in 'data'.
#'@param facet_order character; vector of all facet names of all tests in
#' desired order (counter-clockwise); defaults to NULL, in which case the order
#' is based on the correlation matrix columns in 'data'.
#'@param subradius integer; same unit as center distances; radius of the facet
#' circles; defaults to 0, in which case an appropriate value is estimated.
#'@param tick numeric; axis tick position; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param rotate_tick_label numeric; number of positions to move the tick label
#' (counter-clockwise); defaults to 0.
#'@param rotate_radians integer; radian angle to rotate the chart
#' counter-clockwise by; use fractions of pi (e.g. pi/2 = 90 degrees).
#'@param rotate_degrees integer; angle in degrees to rotate the chart
#' counter-clockwise by.
#'@param subrotate_radians integer; radian angle or vector of radian angles to
#' rotate the nested facet charts counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param subrotate_degrees integer; angle in degrees or vector of angles in
#' degrees to rotate the nested facet charts counter-clockwise by.
#'@param dist_construct_label integer; position of the construct label relative
#' to the surrounding circle; defaults to 10, in which case an appropriate
#' value is estimated; a value of .5 would position the label halfway between
#' the center and the surrounding circle.
#'@param rotate_construct_label_radians integer; radian angle to rotate the
#' construct label counter-clockwise by; use fractions of pi (e.g. pi/2 = 90
#' degrees).
#'@param rotate_construct_label_degrees integer; angle in degrees to rotate the
#' construct label counter-clockwise by.
#'@param dist_test_labels integer; position of the test labels relative to the
#' surrounding circle; defaults to 2/3, in which case the test labels are
#' displayed 2/3 of the way from the centers to the surrounding circles.
#'@param rotate_test_labels_radians integer; radian angle or vector of radian
#' angles to rotate the test labels counter-clockwise by; use fractions of pi
#' (e.g. pi/2 = 90 degrees).
#'@param rotate_test_labels_degrees integer; angle or vector of angle in degrees
#' to rotate the test labels counter-clockwise by.
#'@param prepare_item_charts logical; if \code{TRUE}, generates the item chart
#' coordinates for all factors by calling \code{\link{coord_items}}.
#'@param correlations logical; if \code{TRUE}, generates the coordinates for the
#' latent correlations between tests. Sets up a ring to draw them in. If
#' \code{FALSE}, the ring and the correlations are omitted, simplifying the
#' chart significantly.
#'@param cor_spacing integer; if \code{correlations = TRUE}: width of the ring,
#' the latent correlations between tests are drawn in; defaults to 0, in which
#' case an appropriate value is estimated.
#'@param relative_scaling integer; relative size of the global chart scale
#' compared to the nested facet chart scales; defaults to 0, in which case an
#' appropriate value is estimated.
#'@param xarrows logical; should arrows between tests be displayed?; defaults to TRUE.
#'
#'@details Use \code{\link{nested_chart}} to create nested charts.
#'
#'@return List containing coordinates of chart objects.
#'
#'@seealso \code{\link{plot_nested}} \code{\link{nested_chart}}
coord_nested <- function (
data,
cd_method = "aggregate",
test_order = NULL,
facet_order = NULL,
subradius = 0,
tick = 0,
rotate_tick_label = 0,
rotate_radians = 0,
rotate_degrees = 0,
subrotate_radians = 0,
subrotate_degrees = 0,
dist_construct_label = 10,
rotate_construct_label_radians = 0,
rotate_construct_label_degrees = 0,
dist_test_labels = 2 / 3,
rotate_test_labels_radians = 0,
rotate_test_labels_degrees = 0,
prepare_item_charts = FALSE,
correlations = TRUE,
cor_spacing = 0,
relative_scaling = 0,
xarrows = TRUE) {
# helper variables -----------------------------------------------------------
cplx <- length(colnames(data$est$g$cors))
# a vector of subrotation values can be given,
# to allign the nested facet charts
subrotate <- subrotate_radians + subrotate_degrees * pi / 180
if (length(subrotate) == 1) subrotate <- rep(subrotate, cplx)
if (length(dist_test_labels) == 1) {
dist_test_labels <- rep(dist_test_labels, cplx)
}
rotate_test_labels <- rotate_test_labels_radians +
rotate_test_labels_degrees * pi / 180
if (length(rotate_test_labels) == 1) {
rotate_test_labels <- rep(rotate_test_labels, cplx)
}
# default subradius needs to scale with the data to avoid messy results
def_subradius <- function (x) {
cplx <- length(colnames(x$cors))
if (cd_method == "aggregate") mcd <- x$cds$aggregate_cd
if (cd_method == "mean") mcd <- x$cds$mean_cd
subradius <- max(mean(mcd), .25 * max(mcd)) *
(5 / (3 + cplx)) *
(.25 + .25 * (min(max(mean(mcd), .25 * max(mcd)) / stats::sd(mcd), 3)))
}
if (subradius == 0) {
subradius <- min(unlist(lapply(
data$est$tests[!is.na(data$est$tests)],
def_subradius)))
message(paste("Facet circle radius set to ",
signif(subradius, digits = 3),
" based on the data.",
sep = ""))
}
# nested facet charts --------------------------------------------------------
factorcoords <- list()
for (i in seq_along(data$est$tests)) {
factorcoords[[i]] <- suppressMessages(coord_facets(
data$est$tests[[i]],
cd_method = cd_method,
facet_order = facet_order,
subradius = subradius,
rotate_radians = subrotate[i],
rotate_test_label_radians = rotate_test_labels[i],
dist_test_label = dist_test_labels[i]))
if (is.na(factorcoords[[i]][["p_axes"]][1,"rho0"])) {
x <- names(data$est$tests)[i]
row.names(factorcoords[[i]][["p_circs"]]) <- x
row.names(factorcoords[[i]][["c_circs"]]) <- x
factorcoords[[i]][["test_label"]]["label"] <- x
}
}
names(factorcoords) <- names(data$est$tests)
# # this could be used for bulk processing of item charts in a future build
# if (prepare_item_charts == TRUE) {
# itemcoords <- list()
# for (i in 1:length(data$est$tests)) {
# itemcoords[[i]] <- coord_items(data$est$tests[[i]],
# rotate_radians = subrotate[i])
# }
# names(itemcoords) <- names(data$est$tests)
# }
# helper variables -----------------------------------------------------------
if (is.null(test_order)) {
test_order <- colnames(data$est$g$cors)
}
nam <- test_order
rotate <- rotate_radians + rotate_degrees * pi / 180
rotate_construct_label <- rotate_construct_label_radians +
rotate_construct_label_degrees * pi / 180
# test circle size needed to allign objects
getcircsize <- function (x) {
polcircs <- get(x = "p_circs", envir = as.environment(x))
polcircs <- polcircs[1, "radius"]
}
circsize <- unlist(lapply(factorcoords, getcircsize))
if (cor_spacing == 0 & correlations == TRUE) {
cor_spacing <- .15 * max(circsize)
message(paste("cor_spacing set to ",
signif(cor_spacing, digits = 3),
" based on the data.",
sep = ""))
}
circsize <- circsize + correlations * cor_spacing
if (cd_method == "aggregate") {
g_cds <- data.frame(lapply(split(data$est$g$cds, data$est$g$cds$subfactor),
function (x) y <- x$aggregate_cd[1]))
}
if (cd_method == "mean") {
g_cds <- data.frame(lapply(split(data$est$g$cds, data$est$g$cds$subfactor),
function (x) y <- x$mean_cd[1]))
}
g_cds <- t(g_cds)
g_cds <- data.frame(g_cds)
# default relative scaling needs to scale with the data to avoid messy results
rs <- relative_scaling
if (rs == 0) {
rs <- mean(circsize) / mean(g_cds$g_cds) * 3 * (cplx + 3) / (20 - cplx / 2)
message(paste("Relative scaling set to ",
signif(rs, digits = 3),
" based on the data.",
sep = ""))
}
# default axis tick also scales with the data, selected from a set of possible
# ticks to avoid odd values
if (cd_method == "aggregate") tot_cd <- data$est$g$cds$aggregate_cd
if (cd_method == "mean") tot_cd <- data$est$g$cds$mean_cd
if (tick == 0){
tick <- signif(
max(.15 * max(tot_cd),
.3 * min(tot_cd)) *
rs ^ .25,
1)
if (rs < 3 * (cplx + 3) / 200){
tick <- signif(tick * rs, 1)
}
if (rs > 1.5 * (cplx + 3)) {
tick <- signif(10 * tick / rs, 1)
}
sc <- rep(c(1, 2, 5), 5) * 10 ^ rep(-3:1, each = 3)
tick <- sc[which.min(abs(tick - sc))]
message(paste("Axis tick set to ", tick," based on the data.", sep = ""))
}
# default distance of the construct label from the center needs to scale with
# the number of tests, to account for the reduction in space
if (dist_construct_label == 10) {
dist_construct_label <- (1 - 2 / (1 + cplx))
message(paste("dist_construct_label set to ",
signif(dist_construct_label, digits = 3),
" based on the data.",
sep = ""))
}
# global chart objects -------------------------------------------------------
## circles ------------------------
# polar for calculation, carthesian for application
p_circs <- data.frame(phi = rep(NA, cplx + 1),
rho = 0,
radius = NA)
row.names(p_circs) <- c(levels(data$est$g$cds$factor), nam)
p_circs[names(circsize), "radius"] <- circsize
p_circs$radius[1] <- max(g_cds[nam, ] * rs + circsize[nam] * 2)
p_circs[nam, "rho"] <- c(g_cds[nam, ] * rs + circsize[nam])
p_circs$phi <- c(0, 2 * pi / cplx * c(1:cplx)) + rotate
p_circs$phi[p_circs$phi > 2 * pi] <-
p_circs$phi[p_circs$phi > 2 * pi] - 2 * pi
# reminder:
# x=cos(phi)*rho
# y=sin(phi)*rho
c_circs <- p_circs
# rounded values to decrease display length in console
c_circs[ ,1] <- round(cos(p_circs$phi) * p_circs$rho, digits = 7)
c_circs[ ,2] <- round(sin(p_circs$phi) * p_circs$rho, digits = 7)
names(c_circs) <- c("x", "y", "radius")
row.names(c_circs)[1] <- ""
# add rings for correlation values, so they have enough space to be displayed
if(correlations == TRUE) {
p_ring <- data.frame(
phi = rep(NA, cplx + 1),
rho = NA,
radius = NA)
row.names(p_ring) <- c(levels(data$est$g$cds$factor), nam)
p_ring[names(circsize), "radius"] <- circsize - correlations * cor_spacing
p_ring[nam, "rho"] <- c(g_cds[nam, ] * rs + circsize[nam])
p_ring$phi <- c(0, 2 * pi / cplx * c(1:cplx)) + rotate
p_ring$rho[-1] <- p_ring$rho[-1]
p_ring <- p_ring[-1, ]
c_ring <- p_ring
c_ring[,1] <- round(cos(p_ring$phi) * p_ring$rho, digits = 7)
c_ring[,2] <- round(sin(p_ring$phi) * p_ring$rho, digits = 7)
names(c_ring) <- c("x", "y", "radius")
} else {
c_ring <- NULL
p_ring <- NULL
}
## axes ---------------------------
p_axes <- data.frame(
rho0 = rep(0, cplx),
rho1 = NA,
rho2 = NA,
rho3 = NA,
phi = NA)
row.names(p_axes) <- nam
p_axes$phi <- utils::tail(p_circs$phi, cplx)
p_axes$rho1 <- utils::tail(p_circs$rho, cplx) -
utils::tail(p_circs$radius, cplx)
p_axes$rho2 <- p_axes$rho1 + 2 * utils::tail(p_circs$radius, cplx)
p_axes$rho3 <- rep(p_circs$radius[1])
c_axes <- data.frame(
x0 = rep(NA, cplx), y0 = NA,
x1 = NA, y1 = NA,
x2 = NA, y2 = NA,
x3 = NA, y3 = NA)
row.names(c_axes) <- nam
c_axes$x0 <- round(cos(p_axes$phi) * p_axes$rho0, digits = 7)
c_axes$x1 <- round(cos(p_axes$phi) * p_axes$rho1, digits = 7)
c_axes$x2 <- round(cos(p_axes$phi) * p_axes$rho2, digits = 7)
c_axes$x3 <- round(cos(p_axes$phi) * p_axes$rho3, digits = 7)
c_axes$y0 <- round(sin(p_axes$phi) * p_axes$rho0, digits = 7)
c_axes$y1 <- round(sin(p_axes$phi) * p_axes$rho1, digits = 7)
c_axes$y2 <- round(sin(p_axes$phi) * p_axes$rho2, digits = 7)
c_axes$y3 <- round(sin(p_axes$phi) * p_axes$rho3, digits = 7)
axis_tick <- data.frame(tick = tick, rho = tick, phi = NA, x = NA, y = NA)
axis_tick$phi <- min(p_circs$phi) + (pi + 2 * pi * rotate_tick_label) / cplx
axis_tick$x <- round(cos(axis_tick$phi) *
max(axis_tick$rho, .1 * max(g_cds)),
digits = 7)
axis_tick$y <- round(sin(axis_tick$phi) *
max(axis_tick$rho, .1 * max(g_cds)),
digits = 7)
## construct label ----------------
# coordinates of construct name
# guesses where space is (next to lowest center distance)
construct_label <- data.frame(
x = NA,
y = NA,
label = row.names(p_circs)[1],
phi=NA,
rho=NA)
construct_label$phi <- p_circs[which.min(p_circs$radius), "phi"] +
pi / cplx + rotate_construct_label
construct_label$rho <- dist_construct_label * max(p_circs$radius)
construct_label$x <- round(
cos(construct_label$phi) * construct_label$rho, digits = 7)
construct_label$y <- round(
sin(construct_label$phi) * construct_label$rho, digits = 7)
## correlations -------------------
n <- cplx * (cplx - 1)
cors <- data.frame(x = rep(NA, n),
y = NA,
V1 = NA,
V2 = NA,
label = NA,
xnew = NA,
ynew = NA)
a <- nam
a <- c(a, a[1])
b <- NULL
for (k in 1:cplx) {
b <- c(b, a[-c(1, cplx + 1)])
a <- a[-1]
a <- c(a, a[1])
}
cors$V1 <- b
cors$V2 <- unlist(lapply(nam, rep, times = cplx - 1))
for (k in 1:n) {
cors$label[k] <- data$est$g$cors[cors$V1[k], cors$V2[k]]
}
cors$label <- as.character(cors$label)
# exclude leading 0's for aesthetic reasons
cors$label[cors$label < 0] <-
paste("-", substr(cors$label[cors$label < 0], 3, 5), sep = "")
cors$label[cors$label != 1 & cors$label > 0] <-
substr(cors$label[cors$label != 1 & cors$label > 0], 2, 4)
cors$x <- c_circs[cors$V2, "x"]
cors$y <- c_circs[cors$V2, "y"]
# scatter labels for readability, position indicates partner variable
scatter <- rep(seq(from = (-pi + 2 * pi / cplx) / 2,
to = (pi - 2 * pi / cplx) / 2,
by = (pi - 2 * pi / cplx) / (cplx - 2)),
cplx)
rho <- p_circs[cors$V2, "radius"]
phi <- p_circs[cors$V2, "phi"]
cors$xnew <- cors$x +
round(cos(phi + pi + scatter), digits = 7) *
(rho - correlations * .5 * cor_spacing)
cors$ynew <- cors$y +
round(sin(phi + pi + scatter), digits = 7) *
(rho - correlations * .5 * cor_spacing)
cors$x <- cors$xnew
cors$y <- cors$ynew
cors[6:7] <- list(NULL)
# nested chart objects -------------------------------------------------------
## shifted facet charts -----------
subcircles <- list()
shift_factor <- function (data, x, y) {
# stripping off superfluous information
d <- data[c("c_circs",
"c_axes",
"test_label",
"cors")]
d$axis_tick[1:2] <- list(NULL) # polar coordinates not needed anymore
d$c_circs$x <- d$c_circs$x + x
d$c_axes$x0 <- d$c_axes$x0 + x
d$c_axes$x1 <- d$c_axes$x1 + x
d$c_axes$x2 <- d$c_axes$x2 + x
d$c_axes$x3 <- d$c_axes$x3 + x
d$axis_tick$x <- d$axis_tick$x + x
d$test_label$x <- d$test_label$x + x
d$cors$x <- d$cors$x + x
d$c_circs$y <- d$c_circs$y + y
d$c_axes$y0 <- d$c_axes$y0 + y
d$c_axes$y1 <- d$c_axes$y1 + y
d$c_axes$y2 <- d$c_axes$y2 + y
d$c_axes$y3 <- d$c_axes$y3 + y
d$test_label$y <- d$test_label$y + y
d$cors$y <- d$cors$y + y
return(d)
}
for(i in 1:cplx) {
subcircles[[nam[i]]] <- shift_factor(factorcoords[[nam[i]]],
c_circs[nam[i], "x"],
c_circs[nam[i], "y"])
}
# bunched processing for these ones:
nested <- list(circles = NULL,
axes = NULL,
test_label = NULL,
cors = NULL)
## chart objects ------------------
# circles
for (i in 1:cplx) nested$circles[[nam[i]]] <- subcircles[[c(i, 1)]]
nested$circles <- lapply(nested$circles, utils::tail, n = -1)
nested$circles <- do.call("rbind", nested$circles)
# cutting superfluous test names from labels
nested$circles$label <- substr(
row.names(nested$circles),
unlist(gregexpr(pattern = "\\.", row.names(nested$circles))) + 1,
nchar(row.names(nested$circles)))
# axes
for (i in 1:cplx) nested$axes[[nam[i]]] <- subcircles[[c(i, 2)]]
nested$axes <- do.call("rbind", nested$axes)
# test labels
for (i in 1:cplx) nested$test_label[[nam[i]]] <- subcircles[[c(i, 3)]]
nested$test_label <- do.call("rbind", nested$test_label)
# correlations
for (i in 1:cplx) nested$cors[[nam[i]]] <- subcircles[[c(i,4)]]
nested$cors <- do.call("rbind", nested$cors)
# extra arrows ---------------------------------------------------------------
## arrows -------------------------
if (xarrows & !all(is.na(data$xarrow))) {
n <- dim(data$xarrow)[1]
arrows <- data.frame(x1 = rep(NA, n),
x2 = NA,
y1 = NA,
y2 = NA,
label = NA,
xlabel = NA,
ylabel = NA)
arrows$label <- data$xarrow$value
# facet circles are named as 'test.facet' within nested$circles
# arrow ends on facets
arrows$x1 <- nested$circles[paste(data$xarrow$test1,
data$xarrow$facet1,
sep = "."),
"x"]
arrows$y1 <- nested$circles[paste(data$xarrow$test1,
data$xarrow$facet1,
sep = "."),
"y"]
arrows$x2 <- nested$circles[paste(data$xarrow$test2,
data$xarrow$facet2,
sep = "."),
"x"]
arrows$y2 <- nested$circles[paste(data$xarrow$test2,
data$xarrow$facet2,
sep = "."),
"y"]
# arrow ends on tests
arrows[is.na(data$xarrow$facet1), c("x1", "y1")] <-
c_circs[
data$xarrow[is.na(data$xarrow$facet1),"test1"],
c("x", "y")]
arrows[is.na(data$xarrow$facet2), c("x2", "y2")] <-
c_circs[
data$xarrow[is.na(data$xarrow$facet2),"test2"],
c("x", "y")]
## labels -----------------------
# labels are placed on the intersection between the arrow
# and an imaginary line halfway between the test circles
# to avoid overlap with any other chart objects
# x- and y-distances between the centers of the big and
# the small circles involved
xdist_big <- NULL
ydist_big <- NULL
for (i in 1:n) {
xdist_big[i] <- c_circs[data$xarrow$test2[i], "x"] -
c_circs[data$xarrow$test1[i], "x"]
ydist_big[i] <- c_circs[data$xarrow$test2[i], "y"] -
c_circs[data$xarrow$test1[i], "y"]
}
xdist_small <- arrows$x2 - arrows$x1
ydist_small <- arrows$y2 - arrows$y1
# total distances between the centers of the big and
# the small circles involved
dist_big <- sqrt(xdist_big ^ 2 + ydist_big ^ 2)
dist_small <- sqrt(xdist_small ^ 2 + ydist_small ^ 2)
# points halfway between the big circles
halfwaypoint <- data.frame(x = rep(NA, n), y = NA)
for (i in 1:n) {
halfwaypoint$x[i] <- (c_circs[data$xarrow$test1[i], "x"] +
c_circs[data$xarrow$test2[i], "x"]) / 2 +
xdist_big[i] / dist_big[i] /
2 * (c_circs[data$xarrow$test1[i], "radius"] -
c_circs[data$xarrow$test2[i], "radius"])
halfwaypoint$y[i] <- (c_circs[data$xarrow$test1[i], "y"] +
c_circs[data$xarrow$test2[i], "y"]) / 2 +
ydist_big[i] / dist_big[i] /
2 * (c_circs[data$xarrow$test1[i], "radius"] -
c_circs[data$xarrow$test2[i], "radius"])
}
# placing the labels alongside the arrow on their final positions
d <- NULL
for(i in 1:n){
d[i] <- dist_small[i] *
(((arrows$x1[i] - halfwaypoint$x[i]) * -xdist_big[i]) -
((arrows$y1[i] - halfwaypoint$y[i]) * ydist_big[i])) /
(ydist_small[i] * ydist_big[i] - xdist_small[i] * -xdist_big[i])
}
arrows$xlabel <- arrows$x1 + d / dist_small * xdist_small
arrows$ylabel <- arrows$y1 + d / dist_small * ydist_small
# letting the correlation labels dodge their arrow by .1 sideways
# to avoid overlap
arrows$xlabel <- arrows$xlabel + .1 / dist_small * ydist_small
arrows$ylabel <- arrows$ylabel + .1 / dist_small * -xdist_small
## arrows again -----------------
arrows$radius1 <- subradius
arrows$radius2 <- subradius
# overwrite in case of arrows ending in test (instead of facet)
arrows[is.na(data$xarrow$facet1), "radius1"] <-
c_circs[data$xarrow[is.na(data$xarrow$facet1), "test1"],
"radius"]
arrows[is.na(data$xarrow$facet2), "radius2"] <-
c_circs[data$xarrow[is.na(data$xarrow$facet2), "test2"],
"radius"]
arrows$x1new <- arrows$x1 + arrows$radius1 / dist_small * xdist_small
arrows$x2new <- arrows$x2 + arrows$radius2 / dist_small * -xdist_small
arrows$y1new <- arrows$y1 + arrows$radius1 / dist_small * ydist_small
arrows$y2new <- arrows$y2 + arrows$radius2 / dist_small * -ydist_small
arrows$x1 <- arrows$x1new
arrows$x2 <- arrows$x2new
arrows$y1 <- arrows$y1new
arrows$y2 <- arrows$y2new
arrows[8:13] <- list(NULL)
rm(n)
} else arrows <- NULL
rm(nam,cplx)
# return ---------------------------------------------------------------------
global <- list(p_circs = p_circs,
c_circs = c_circs,
p_ring = p_ring,
c_ring = c_ring,
p_axes = p_axes,
c_axes = c_axes,
axis_tick = axis_tick,
construct_label = construct_label,
cors = cors,
nested = nested,
rs = rs,
cor_spacing = cor_spacing,
arrows = arrows)
coord <- list(factor = factorcoords,
global = global,
rs = rs)
# if (prepare_item_charts == TRUE) coord$items <- itemcoords
return(coord)
}
#'Plot Nested
#'
#'Generates a nested chart from coordinates.
#'
#'@param coord list generated by \code{\link{coord_nested}}.
#'@param size integer; changes the size of most chart objects simultaneously.
#'@param file_name character; name of the file to save. Supported formats are:
#' "pdf" (highest quality and smallest file size), "png", "jpeg"; defaults to
#' "none".
#'@param zoom_x integer; vector with two values, the edges of the zoomed section
#' on the x-axis; defaults to NULL.
#'@param zoom_y integer; vector with two values, the edges of the zoomed section
#' on the y-axis; defaults to NULL.
#'@param file_width integer; file width in inches; defaults to 10.
#'@param file_height integer; file height in inches; defaults to 10.
#'@param dpi integer; resolution in dots per inch for "png" and "jpeg" files;
#' defaults to 500.
#'@param cor_labels_tests logical; if \code{TRUE}, shows the correlations
#' between tests as text.
#'@param cor_labels_facets logical; if \code{TRUE}, shows the correlations
#' between facets as text.
#'@param color_global global accent color; defaults to "black".
#'@param color_nested nested accent color; defaults to "black".
#'@param fade integer; brightness of the gray tones between 0 (black) and 100
#' (white) in steps of 1; defaults to 85.
#'@param font character; text font, use extrafonts to access additional fonts;
#' defaults to "sans", which is "Helvetica".
#'@param size_construct_label integer; construct label font size relative to
#' default.
#'@param size_test_labels integer; test label font size relative to default.
#'@param size_facet_labels integer; facet label font size relative to default.
#'@param width_axes integer; global radial axis width relative to default.
#'@param width_axes_inner integer; nested radial axis width relative to default.
#'@param width_circles integer; global circle outline width relative to default.
#'@param width_circles_inner integer; nested circle outline width relative to
#' default.
#'@param width_tick integer; global axis tick line width relative to default.
#'@param width_tick_inner integer; nested axis tick line width relative to
#' default.
#'@param title character; overall chart title; defaults to NULL.
#'@param size_title integer; title font size relative to default.
#'@param size_tick_label integer; axis tick label font size relative to default.
#'@param size_cor_labels integer; font size of the correlations between tests
#' relative to default.
#'@param size_cor_labels_inner integer; font size of the correlations between
#' facets relative to default.
#'@param width_xarrows integer; extra arrow line width relative to default.
#'@param size_xarrow_heads integer; extra arrow head length relative to default.
#'@param size_xarrow_labels integer; font size of the correlations indicated by
#' extra arrows relative to default.
#'@param size_marker integer; size (in inches) of the value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .1
#'@param size_marker_inner integer; size (in inches) of the nested value marker at the
#' circle border that indicates the center distance, a value of 0 omits the
#' marker; defaults to .05
#'
#'@details Use \code{\link{nested_chart}} to create nested charts
#'
#'@return Object of the class "ggplot" and, by default, the same object saved as
#' a file.
#'
#'@seealso \code{\link{coord_nested}} \code{\link{nested_chart}}
plot_nested <- function (
coord,
size = 1,
file_name = "none",
file_width = 10,
file_height = 10,
zoom_x = NULL,
zoom_y = NULL,
dpi = 500,
cor_labels_tests = TRUE,
cor_labels_facets = TRUE,
color_global = "black",
color_nested = "black",
fade = 85,
font = "sans",
size_construct_label = 1,
size_test_labels = 1,
size_facet_labels = 1,
width_axes = 1,
width_axes_inner = 1,
width_circles = 1,
width_circles_inner = 1,
width_tick = 1,
width_tick_inner = 1,
title = NULL,
size_title = 1,
size_tick_label = 1,
size_cor_labels = 1,
size_cor_labels_inner = 1,
width_xarrows = 1,
size_xarrow_heads = 1,
size_xarrow_labels = 1,
size_marker = .1,
size_marker_inner = .05) {
# preparation ----------------------------------------------------------------
if (cor_labels_tests == TRUE) {
cors <- coord$g$cors
} else cors <- NULL
if (cor_labels_facets == TRUE) {
cors_inner <- coord$g$nested$cors
} else cors_inner <- NULL
# delete empty elements
facetless <- c(
"pLaCeHoLdEr",
row.names(coord$g$nested$axes)[is.na(coord$g$nested$axes$x0)])
has_facets <- setdiff(names(coord$factor), facetless)
coord$global$nested$cors <-
coord$g$n$cors[which(!row.names(coord$g$n$cors) %in% facetless), ]
coord$global$nested$axes <-
coord$g$n$axes[which(!row.names(coord$g$n$axes) %in% facetless), ]
cors_inner <- cors_inner[which(!row.names(cors_inner) %in% facetless), ]
# some calculations are not possible within aes_string(), so aesthetics are
# prepared here
tick <- coord$g$axis_tick$tick
tick_label_x <- coord$g$rs * coord$g$axis_tick$x +
0.03 * size * size_tick_label *
cos(coord$g$axis_tick$phi) * coord$g$p_circs[1, "radius"]
tick_label_y <- coord$g$rs * coord$g$axis_tick$y +
0.03 * size * size_tick_label *
sin(coord$g$axis_tick$phi) * coord$g$p_circs[1, "radius"]
tick_label_label <- as.character(formatC(tick, format = "fg"))
# aspect ratio correction (to manage zoomed cases)
if(!is.null(zoom_x) & !is.null(zoom_y)) {
asp <- diff(zoom_y) / diff(zoom_x)
file_height <- asp * file_width
}
# scale zoom_x and zoom_y properly (messed up by relative_scaling)
if (!is.null(zoom_x)) zoom_x <- zoom_x * coord$rs
if (!is.null(zoom_y)) zoom_y <- zoom_y * coord$rs
# chart ----------------------------------------------------------------------
myipv <- ggplot2::ggplot(coord$g$c_circs) +
## initializing -----------------
ggplot2::coord_fixed() +
ggplot2::theme(
axis.line = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.title.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
legend.position = "none",
panel.background = ggplot2::element_blank(),
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
plot.background = ggplot2::element_blank(),
text = ggplot2::element_text(size = 16, family = font),
plot.margin = ggplot2::margin(0, 0, 0, 0, "in"),
plot.title = ggplot2::element_text(
hjust = .5,
vjust = -3,
size = 16 * size * size_title)) +
ggplot2::aes() +
## layers -----------------------
# ordered from bottom to top for correct overlap
# tick label
ggplot2::geom_text(
data = coord$g$axis_tick,
ggplot2::aes(x = tick_label_x,
y = tick_label_y,
label = tick_label_label),
angle = (coord$g$axis_tick$phi - pi / 48 - pi / 2) * 180 / pi,
family = font,
size = 3 * size * size_tick_label) +
# global tick
ggforce::geom_circle(
ggplot2::aes(x0 = 0, y0 = 0, r = coord$g$rs * tick),
linetype = "dotted",
size = .5 * min(size, 1) * width_tick) +
# test circle background
ggforce::geom_circle(
data = coord$g$c_circs[-1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .5 * size * width_circles,
color = color_global,
fill = "white") +
# global outer axis segments
ggplot2::geom_segment(
data = coord$g$c_axes,
ggplot2::aes_string(x = "x2", y = "y2", xend = "x3", yend = "y3"),
size = .5 * size * width_axes,
color = paste("gray", fade, sep = "")) +
# global circle
ggforce::geom_circle(
data = coord$g$c_circs[1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .5 * size * width_axes,
color = paste("gray", fade, sep = "")) +
# global center dot
ggplot2::geom_point(
ggplot2::aes(x = 0, y = 0),
size = 2 * size * width_axes) +
# nested outer axis segments
ggplot2::geom_segment(
data = coord$g$nested$axes,
ggplot2::aes_string(x = "x2", y = "y2", xend = "x3", yend = "y3"),
size = .25 * size * width_axes_inner,
color = paste("gray", fade, sep = "")) +
# nested center dots
ggplot2::geom_point(
data = coord$g$c_circs[has_facets, ],
ggplot2::aes_string(x = "x", y = "y"),
size = 1 * size * width_axes_inner) +
# test circles
ggforce::geom_circle(
data = coord$g$c_circs[-1, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .6 * size * width_circles,
color = color_global) +
# nested tick
ggforce::geom_circle(
data = coord$g$c_circs[has_facets, ],
ggplot2::aes_string(x0 = "x", y0 = "y", r = "tick"),
size = .5 * min(size, .5) * width_tick_inner,
linetype = "dotted") +
# facet circle background
ggforce::geom_circle(
data = coord$g$nested$circles,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .3 * size * width_circles_inner,
color = color_nested,
fill = "white") +
# global inner axis segments
ggplot2::geom_segment(
data = coord$g$c_axes,
ggplot2::aes_string(x = "x0", y = "y0", xend = "x1", yend = "y1"),
size = 1.5 * size * width_axes,
arrow = ggplot2::arrow(
angle = 90,
ends = "last",
length = ggplot2::unit(size_marker, "inches")),
color = "black") +
# facet circles
ggforce::geom_circle(
data = coord$g$nested$circles,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .3 * size * width_circles_inner,
color = color_nested) +
# facet labels
ggplot2::geom_text(
data = coord$g$nested$circles,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 2 * size * size_facet_labels) +
# nested inner axis segments
ggplot2::geom_segment(
data = coord$g$nested$axes,
ggplot2::aes_string(x = "x0", y = "y0", xend = "x1", yend = "y1"),
size = .75 * size * width_axes_inner,
arrow = ggplot2::arrow(
angle = 90,
ends = "last",
length = ggplot2::unit(size_marker_inner, "inches")),
color = "black") +
# construct label
ggplot2::geom_text(
data = coord$g$construct_label,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 5 * size * size_construct_label,
fontface = "bold",
color = "black") +
# test labels
ggplot2::geom_text(
data = coord$g$nested$test_label,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 3.5 * size * size_test_labels,
fontface = "bold",
color = "black")
## optional layers ----------------
# facet correlations
if (!is.null(cors_inner)) {
myipv <- myipv +
ggplot2::geom_text(
data = cors_inner,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 1.5 * size * size_cor_labels_inner)
}
# test correlations
if (!is.null(cors)) {
# rings
# c() enables putting layer on the bottom, by listing the layer first
myipv$layers <- append(
myipv$layers,
ggforce::geom_circle(
data = coord$g$c_ring,
ggplot2::aes_string(x0 = "x", y0 = "y", r = "radius"),
size = .25 * size * width_axes_inner,
color = paste("gray", fade, sep = "")),
after = 3
)
# labels
myipv <- myipv +
ggplot2::geom_text(
data = cors,
ggplot2::aes_string(x = "x", y = "y", label = "label"),
family = font,
size = 3 * size * size_cor_labels,
fontface = "bold")
}
# extra arrows
if (!is.null(coord$global$arrows)) {
myipv <- myipv +
# arrows
ggplot2::geom_segment(
data = coord$g$arrows,
ggplot2::aes_string(x = "x1", y = "y1", xend = "x2", yend = "y2"),
arrow = ggplot2::arrow(
ends = "both",
length = ggplot2::unit(.003 * size * size_xarrow_heads,
"native"),
type = "closed"),
size = .25 * size * width_xarrows,
linetype = "dotted",
color = "gray20") +
# labels
ggplot2::geom_text(
data = coord$g$arrows,
ggplot2::aes_string(x = "xlabel", y = "ylabel", label = "label"),
size = 2.25 * size * size_xarrow_labels,
family = font,
color = "gray20")
}
# title
if (!is.null(title)) {
myipv <- myipv +
ggplot2::ggtitle(label = title)
}
# section
if (!is.null(c(zoom_x, zoom_y))) {
myipv <- myipv +
ggplot2::coord_cartesian(
xlim = zoom_x,
ylim = zoom_y,
expand = FALSE)
if(!is.null(zoom_x) & !is.null(zoom_y) & file_name != "none") {
message(paste(
"file_height was set to ",
signif(asp, 4),
" times the file_width, to retain the aspect ratio.",
sep = ""))
}
}
# optional file save ---------------------------------------------------------
## .pdf ---------------------------
if (substring(file_name, nchar(file_name)-3+1) == "pdf") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
## .png ---------------------------
if (substring(file_name, nchar(file_name)-3+1) == "png") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
## .jpeg --------------------------
if (substring(file_name, nchar(file_name)-3+1) == "peg") {
ggplot2::ggsave(file_name,
myipv,
width = file_width,
height = file_height,
units = "in",
dpi = dpi)
}
# return ---------------------------------------------------------------------
return(myipv)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.