Nothing
# //////////////////////////////////////////////////////
#' Calculate coordinates for biplot.
#'
#' @param x `repgrid` object.
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param col.active Columns (elements) that are no supplementary points, i.e. they are used
#' in the SVD to find principal components. default is to use all elements.
#' @param col.passive Columns (elements) that are supplementary points, i.e. they are NOT used
#' in the SVD but projected into the component space afterwards. They do not
#' determine the solution. Default is `NA`, i.e. no elements are set
#' supplementary.
#' @param ... Parameters to be passed on to `center()` and `normalize`.
#' @return a `list`.
#' @keywords internal
#' @export
#'
calcBiplotCoords <- function(x, g = 0, h = 1 - g,
col.active = NA,
col.passive = NA,
...) {
# definition of active and passive (supplementary points)
if (!identical(col.active, NA) & !identical(col.passive, NA)) {
stop("active OR passive columns must be defined")
}
ne <- getNoOfElements(x)
if (identical(col.active, NA)) { # if no active points defined
col.active <- seq_len(ne) # the rest is set active
col.active <- setdiff(col.active, col.passive)
} else if (identical(col.passive, NA)) { # if no passive points defined
col.passive <- seq_len(ne) # the is set passive
col.passive <- setdiff(col.passive, col.active)
}
X <- center(x, ...) # center grid
X <- normalize(X, ...) # normalize grid
X.active <- X[, col.active] # X with active columns (elements) only. Used for SVD.
# The other supplementary elements are projected afterwards.
dec <- svd(X.active) # make SVD for reduced set of active points
U <- dec$u # left singular vector matrix
D <- dec$d # matrix of singular values
V <- dec$v # right singular vector matrix
# constructs coords
C <- U %*% diag(D^g) # standard form
# C <- X[, col.active] %*% V %*% (D^h)^-1
# C <- X[, col.active] %*% V %*% (D^(1-g))^-1
# element coords
# E <- V %*% diag(D^h) # not used as supplementary points need to be calculated
# t(X) %*% U %*% (D^g)^-1 # only works when g + h =1, thus:
E <- t(X) %*% U %*% diag((D^(1 - h))^-1) # only dependent on h not g
rownames(C) <- constructs(x)[, 2] # names of direction into which vector points
rownames(E) <- elements(x)
x@calcs$biplot <- list(
X = X, element.coords = E, construct.coords = C,
D = D, U = U, V = V, col.passive = col.active,
col.passive = col.passive
)
x
}
#' Map arbitrary numeric vector to a given range of values.
#'
#' From a given numeric vector `z` the range is determined and
#' the values are linearly mapped onto the interval
#' given by `val.range`. This
#' function can be used in order to map arbitrary vectors to a given
#' range of values.
#'
#' @param z numeric vector.
#' @param val.range numeric vector of lengths two (default `c(.5, 1)`).
#' @return numeric vector
#' @keywords internal
#' @export
mapCoordinatesToValue <- function(z, val.range = c(.5, 1)) {
z.range <- c(min(z, na.rm = T), max(z, na.rm = T))
slope <- diff(val.range) / diff(z.range)
int <- val.range[1] - z.range[1] * slope
vals <- int + slope * z
round(vals, 10) # round at 10th digit to prevent values like 1.00000000001
}
#' Determine color values according to a given range of values.
#'
#' From a given numeric vector z the range is determined and the values are
#' linearly mapped onto the interval given by `val.range`. Then
#' a color ramp using the colors given by `color` is created and
#' the mapped values are transformed into hex color values.
#'
#' @param z numeric vector.
#' @param colors vector of length two giving color values `c("white", "black")`.
#' @param val.range numeric vector of lengths two (default `c(.2, .8)`).
#' @return numeric vector
#' @keywords internal
#' @export
#'
mapCoordinatesToColor <- function(z, colors = c("white", "black"), val.range = c(.2, .8)) {
colorRamp <- makeStandardRangeColorRamp(colors)
vals <- mapCoordinatesToValue(z, val.range)
colorRamp(unlist(vals)) # unlist in case z comes as a data frame column
}
#' Coordinates of a surrounding rectangle in direction of a given vector.
#'
#' An arbitrary numeric vector in 2D is to be extended so it will
#' end on the borders of a surrounding rectangle of a given size.
#' Currently the vector is supposed to start in the origin `c(0,0)`.
#'
#' @param x numeric vector of x coordinates x coordinates.
#' @param y numeric vector of y coordinates x coordinates.
#' @param xmax maximal x value for surrounding rectangle (default is `1`).
#' @param ymax maximal y value for surrounding rectangle (default is `1`).
#' @param cx center of rectangle in x direction (not yet supported).
#' @param cy center of rectangle in x direction (not yet supported).
#'
#' @return a `dataframe` containing the x and y coordinates for the
#' extended vectors.
#' @keywords internal
#' @export
#' @examples \dontrun{
#' calcCoordsBorders(1:10, 10:1)
#'
#' x <- c(-100:0, 0:100, 100:0, 0:-100) / 10
#' y <- c(0:100, 100:0, -(0:100), -(100:0)) / 10
#' xy1 <- calcCoordsBorders(x, y)
#' xy2 <- calcCoordsBorders(x, y, xm = 1.2, ym = 1.2)
#' plot(xy2[, 1], xy2[, 2], type = "n")
#' segments(xy1[, 1], xy1[, 2], xy2[, 1], xy2[, 2])
#' }
#'
calcCoordsBorders <- function(x, y, xmax = 1, ymax = 1, cx = 0, cy = 0) {
is.lr.part <- abs(x * ymax / xmax) >= abs(y) # which are left and right parts
# left and right part
sign.x <- sign(x) # positive or negative value
sign.x[sign.x == 0] <- 1 # zeros in posistive direction
a.lr <- xmax * sign(x) # x is fix on the left and right side
b.lr <- y / x * a.lr
# upper and lower part
sign.y <- sign(y)
sign.y[sign.y == 0] <- 1
b.ul <- ymax * sign(y)
a.ul <- x / y * b.ul
a.lr <- unlist(a.lr)
b.lr <- unlist(b.lr)
a.ul <- unlist(a.ul)
b.ul <- unlist(b.ul)
a.lr[is.nan(a.lr)] <- 0 # in case one of x or y is zero Inf results ans subsequently NaN
b.lr[is.nan(b.lr)] <- 0
a.ul[is.nan(a.ul)] <- 0
b.ul[is.nan(b.ul)] <- 0
# join both parts
b <- (b.ul * !is.lr.part) + (b.lr * is.lr.part)
a <- (a.ul * !is.lr.part) + (a.lr * is.lr.part)
a[abs(a) > xmax] <- (xmax * sign(a))[abs(a) > xmax]
b[abs(b) > ymax] <- (ymax * sign(b))[abs(b) > ymax]
data.frame(x = a, y = b)
}
# calculate the coords for the label rectangle
#
# TODO: supply x.ext in mm and convert to usr coords
#
# @param xy `dataframe` with x and y coords.
# @param labels vector of strings.
# @param cex vector of cex values (default is `.7`).
# @param x.ext scalar giving the horizontal margin
# of the rectangle in NDC coordinates
# (default is `.02`).
# @param y.ext scalar giving the vertical margin
# of the rectangle in NDC coordinates
# (default is `.02`).
# @return `dataframe` with coordinates for the lower left and
# upper right rectangle borders (`x0, y0, x1, y1`).
#
calcRectanglesCoordsForLabels <- function(xy, labels, cex = .7,
x.ext = .02, y.ext = .02) {
if (length(cex) == 1) {
cex <- rep(cex, dim(xy)[1])
}
heights <- vector()
widths <- vector()
for (i in 1:dim(xy)[1]) {
heights[i] <- strheight(labels[i], cex = cex[i]) # determine necessary height for text
widths[i] <- strwidth(labels[i], cex = cex[i]) # determine necessary width for text
}
# make adj adjustements
leftSide <- xy[, 1] < 0
labelsBorders <- data.frame(
x0 = xy[, 1] - (widths * leftSide),
y0 = xy[, 2] - heights / 2,
x1 = xy[, 1] + (widths * !leftSide),
y1 = xy[, 2] + heights / 2
)
# extend borders for neater look
labelsBorders$x0 <- labelsBorders$x0 - x.ext
labelsBorders$y0 <- labelsBorders$y0 - y.ext
labelsBorders$x1 <- labelsBorders$x1 + x.ext
labelsBorders$y1 <- labelsBorders$y1 + y.ext
labelsBorders
}
#' Detect if two rectangles overlap.
#'
#' The overlap is assessed in x AND y.
#'
#' @param a vector with four coordinates `c(x0,y0,x1,y1)`.
#' @param b vector with four coordinates `c(x0,y0,x1,y1)`.
#' @return `logical`. TRUE if rectangles overlap.
#'
#' @keywords internal
#' @export
#'
#' @examples \dontrun{
#' # overlap in x and y
#' a <- c(0, 0, 2, 2)
#' b <- c(1, 1, 4, 3)
#' plot(c(a, b), c(a, b), type = "n")
#' rect(a[1], a[2], a[3], a[4])
#' rect(b[1], b[2], b[3], b[4])
#' doRectanglesOverlap(a, b)
#'
#' # b contained in a vertically
#' a <- c(5, 0, 20, 20)
#' b <- c(0, 5, 15, 15)
#' plot(c(a, b), c(a, b), type = "n")
#' rect(a[1], a[2], a[3], a[4])
#' rect(b[1], b[2], b[3], b[4])
#' doRectanglesOverlap(a, b)
#'
#' # overlap only in y
#' a <- c(0, 0, 2, 2)
#' b <- c(2.1, 1, 4, 3)
#' plot(c(a, b), c(a, b), type = "n")
#' rect(a[1], a[2], a[3], a[4])
#' rect(b[1], b[2], b[3], b[4])
#' doRectanglesOverlap(a, b)
#' }
#'
doRectanglesOverlap <- function(a, b, margin = 0) {
overlap1D <- function(a0, a1, b0, b1) { # overlap if one of four conditions is satisfied
(a0 <= b1 & b1 <= a1) | # b overlaps at bottom
(a0 <= b0 & b0 <= a1) | # b overlaps at top
(a0 >= b0 & a1 <= b1) | # b overlaps at bottom and top
(a0 <= b0 & a1 >= b1) # b contained within a
}
overlap.x <- overlap1D(a[1], a[3], b[1], b[3]) # overlap in x ?
overlap.y <- overlap1D(a[2], a[4], b[2], b[4]) # overlap in y ?
as.logical(overlap.x & overlap.y) # overlap in x and y, strip off vector names ?
}
# calculate angle between vector and x-y plane
# a vector
# n plane normal vector
degreesBetweenVectorAndPlane <- function(a, n) {
rad <- asin(abs(n %*% a) /
(sum(n^2)^.5 * sum(a^2)^.5))
rad * 180 / pi # convert from radians to degrees
}
#' A graphically unsophisticated version of a biplot.
#'
#' It will draw elements and constructs vectors using similar
#' arguments as [biplot2d()]. It is a version for quick
#' exploration used during development.
#'
#' @param x `repgrid` object.
#' @param dim Dimensions (i.e. principal components) to be used for biplot
#' (default is `c(1,2)`).
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' The default is `1` (row centering).
#' @param normalize A numeric value indicating along what direction (rows, columns)
#' to normalize by standard deviations. `0 = none, 1= rows, 2 = columns`
#' (default is `0`).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param col.active Columns (elements) that are no supplementary points, i.e. they are used
#' in the SVD to find principal components. default is to use all elements.
#' @param col.passive Columns (elements) that are supplementary points, i.e. they are NOT used
#' in the SVD but projected into the component space afterwards. They do not
#' determine the solution. Default is `NA`, i.e. no elements are set
#' supplementary.
#' @param unity Scale elements and constructs coordinates to unit scale in 2D (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param zoom Scaling factor for all vectors. Can be used to zoom
#' the plot in and out (default `1`).
#' @param scale.e Scaling factor for element vectors. Will cause element points to move a bit more
#' to the center. This argument is for visual appeal only.
#' @param e.point.col Color of the element symbols (default is `"black"`.
#' @param e.point.cex Size of the element symbol (default is `1`.
#' @param e.label.col Color of the element labels (default is `"black"`.
#' @param e.label.cex Size of the element labels (default is `.7`.
#' @param c.point.col Color of the construct lines (default is `grey(.6)`.
#' @param c.label.col Color of the construct labels (default is `grey(.6)`.
#' @param c.label.cex Size of the construct labels (default is `.6`.
#' @param ... Parameters to be passed on to `center()` and `normalize`.
#' @return `repgrid` object.
#' @export
#' @seealso Unsophisticated biplot: [biplotSimple()]; \cr
#' 2D biplots:
#' [biplot2d()],
#' [biplotEsa2d()],
#' [biplotSlater2d()];\cr
#' Pseudo 3D biplots:
#' [biplotPseudo3d()],
#' [biplotEsaPseudo3d()],
#' [biplotSlaterPseudo3d()];\cr
#' Interactive 3D biplots:
#' [biplot3d()],
#' [biplotEsa3d()],
#' [biplotSlater3d()];\cr
#' Function to set view in 3D:
#' [home()].
#'
#' @examples \dontrun{
#'
#' biplotSimple(boeker)
#' biplotSimple(boeker, unity = F)
#'
#' biplotSimple(boeker, g = 1, h = 1) # INGRID biplot
#' biplotSimple(boeker, g = 1, h = 1, center = 4) # ESA biplot
#'
#' biplotSimple(boeker, zoom = .9) # zooming out
#' biplotSimple(boeker, scale.e = .6) # scale element vectors
#'
#' biplotSimple(boeker, e.point.col = "brown") # change colors
#' biplotSimple(boeker,
#' e.point.col = "brown",
#' c.label.col = "darkblue"
#' )
#' }
#'
biplotSimple <- function(x, dim = 1:2, center = 1, normalize = 0,
g = 0, h = 1 - g, unity = T,
col.active = NA,
col.passive = NA,
scale.e = .9, zoom = 1,
e.point.col = "black",
e.point.cex = 1,
e.label.col = "black",
e.label.cex = .7,
c.point.col = grey(.6),
c.label.col = grey(.6),
c.label.cex = .6,
...) {
par(mar = c(1, 1, 1, 1))
d1 <- dim[1]
d2 <- dim[2]
x <- calcBiplotCoords(x,
g = g, h = h, center = center,
normalize = normalize,
col.active = col.active,
col.passive = col.passive, ...
)
cnames <- constructs(x)
E <- x@calcs$biplot$el
C <- x@calcs$biplot$con
X <- x@calcs$biplot$X
max.e <- max(abs(E[, dim]))
max.c <- max(abs(C[, dim]))
mv <- max(max.e, max.c)
if (unity) {
max.e <- max(apply(E[, dim[1:2]]^2, 1, sum)^.5) # maximal length of element vectors
max.c <- max(apply(C[, dim[1:2]]^2, 1, sum)^.5) # maximal length of construct vectors
se <- 1 / max.e * scale.e # scale to unity to make E and C same size
sc <- 1 / max.c
} else {
se <- 1
sc <- 1
}
Cu <- C * sc
Eu <- E * se
mv <- max(abs(rbind(Cu, Eu)))
Cu <- Cu * zoom
Eu <- Eu * zoom
# make biplot
plot(0,
xlim = c(-mv, mv), ylim = c(-mv, mv), type = "n", asp = 1,
xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i"
)
abline(v = 0, h = 0, col = "grey")
# plot constructs and labels
arrows(0, 0, -Cu[, d1], -Cu[, d2],
length = .05,
col = c.point.col, lty = 1
) # plot left poles
text(-Cu[, d1], -Cu[, d2], cnames[, 1],
pos = 1,
cex = c.label.cex, col = c.label.col
)
arrows(0, 0, Cu[, d1], Cu[, d2],
length = .05,
col = c.point.col, lty = 3
) # plot right poles
text(Cu[, d1], Cu[, d2], cnames[, 2],
pos = 1,
cex = c.label.cex, col = c.label.col
)
# plot elements and labels
points(Eu[, dim], pch = 15, col = e.point.col, cex = e.point.cex) # plot elements
text(Eu[, dim],
labels = rownames(Eu), cex = e.label.cex,
col = e.label.col, pos = 2
) # label elements
invisible(x)
}
# library(xtable)
# x <- biplotSimple(raeithel, dim=1:2, g=1, h=1, col.act=c(1,2,3,5,10,12))
# ssq.table <- ssq(x)
# #ssq.table[ssq.table < 10] <- NA
# res <- xtable(round(ssq.table, 1), digits=1,
# align=c("l", rep("r", ncol(ssq.table))), caption="Percentage of element's SSQ explained")
# print(res, table.placement="H", hline.after=c(-1,0,nrow(ssq.table)-1, nrow(ssq.table)))
#' Prepare dataframe passed to drawing functions for biplots.
#'
#' Data frame contains the variables `type, show, x, y,
#' z, labels, color, cex`.
#'
#' @param x `repgrid` object.
#' @param dim Dimensions to be used for biplot (default is `c(1,2)`).
#' @param map.dim Third dimension used to map aesthetic attributes (depth)
#' (default is `3`).
#' @param e.point.col Color(s) of the element symbols. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all elements
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param e.point.cex Size of the element symbols. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.4, .8)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all elements
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param e.label.col Color(s) of the element labels. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all element labels
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param e.label.cex Size of the element labels. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.4, .8)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all element labels
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param e.color.map Value range to determine what range of the color ramp defined in
#' `e.color` will be used for mapping the colors.
#' Default is `c(.4, ,1)`. Usually not important for the user.
#' @param c.point.col Color(s) of the construct symbols. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "darkred")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all elements
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param c.point.cex Size of the construct symbols. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.4, .8)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all elements
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param c.label.col Color(s) of the construct labels. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all construct labels
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param c.label.cex Size of the construct labels. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.4, .8)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all construct labels
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param c.color.map Value range to determine what range of the color ramp defined in
#' `c.color` will be used for mapping. Default is `c(.4, ,1)`.
#' Usually not important for the user.
#' @param devangle The deviation angle from the x-y plane in degrees. These can only be calculated
#' if a third dimension `map.dim` is specified. Only the constructs
#' vectors that do not depart
#' more than the specified degrees from the shown x-y plane will be printed.
#' This facilitates the visual interpretation, as only vectors represented in
#' the current plane are shown. Set the value to `91` (default)
#' to show all vectors.
#' @param unity Scale elements and constructs coordinates to unit scale in 2D (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param unity3d Scale elements and constructs coordinates to unit scale in 3D (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param scale.e Scaling factor for element vectors. Will cause element points to move a bit more
#' to the center. This argument is for visual appeal only.
#' @param ... Not evaluated.
#'
#' @return `dataframe` containing the variables `type, show, x, y,
#' z, labels, color, cex`. Usually not of interest to the user.
#' @note TODO: How to omit `map.dim`?
#' @keywords internal
#' @export
#'
prepareBiplotData <- function(x, dim = c(1, 2), map.dim = 3,
# e.color=c("white", "black"),
# c.color=c("white", "darkred"),
e.label.cex = .8,
c.label.cex = .6,
e.label.col = "black",
c.label.col = grey(.8),
e.point.cex = .7,
c.point.cex = .8,
e.point.col = "black",
c.point.col = "darkred",
# e.cex.map=c(.6, .8),
# c.cex.map=c(.6, .8),
e.color.map = c(.4, 1),
c.color.map = c(.4, 1),
c.points.devangle = 90,
c.labels.devangle = 90,
c.points.show = TRUE,
c.labels.show = TRUE,
e.points.show = TRUE,
e.labels.show = TRUE,
unity = TRUE,
unity3d = FALSE,
scale.e = .9,
...) {
dim <- c(dim, map.dim)
# make vector of length two if only one color/cex is specified
# if (length(e.color) == 1) # element color
# e.color <- rep(e.color, 2)
# if (length(c.color) == 1) # construct color
# c.color <- rep(c.color, 2)
# if (length(e.cex.map) == 1) # element cex for pseudo 3d dimension
# e.cex.map <- rep(e.cex.map, 2)
# if (length(c.cex.map) == 1) # construct cex for pseudo 3d dimension
# c.cex.map <- rep(c.cex.map, 2)
if (length(e.label.col) == 1) { # label color(s) for elements
e.label.col <- rep(e.label.col, 2)
}
if (length(c.label.col) == 1) { # label color(s) for constructs
c.label.col <- rep(c.label.col, 2)
}
if (length(e.point.col) == 1) { # point color(s) for elements
e.point.col <- rep(e.point.col, 2)
}
if (length(c.point.col) == 1) { # point color(s) for constructs
c.point.col <- rep(c.point.col, 2)
}
if (length(e.label.cex) == 1) { # label cex(s) for elements
e.label.cex <- rep(e.label.cex, 2)
}
if (length(c.label.cex) == 1) { # label cex(s) for constructs
c.label.cex <- rep(c.label.cex, 2)
}
if (length(e.point.cex) == 1) { # point cex(s) for elements
e.point.cex <- rep(e.point.cex, 2)
}
if (length(c.point.cex) == 1) { # point cex(s) for constructs
c.point.cex <- rep(c.point.cex, 2)
}
if (length(e.color.map) == 1) { # element color for pseudo 3d dimension
e.color.map <- rep(e.color.map, 2)
}
if (length(c.color.map) == 1) { # construct color for pseudo 3d dimension
c.color.map <- rep(c.color.map, 2)
}
# construct data frame containing all information needed for different plotting functions
# (e.g. rgl and biplot functions)
labels.e <- elements(x)
labels.cl <- constructs(x)[, 1]
labels.cr <- constructs(x)[, 2]
labels.all <- c(labels.e, labels.cr, labels.cl) # join all labels
type <- factor(c(
rep("e", getNoOfElements(x)), # make factor specifying if row is element or construct
rep(c("cl", "cr"), each = getNoOfConstructs(x))
))
df <- data.frame(type = type, label = labels.all, stringsAsFactors = FALSE)
df$cex <- .7 # default cex
df$showpoint <- T # default value for show point
df$showlabel <- T # default value for show label
df$color <- grey(0) # default color
df$label.col <- "darkgreen" # default label color
df$point.col <- "purple" # default point color
df$label.cex <- .7 # default label size
df$point.cex <- .7 # default point size
# calculate and add coordinates
# x <- calcBiplotCoords(x, ...)
E <- x@calcs$biplot$el
C <- x@calcs$biplot$con
X <- x@calcs$biplot$X
# scale to unity to make E and C same size.
# Two types of unity, for 2D and 3D
if (unity) {
max.e <- max(apply(E[, dim[1:2]]^2, 1, sum)^.5) # maximal length of element vectors
max.c <- max(apply(C[, dim[1:2]]^2, 1, sum)^.5) # maximal length of construct vectors
se <- 1 / max.e * scale.e # scale to unity to make E and C same size
sc <- 1 / max.c
}
if (unity3d) {
# max.e <- max(abs(E[ ,dim[1:3]]), na.rm=T)
# max.c <- max(abs(C[ ,dim[1:3]]), na.rm=T)
max.e <- max(apply(E[, dim[1:3]]^2, 1, sum)^.5) # maximal length of element vectors
max.c <- max(apply(C[, dim[1:3]]^2, 1, sum)^.5) # maximal length of construct vectors
se <- 1 / max.e * scale.e # scale to unity to make E and C same size
sc <- 1 / max.c
}
if (!unity & !unity3d) {
se <- 1
sc <- 1
}
Cu <- C * sc
Eu <- E * se
coords <- rbind(Eu[, dim], Cu[, dim], -Cu[, dim])
colnames(coords) <- c("x", "y", "z")
rownames(coords) <- NULL # otherwise warning in cbind occurs
df <- cbind(df, coords) # , check.rows=F)
if (is.na(dim[3])) { # if no 3rd dimension in specified, all values are set to zero i.e. neutral
df$z <- 0
}
# plot coords for all points
z <- subset(df, type == "e", sel = z) # z scores for elements
# cex.e <- mapCoordinatesToValue(z, e.cex.map)
cex.label.e <- mapCoordinatesToValue(z, e.label.cex)
cex.point.e <- mapCoordinatesToValue(z, e.point.cex)
# color.e <- mapCoordinatesToColor(z, color=e.color, val.range=e.color.map)
color.label.e <- mapCoordinatesToColor(z, colors = e.label.col, val.range = e.color.map)
color.point.e <- mapCoordinatesToColor(z, colors = e.point.col, val.range = e.color.map)
z <- subset(df, type == "cl", sel = z)
# cex.cl <- mapCoordinatesToValue(z, c.cex.map)
cex.label.cl <- mapCoordinatesToValue(z, c.label.cex)
cex.point.cl <- mapCoordinatesToValue(z, c.point.cex)
# color.cl <- mapCoordinatesToColor(z, color=c.color, val.range=c.color.map)
color.label.cl <- mapCoordinatesToColor(z, colors = c.label.col, val.range = c.color.map)
color.point.cl <- mapCoordinatesToColor(z, colors = c.point.col, val.range = c.color.map)
z <- subset(df, type == "cr", sel = z)
# cex.cr <- mapCoordinatesToValue(z, c.cex.map)
cex.label.cr <- mapCoordinatesToValue(z, c.label.cex)
cex.point.cr <- mapCoordinatesToValue(z, c.point.cex)
# color.cr <- mapCoordinatesToColor(z, color=c.color, val.range=c.color.map)
color.label.cr <- mapCoordinatesToColor(z, colors = c.label.col, val.range = c.color.map)
color.point.cr <- mapCoordinatesToColor(z, colors = c.point.col, val.range = c.color.map)
# df$cex <- unlist(rbind(cex.e, cex.cl, cex.cr))
# df$color <- c(color.e, color.cl, color.cr)
df$label.col <- c(color.label.e, color.label.cl, color.label.cr)
df$point.col <- c(color.point.e, color.point.cl, color.point.cr)
df$label.cex <- unlist(c(cex.label.e, cex.label.cl, cex.label.cr))
df$point.cex <- unlist(c(cex.point.e, cex.point.cl, cex.point.cr))
df$devangle <- apply(df, 1, function(x) {
a <- as.numeric(c(x["x"], x["y"], x["z"]))
n <- c(0, 0, 1) # normal vector for x-y plane
degreesBetweenVectorAndPlane(a = a, n = n)
})
# calculate absolute deviation angle from shown plane. If it is bigger than given values
# the constructs will not be shown on the side and/or the construct points will
# not be printed. If values >=90 all strokes and points are shown.
cs <- subset(df, type %in% c("cl", "cr"))
draw <- abs(cs$devangle) <= c.labels.devangle # which angles are smaller or equal than the maximal allowed ones?
cs$showlabel <- cs$showlabel & draw # show only labels that are requested and within allowed angle range
draw <- abs(cs$devangle) <= c.points.devangle # which angles are smaller or equal than the maximal allowed ones?
cs$showpoint <- cs$showpoint & draw # show only labels that are requested and within allowed angle range
df[df$type %in% c("cl", "cr"), ] <- cs # show only labels that are requested and within allowed angle range
# elements #
# select which element labels to show
# numerical values for element selection are converted to logical
seq.e <- seq_len(getNoOfElements(x))
if (!(identical(e.labels.show, T) | identical(e.labels.show, F) | all(is.numeric(e.labels.show)))) {
stop("'e.labels.show' must either be a logical value or a numeric vector")
}
if (all(is.numeric(e.labels.show))) {
e.labels.show <- seq.e %in% seq.e[e.labels.show]
}
df[df$type == "e", "showlabel"] <- e.labels.show # replace showlabel column for elements
# select which element points to show
# numerical values for element selection are converted to logical
if (!(identical(e.points.show, T) | identical(e.points.show, F) | all(is.numeric(e.points.show)))) {
stop("'e.points.show' must either be a logical value or a numeric vector")
}
if (all(is.numeric(e.points.show))) {
e.points.show <- seq.e %in% seq.e[e.points.show]
}
df[df$type == "e", "showpoint"] <- e.points.show # replace showpoint column for elements
# constructs # TODO: mechanism fill fail for single / double mode grids
# select which construct labels to show (independently from devangle)
# numerical values for construct selection are converted to logical
seq.c <- seq_len(getNoOfConstructs(x)) # TODO for single mode grids
if (!(identical(c.labels.show, T) | identical(c.labels.show, F) | all(is.numeric(c.labels.show)))) {
stop("'c.labels.show' must either be a logical value or a numeric vector")
}
if (all(is.numeric(c.labels.show))) {
doubleadd <- c.labels.show + sign(c.labels.show[1]) * getNoOfConstructs(x) # if double mode
c.labels.show <- seq.c %in% seq.c[c(c.labels.show, doubleadd)]
}
show.tmp <- df[df$type %in% c("cl", "cr"), "showlabel"]
df[df$type %in% c("cl", "cr"), "showlabel"] <- c.labels.show & show.tmp # replace showlabel column for elements
# select which construct points to show (independently from devangle)
# numerical values for construct selection are converted to logical
if (!(identical(c.points.show, T) | identical(c.points.show, F) | all(is.numeric(c.points.show)))) {
stop("'c.points.show' must either be a logical value or a numeric vector")
}
if (all(is.numeric(c.points.show))) {
c.points.show <- seq.c %in% seq.c[c.points.show]
}
points.tmp <- df[df$type %in% c("cl", "cr"), "showpoint"]
df[df$type %in% c("cl", "cr"), "showpoint"] <- c.points.show & points.tmp # replace showpoint column for elements
# list(rg=x, df=df)
x@calcs$biplot$e.unity <- Eu
x@calcs$biplot$c.unity <- Cu
x@plotdata <- df
x
}
#' biplotDraw is the workhorse doing the drawing of a 2D biplot.
#'
#' When the number of elements and constructs differs to a large extent, the
#' absolute values of the coordinates for either constructs or elements
#' will be much smaller or greater. This is an inherent property of the biplot.
#' In the case it is not necessary to be able to read off the original
#' data entries from the plot, the axes for elements and constructs
#' can be scaled separately. The proportional projection values will
#' stay unaffected. the absolute will change though. For grid interpretation
#' the absolute values are usually oh no importance. Thus, there is an optional
#' argument `normalize` which is `FALSE` as a default which
#' rescales the axes so the longest construct and element vector will be
#' set to the length of `1`.
#'
#' @param x `repgrid` object.
#' @param inner.positioning Logical. Whether to calculate positions to minimize overplotting of
#' elements and construct labels (default is`TRUE`). Note that
#' the positioning may slow down the plotting.
#' @param outer.positioning Logical. Whether to calculate positions to minimize overplotting of
#' of construct labels on the outer borders (default is`TRUE`). Note that
#' the positioning may slow down the plotting.
#' @param c.labels.inside Logical. Whether to print construct labels next to the points.
#' Can be useful during inspection of the plot (default `FALSE`).
#' @param flipaxes Logical vector of length two. Whether x and y axes are reversed
#' (default is `c(F,F)`).
#' @param strokes.x Length of outer strokes in x direction in NDC.
#' @param strokes.y Length of outer strokes in y direction in NDC.
#' @param offsetting Do offsetting? (TODO)
#' @param offset.labels Offsetting parameter for labels (TODO).
#' @param offset.e offsetting parameter for elements (TODO).
#' @param axis.ext Axis extension factor (default is `.1`). A bigger value will
#' zoom out the plot.
#' @param mai Margins available for plotting the labels in inch
#' (default is `c(.2, 1.5, .2, 1.5)`).
#' @param rect.margins Vector of length two (default is `c(.07, .07)`). Two values
#' specifying the additional horizontal and vertical margin around each
#' label.
#' @param srt Angle to rotate construct label text. Only used in case `offsetting=FALSE`.
#' @param cex.pos Cex parameter used during positioning of labels if prompted. Does
#' usually not have to be changed by user.
#' @param xpd Logical (default is `TRUE`). Whether to extend text labels
#' over figure region. Usually not needed by the user.
#' @param c.lines Logical. Whether construct lines from the center of the biplot
#' to the surrounding box are drawn (default is `FALSE`).
#' @param col.c.lines The color of the construct lines from the center to the borders
#' of the plot (default is `gray(.9)`).
#' @param zoom Scaling factor for all vectors. Can be used to zoom
#' the plot in and out (default `1`).
#' @param ... Not evaluated.
#' @return Invisible return of dataframe used during construction of plot
#' (useful for developers).
#' @export
#' @keywords internal
#'
biplotDraw <- function(x,
inner.positioning = TRUE,
outer.positioning = TRUE,
c.labels.inside = F,
flipaxes = c(F, F),
strokes.x = .1, strokes.y = .1,
offsetting = TRUE, offset.labels = .0, offset.e = 1,
axis.ext = .1, mai = c(.2, 1.5, .2, 1.5),
rect.margins = c(.01, .01),
srt = 45,
cex.pos = .7,
xpd = TRUE,
c.lines = TRUE, ### new
col.c.lines = grey(.9),
zoom = 1,
...) {
y <- showpoint <- showlabel <- type <- NULL # to prevent 'R CMD check' from noting a missing binding
# as the variables are provided in object x as default
x <- x@plotdata # df = data frame containing the information for printing
max.all <- max(abs(x$x), abs(x$y))
axis.ext <- 1 + axis.ext
max.ext <- max.all * axis.ext
x$x <- x$x * zoom # zoom data
x$y <- x$y * zoom # zoom data
# if (! draw.c)
# x$labels[x$type %in% c("cl", "cr")] <- " "
labels.constructs <- x$labels[x$type %in% c("cl", "cr")]
labels.all <- x$labels
if (flipaxes[1]) {
x$x <- x$x * -1
}
if (flipaxes[2]) {
x$y <- x$y * -1
}
# build plot
old.par <- par(no.readonly = TRUE) # save parameters
# on.exit(par(old.par)) # reset old par when done
par(mai = mai)
plot.new()
plot.window(
xlim = c(-max.ext, max.ext),
ylim = c(-max.ext, max.ext),
xaxs = "i", yaxs = "i", asp = 1
)
# add center lines and outer rectangle
segments(-max.ext, 0, max.ext, 0, col = "lightgrey")
segments(0, -max.ext, 0, max.ext, col = "lightgrey")
rect(-max.ext, -max.ext, max.ext, max.ext)
# make standard concentration ellipse # TODO, scaling of ellipse
# sing <- diag(esa$sing)[dim] / sum(diag(esa$sing))
# ellipse(sing[1], sing[2], col="lightgrey")
# initial coords for labels for strokes
str.3 <- calcCoordsBorders(x["x"], x["y"],
xmax = max.ext * (1 + strokes.x + offset.labels), # + rect.margins[1]/2),
ymax = max.ext * (1 + strokes.y + offset.labels)
) # + rect.margins[2]/2))
colnames(str.3) <- c("str.3.x", "str.3.y")
x <- cbind(x, str.3)
# segments(0,0,x$str.3.x, x$str.3.y) # debug
# calc coordinates for surrounding rectangles (elements and constructs)
lb <- calcRectanglesCoordsForLabels(x[, c("str.3.x", "str.3.y")], x$label,
cex = x$label.cex, x.ext = rect.margins[1], y.ext = rect.margins[2]
)
colnames(lb) <- c("str.3.x0", "str.3.y0", "str.3.x1", "str.3.y1")
x <- cbind(x, lb)
# segments(x$str.3.x0, x$str.3.y0, x$str.3.x1, x$str.3.y1) # debug
# offset labels in y direction if too close together
# for labels on the left and on the right separately
x$angle <- atan2(x$y, x$x) # caveat: first y, then y argument!
x <- x[order(x$angle), ] # sort by angles
# assign quandrants for offsetting
x$quadrant[x$angle >= 0 & x$angle < pi / 2] <- "ur" #
x$quadrant[x$angle >= pi / 2 & x$angle <= pi] <- "ul" #
x$quadrant[x$angle < 0 & x$angle >= -pi / 2] <- "lr" #
x$quadrant[x$angle < -pi / 2 & x$angle >= -pi] <- "ll" #
# calc necessary offset (only correct in case there is overlap!)
necessaryOffset <- function(a, b, direction = 1, margin = .05) {
if (direction >= 0) { # offset upwards
offset <- a[4] - b[2] # is always positive >= 0
if (offset < 0) { # if smaller than zero there should be no overlap anyway
offset <- 0
}
} else { # offset downwards
offset <- a[2] - b[4] # should always be <= 0
if (offset > 0) { # if bigger than zero there is no overlap
offset <- 0
}
}
as.numeric(offset + margin * sign(direction))
}
# offset quadrants
# lr <- subset(x.sorted, type %in% c("cr", "cl") & quadrant=="lr")
# ol <- lr[, c("str.3.x0", "str.3.y0", "str.3.x1", "str.3.y1")]
# order.lines <- 1:nrow(ol)
# order.lines <- rev(order.lines)
# lim <- c(min(ol), max(ol))
# plot(0, type="n", xlim=lim, ylim=lim)
# rect(ol[,1], ol[,2], ol[,3], ol[,4])
# text(ol[,1], ol[,2], order.lines)
offsetQuadrant <- function(x, quadrant = "ur", direction = 1,
reverse = T, margin = 0.02) {
index <- x$type %in% c("cr", "cl") & x$quadrant == quadrant # get constructs of quandrant
ol <- x[index, ]
vars <- c("str.3.x0", "str.3.y0", "str.3.x1", "str.3.y1")
order.lines <- 1:nrow(ol)
if (reverse) {
order.lines <- rev(order.lines)
}
for (i in order.lines) {
for (i.n in order.lines) {
if (i != i.n) {
overlap <- doRectanglesOverlap(ol[i, vars], ol[i.n, vars])
if (overlap) { # if overlap is present the rectangles is moved to avoid overlap
offset <- necessaryOffset(ol[i, vars], ol[i.n, vars], dir = direction, margin = margin)
ol[i.n, c("str.3.y", "str.3.y0", "str.3.y1")] <-
ol[i.n, c("str.3.y", "str.3.y0", "str.3.y1")] + offset
}
}
}
}
x[index, c("str.3.y", vars)] <- ol[, c("str.3.y", vars)]
x
}
# code is slow!
if (outer.positioning) {
x <- offsetQuadrant(x, quadrant = "ur", direction = 1, reverse = F) # dir.ur <- 1; reverse <- F
x <- offsetQuadrant(x, quadrant = "ul", direction = 1, reverse = T) # dir.ul <- 1; reverse <- T
x <- offsetQuadrant(x, quadrant = "ll", direction = -1, reverse = F) # dir.ll <- -1; reverse <- F
x <- offsetQuadrant(x, quadrant = "lr", direction = -1, reverse = T) # dir.lr <- -1; reverse <- T
}
#
# for (i in order.lines){
# #cat("---\n")
# for (i.n in order.lines){
# if(i != i.n){
# overlap <- doRectanglesOverlap(ol[i, ], ol[i.n, ])
# #cat("(", i, i.n, ")", "\t\t"); print(overlap)
# if (overlap){ # if overlap is present the rectangles is moved to avoid overlap
# offset <- necessaryOffset(ol[i, ], ol[i.n, ], dir=-1, margin=0.02)
# #print(offset)
# ol[i.n, c("str.3.y0","str.3.y1")] <-
# ol[i.n, c("str.3.y0","str.3.y1")] + offset
# }
# }
# }
# }
# lim <- c(min(ol), max(ol))
# rect(ol[,1], ol[,2], ol[,3], ol[,4], border="blue", lty=2)
# text(ol[,3], ol[,2], order.lines, col="blue" )
#
#
# plot(0:5)
# rect(ol[4,1],ol[4,2],ol[4,3],ol[4,4])
# rect(ol[3,1],ol[3,2],ol[3,3],ol[3,4])
# doRectanglesOverlap(ol[4,], ol[3,])
# do others overlap? If yes move them
# make outer strokes for all labels (elements and constructs)
# select which to draw later
# coordinates for stroke starts
str.1 <- calcCoordsBorders(x["x"], x["y"], xmax = max.ext, ymax = max.ext)
colnames(str.1) <- c("str.1.x", "str.1.y")
# coordinates for stroke ends
str.2 <- calcCoordsBorders(x["x"], x["y"],
xmax = max.ext * (1 + strokes.x),
ymax = max.ext * (1 + strokes.y)
)
colnames(str.2) <- c("str.2.x", "str.2.y")
x <- cbind(x, str.1, str.2)
# redo coordinates for stroke ends according to edges of rectangles that have been offsetted
a <- list()
for (i in seq_len(nrow(x))) {
a[[i]] <- calcCoordsBorders(x[i, "x"], x[i, "y"],
xmax = max.ext * (1 + strokes.x),
ymax = abs(x[i, "str.3.y"])
)
}
str.4 <- do.call(rbind, a)
colnames(str.4) <- c("str.4.x", "str.4.y")
x <- cbind(x, str.4)
if (!c.labels.inside) { # when constructs labels are prompted to be outside the plot(default)
# rotate labels srt degress on top and bottom for quick printing
y.max.ext <- max.ext * (1 + strokes.y + offset.labels) # position of outer strokes to determine side of labels
x$rotate <- 0 # default is no rotation of labels in text
if (!outer.positioning) { # only for positioning = FALSE to get neater label directions
x$rotate[x$str.3.y == y.max.ext | # replace by standadrd rotation angle
x$str.3.y == -y.max.ext] <- srt
}
# only make labels, rectangles and strokes that are prompted
cl <- subset(x, type %in% c("cl", "cr") & showlabel == T) # select only labels that should be shown
segments(cl$str.1.x, cl$str.1.y, cl$str.2.x, cl$str.2.y, xpd = T)
segments(cl$str.2.x, cl$str.2.y, cl$str.4.x, cl$str.4.y, xpd = T, lty = 3)
rect(cl$str.3.x0, cl$str.3.y0,
cl$str.3.x1, cl$str.3.y1,
col = grey(1), border = grey(1), xpd = T
)
# print constructs labels (if there are any) and not only inner labels are prompted
if (nrow(cl) > 0) {
for (i in 1:nrow(cl)) {
if (cl$str.3.x[i] < 0) {
adj <- c(1, .5)
} else {
adj <- c(0, .5)
}
if (!outer.positioning) { # overwrite adj in case of no positioning
if (cl$str.3.y[i] == y.max.ext) {
adj <- c(0, .5)
}
if (cl$str.3.y[i] == -y.max.ext) {
adj <- c(1, .5)
}
}
text(cl$str.3.x[i], cl$str.3.y[i],
labels = cl$label[i], col = cl$label.col[i],
cex = cl$label.cex[i], adj = adj, xpd = T, srt = cl$rotate[i]
)
}
}
}
### plotting of elements and constructs inside plot ###
# make construct lines if prompted
if (c.lines) {
cli <- subset(x, type %in% c("cl", "cr") & showlabel == T) # select only labels that should be shown
segments(0, 0, cli$str.1.x, cli$str.1.y, col = col.c.lines) # lines form biplot center to outsides
}
# make construct symbols
cs <- subset(x, type %in% c("cl", "cr") & showpoint == T & abs(x) < max.ext & abs(y) < max.ext)
points(cs[c("x", "y")], col = cs$point.col, pch = 4, cex = cs$point.cex, xpd = xpd)
# make element symbols
es <- subset(x, type == "e" & showpoint == T & abs(x) < max.ext & abs(y) < max.ext)
points(es[c("x", "y")], col = es$point.col, pch = 15, cex = es$point.cex, xpd = xpd)
# positioning of element and constructs labels inside the plot
if (inner.positioning) { # positioning by landmark algorithm from maptools package
# dirty hack as I do not understand the problem why some values become NA:
# replace NAs in showlabel and showpoint. Endas grid #10 produces this
x$showlabel[is.na(x$showlabel)] <- TRUE
x$showpoint[is.na(x$showpoint)] <- TRUE
sh <- subset(x, showlabel == T & showpoint == T) # &
lpos <- pointLabel(sh[c("x", "y")], labels = sh$label, doPlot = FALSE, cex = cex.pos) # package maptools
x$x.pos <- NA
x$y.pos <- NA
sh$x.pos <- lpos$x
sh$y.pos <- lpos$y
x[x$showlabel == T & x$showpoint == T, ] <- sh
} else { # simple offsetting in y direction
x$x.pos <- x$x
x$y.pos <- NA
offset.y.pos <- strheight("aaaa", cex = .7) # string height for dummy string
x[x$type == "e", ]$y.pos <- x[x$type == "e", ]$y + offset.y.pos * offset.e # offset element labels by normal stringheight times x
x[x$type %in% c("cl", "cr"), ]$y.pos <- x[x$type %in% c("cl", "cr"), ]$y - .05
}
# text labels for elements
# es <- subset(x, type=="e" & showlabel==T & showpoint==T) # old version
es <- subset(x, type == "e" & showlabel == T & showpoint == T &
abs(x) < max.ext & abs(y) < max.ext) # avoid plotting outside plot region
if (dim(es)[1] > 0) {
text(es[, c("x.pos", "y.pos")],
labels = es$label, col = es$label.col, pch = 15, cex = es$label.cex, xpd = xpd
)
}
# text labels for constructs inside plot
if (c.labels.inside) {
cs <- subset(x, type %in% c("cl", "cr") & showlabel == T &
abs(x) < max.ext & abs(y) < max.ext)
if (dim(cs)[1] > 0) {
text(cs[, c("x.pos", "y.pos")],
labels = cs$label, col = cs$label.col, pch = 4, cex = cs$label.cex, xpd = xpd
)
}
}
invisible(x) # returns plotdata frame
}
# x <- calcBiplotCoords(raeithel, g=1, h=1)
# x <- prepareBiplotData(x)
# biplotDraw(x)) # add amount explained variance to the axes
#' Adds the percentage of the sum-of-squares explained by each axis to the plot.
#'
#' @param x `repgrid` object containing the biplot coords, i.e. after
#' having called [calcBiplotCoords()] and
#' [prepareBiplotData()].
#' @param dim The dimensions to be printed.
#' @param var.show Show explained sum-of-squares in biplot? (default `TRUE`).
#' @param var.cex The cex value for the percentages shown in the plot.
#' @param var.col The color value of the percentages shown in the plot.
#' @param axis.ext Axis extension factor (default is `.1`). A bigger value will
#' zoom out the plot.
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' The default is `1` (row centering).
#' @param normalize A numeric value indicating along what direction (rows, columns)
#' to normalize by standard deviations. `0 = none, 1= rows, 2 = columns`
#' (default is `0`).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param col.active Columns (elements) that are no supplementary points, i.e. they are used
#' in the SVD to find principal components. default is to use all elements.
#' @param col.passive Columns (elements) that are supplementary points, i.e. they are NOT used
#' in the SVD but projected into the component space afterwards. They do not
#' determine the solution. Default is `NA`, i.e. no elements are set
#' supplementary.
#' @param ... Not evaluated.
#' @keywords internal
#' @export
#'
addVarianceExplainedToBiplot2d <- function(x, dim = c(1, 2, 3), var.cex = .7,
var.show = TRUE, var.col = grey(.1),
axis.ext = .1,
center = 1, normalize = 0,
g = 0, h = 1 - g,
col.active = NA,
col.passive = NA,
...) {
# do only if prompted
if (var.show) {
# determine way to calculate SSQ proportions.
# Different if passive columns are used.
if (is.na(col.active[1]) & is.na(col.passive[1])) {
standard.calc.ssq <- TRUE
} else {
standard.calc.ssq <- FALSE
}
if (standard.calc.ssq) {
# one valid way of calculating the prop SSQ not taking into account passive columns
sv <- x@calcs$biplot$D # get singular values from SVD
sv.exp <- sv^2 / sum(sv^2) # proportion of ssq explained per principal component
var <- paste("Dim ", dim[1:2], ": ", round(sv.exp[dim[1:2]] * 100, 1), "%", sep = "")
} else {
# calculating explained variance when passive columns are used
ssq.out <- ssq(x,
along = 2, cum = F, g = g, h = h,
center = center, normalize = normalize,
col.active = col.active,
col.passive = col.passive, print = F, ...
)
ssq.prop.dim <- ssq.out[dim(ssq.out)[1], dim]
var <- paste("Dim ", dim[1:2], ": ",
round(ssq.prop.dim[dim[1:2]], 1), "%",
sep = ""
)
}
data <- x@plotdata # data frame from data prepare function return
max.all <- max(abs(data$x), abs(data$y))
axis.ext <- 1 + axis.ext
max.ext <- max.all * axis.ext
ext <- strheight(var[1], cex = var.cex)
text(max.ext - ext / 2, 0, var[1], cex = var.cex, adj = c(.5, 0), col = var.col, srt = 90)
text(0, -max.ext + ext / 2, var[2], cex = var.cex, adj = c(.5, 0), col = var.col)
}
}
# x <- randomGrid(20, 40)
# x <- boeker
# x <- raeithel
# xb <- prepareBiplotData(x, c.labels.show=F, c.points.dev=90, e.points=1:3, e.labels=T)
# biplotDraw(xb, xpd=F, inner=F, outer=F)
# addVarianceExplainedToBiplot(xb$rg, xb$df)
#
# xb <- prepareBiplotData(x, c.points.dev=5, c.labels.dev=5)
# biplotDraw(xb, xpd=F, inner=F, outer=T, mai=rep(0,4), c.labels.inside=T)
# biplotDraw(xb, xpd=F, inner=F, outer=T)
#
# dev.new()
# xb <- prepareBiplotData(x, dim=c(1,2), map=4)
# biplotDraw(xb, dev=15)
# addVarianceExplainedToBiplot(x, xb, dim=c(1,2,4))
#
#
# dev.new()
# xb <- prepareBiplotData(x, dim=c(2,3), map=1)
# biplotDraw(xb, dev=15)
# addVarianceExplainedToBiplot(x, xb, dim=c(2,3,1))
#
# dev.new()
# xb <- prepareBiplotData(x, dim=c(3,4), map=1)
# biplotDraw(xb, dev=15)
# addVarianceExplainedToBiplot(x, xb, dim=c(3,4,1))
# x <- boeker
# x <- prepareBiplotData(x, e.col="black", c.col="black", cex.e=.7, cex.c=.7)#, color.e=.8, color.c=.8)
# biplotDraw(x)
# addVarianceExplainedToBiplot(boeker, x)
#
# x <- boeker
# x <- prepareBiplotData(x, e.col="black", c.col="black", cex.e=.7, cex.c=.7,
# color.e=.3, color.c=.5)
# biplotDraw(x)
# addVarianceExplainedToBiplot(boeker, x)
#
# x <- boeker
# x <- prepareBiplotData(x, e.col="black", c.col="black", cex.e=c(.3,1))
# x <- prepareBiplotData(x, e.col="black", c.col="black", cex.e=c(.3,1), cex.c=c(.3,1))
# x <- prepareBiplotData(x, cex.e=c(.5,1.3), cex.c=c(.5,1.3))
# x <- prepareBiplotData(x, cex.e=c(.5,1), cex.c=c(.5,1), color.c.map=c(0, 0))
# biplotDraw2(x)
#
# x <- boeker
# x <- raeithel
#
# layout(matrix(1:4, by=T, ncol=2))
#
# xb <- prepareBiplotData(x, dim=c(1,2), map=3)
# biplotDraw(xb)
# addVarianceExplainedToBiplot(x, xb, dim=1:3)
#
# xb <- prepareBiplotData(x, dim=c(2,3), map=1)
# biplotDraw(xb)
# addVarianceExplainedToBiplot(x, xb, dim=c(2,3,1))
#
# xb <- prepareBiplotData(x, dim=c(3,4), map=1)
# biplotDraw(xb)
# addVarianceExplainedToBiplot(x, xb, dim=c(3,4,1))
#
# xb <- prepareBiplotData(x, dim=c(1,4), map=2)
# biplotDraw(xb)
# addVarianceExplainedToBiplot(x, xb, dim=c(1,4,2))
#' Draw a two-dimensional biplot.
#'
#' The biplot is the central way to create a joint plot of elements and constructs. Depending on the parameters chosen
#' it contains information on the distances between elements and constructs. Also the relative values the elements have
#' on a construct can be read off by projection the element onto the construct vector. A lot of parameters can be
#' changed rendering different types of biplots (ESA, Slater's) and different looks (colors, text size). See the
#' example section below to get started.
#'
#' For the construction of a biplot the grid matrix is first centered and normalized according to the prompted options.
#'
#' Next, the matrix is decomposed by singular value decomposition (SVD)
#' into \deqn{X = UDV^T}{X = UDV^T}
#' The biplot is made up of two matrices
#' \deqn{X = GH^T}{X = GH^T}
#' These matrices are construed on the basis of the SVD results.
#' \deqn{\hat{X} = UD^gD^hV^T}{X = UD^gD^hV^T}
#' Note that the grid matrix values are only recovered and
#' the projection property is only given if \eqn{g + h = 1}{g + h = 1}
#'
#'
#' @param x `repgrid` object.
#' @param dim Dimensions (i.e. principal components) to be used for biplot
#' (default is `c(1,2)`).
#' @param map.dim Third dimension (depth) used to map aesthetic attributes to
#' (default is `3`).
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' The default is `1` (row centering).
#' @param normalize A numeric value indicating along what direction (rows, columns)
#' to normalize by standard deviations. `0 = none, 1= rows, 2 = columns`
#' (default is `0`).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param col.active Columns (elements) that are no supplementary points, i.e. they are used
#' in the SVD to find principal components. default is to use all elements.
#' @param col.passive Columns (elements) that are supplementary points, i.e. they are NOT used
#' in the SVD but projected into the component space afterwards. They do not
#' determine the solution. Default is `NA`, i.e. no elements are set
#' supplementary.
#' @param e.point.col Color of the element symbols. The default is `"black"`.
#' Two values can be entered that will create a color ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color color value is supplied (e.g. `"black"`)
#' no mapping occurs and all elements will have the same color
#' irrespective of their value on the `map.dim` dimension.
#' @param e.point.cex Size of the element symbols. The default is `.9`.
#' Two values can be entered that will create a size ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color size value is supplied (e.g. `.8`)
#' no mapping occurs and all elements will have the same size
#' irrespective of their value on the `map.dim` dimension.
#' @param e.label.col Color of the element label. The default is `"black"`.
#' Two values can be entered that will create a color ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color color value is supplied (e.g. `"black"`)
#' no mapping occurs and all labels will have the same color
#' irrespective of their value on the `map.dim` dimension.
#' @param e.label.cex Size of the element labels. The default is `.7`.
#' Two values can be entered that will create a size ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color size value is supplied (e.g. `.7`)
#' no mapping occurs and all labels will have the same size
#' irrespective of their value on the `map.dim` dimension.
#' @param e.color.map Value range to determine what range of the color ramp defined in
#' `e.color` will be used for mapping the colors.
#' Default is `c(.4, ,1)`. Usually not important for the user.
#' @param c.point.col Color of the construct symbols. The default is `"black"`.
#' Two values can be entered that will create a color ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color color value is supplied (e.g. `"black"`)
#' no mapping occurs and all construct will have the same color
#' irrespective of their value on the `map.dim` dimension.
#' @param c.point.cex Size of the construct symbols. The default is `.8`.
#' Two values can be entered that will create a size ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color size value is supplied (e.g. `.8`)
#' no mapping occurs and all construct will have the same size
#' irrespective of their value on the `map.dim` dimension.
#' @param c.label.col Color of the construct label. The default is `"black"`.
#' Two values can be entered that will create a color ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color color value is supplied (e.g. `"black"`)
#' no mapping occurs and all labels will have the same color
#' irrespective of their value on the `map.dim` dimension.
#' @param c.label.cex Size of the construct labels. The default is `.7`.
#' Two values can be entered that will create a size ramp. The values of
#' `map.dim` are mapped onto the ramp.
#' If only one color size value is supplied (e.g. `.7`)
#' no mapping occurs and all labels will have the same size
#' irrespective of their value on the `map.dim` dimension.
#' @param c.color.map Value range to determine what range of the color ramp defined in
#' `c.color` will be used for mapping. Default is `c(.4, ,1)`.
#' Usually not important for the user.
#' @param c.points.devangle The deviation angle from the x-y plane in degrees. These can only be calculated
#' if a third dimension `map.dim` is specified. Only the constructs
#' that do not depart more than the specified degrees from the
#' x-y plane will be printed. This facilitates the visual
#' interpretation, as only vectors represented near the current plane
#' are shown. Set the value to `91` (default)
#' to show all vectors.
#' @param c.labels.devangle The deviation angle from the x-y plane in degrees. These can only be calculated
#' if a third dimension `map.dim` is specified. Only the labels of constructs
#' that do not depart more than the specified degrees from the
#' x-y plane will be printed. Set the value to `91` (default)
#' to show all construct labels.
#' @param c.points.show Whether the constructs are printed (default is `TRUE`).
#' `FALSE` will suppress the printing of the constructs.
#' To only print certain constructs a numeric vector can be
#' provided (e.g. `c(1:10)`).
#' @param c.labels.show Whether the construct labels are printed (default is `TRUE`).
#' `FALSE` will suppress the printing of the labels.
#' To only print certain construct labels a numeric vector can be
#' provided (e.g. `c(1:10)`).
#' @param e.points.show Whether the elements are printed (default is `TRUE`).
#' `FALSE` will suppress the printing of the elements.
#' To only print certain elements a numeric vector can be
#' provided (e.g. `c(1:10)`).
#' @param e.labels.show Whether the element labels are printed (default is `TRUE`).
#' `FALSE` will suppress the printing of the labels.
#' To only print certain element labels a numeric vector can be
#' provided (e.g. `c(1:10)`).
#' @param inner.positioning Logical. Whether to calculate positions to minimize overplotting of
#' elements and construct labels (default is`TRUE`). Note that
#' the positioning may slow down the plotting.
#' @param outer.positioning Logical. Whether to calculate positions to minimize overplotting of
#' of construct labels on the outer borders (default is`TRUE`). Note that
#' the positioning may slow down the plotting.
#' @param c.labels.inside Logical. Whether to print construct labels next to the points.
#' Can be useful during inspection of the plot (default `FALSE`).
#' @param c.lines Logical. Whether construct lines from the center of the biplot
#' to the surrounding box are drawn (default is `FALSE`).
#' @param col.c.lines The color of the construct lines from the center to the borders
#' of the plot (default is `gray(.9)`).
#' @param flipaxes Logical vector of length two. Whether x and y axes are reversed
#' (default is `c(F,F)`).
#' @param strokes.x Length of outer strokes in x direction in NDC.
#' @param strokes.y Length of outer strokes in y direction in NDC.
#' @param offsetting Do offsetting? (TODO)
#' @param offset.labels Offsetting parameter for labels (TODO).
#' @param offset.e offsetting parameter for elements (TODO).
#' @param axis.ext Axis extension factor (default is `.1`). A bigger value will
#' zoom out the plot.
#' @param mai Margins available for plotting the labels in inch
#' (default is `c(.2, 1.5, .2, 1.5)`).
#' @param rect.margins Vector of length two (default is `c(.07, .07)`). Two values
#' specifying the additional horizontal and vertical margin around each
#' label.
#' @param srt Angle to rotate construct label text. Only used in case `offsetting=FALSE`.
#' @param cex.pos Cex parameter used during positioning of labels if prompted. Does
#' usually not have to be changed by user.
#' @param xpd Logical (default is `TRUE`). Whether to extend text labels
#' over figure region. Usually not needed by the user.
#' @param unity Scale elements and constructs coordinates to unit scale in 2D (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param unity3d Scale elements and constructs coordinates to unit scale in 3D (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param scale.e Scaling factor for element vectors. Will cause element points to move a bit more
#' to the center. (but only if `unity` or `unity3d` is `TRUE`).
#' This argument is for visual appeal only.
#' @param zoom Scaling factor for all vectors. Can be used to zoom
#' the plot in and out (default `1`).
#' @param var.show Show explained sum-of-squares in biplot? (default `TRUE`).
#' @param var.cex The cex value for the percentages shown in the plot.
#' @param var.col The color value of the percentages shown in the plot.
#' @param ... parameters passed on to come.
#' @export
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#'
#' biplot2d(boeker) # biplot of boeker data
#' biplot2d(boeker, c.lines = T) # add construct lines
#' biplot2d(boeker, center = 2) # with column centering
#' biplot2d(boeker, center = 4) # midpoint centering
#' biplot2d(boeker, normalize = 1) # normalization of constructs
#'
#' biplot2d(boeker, dim = 2:3) # plot 2nd and 3rd dimension
#' biplot2d(boeker, dim = c(1, 4)) # plot 1st and 4th dimension
#'
#' biplot2d(boeker, g = 1, h = 1) # assign singular values to con. & elem.
#' biplot2d(boeker, g = 1, h = 1, center = 1) # row centering (Slater)
#' biplot2d(boeker, g = 1, h = 1, center = 4) # midpoint centering (ESA)
#'
#' biplot2d(boeker, e.color = "red", c.color = "blue") # change colors
#' biplot2d(boeker, c.color = c("white", "darkred")) # mapped onto color range
#'
#' biplot2d(boeker, unity = T) # scale con. & elem. to equal length
#' biplot2d(boeker, unity = T, scale.e = .5) # scaling factor for element vectors
#'
#' biplot2d(boeker, e.labels.show = F) # do not show element labels
#' biplot2d(boeker, e.labels.show = c(1, 2, 4)) # show labels for elements 1, 2 and 4
#' biplot2d(boeker, e.points.show = c(1, 2, 4)) # only show elements 1, 2 and 4
#' biplot2d(boeker, c.labels.show = c(1:4)) # show constructs labels 1 to 4
#' biplot2d(boeker, c.labels.show = c(1:4)) # show constructs labels except 1 to 4
#'
#' biplot2d(boeker, e.cex.map = 1) # change size of texts for elements
#' biplot2d(boeker, c.cex.map = 1) # change size of texts for constructs
#'
#' biplot2d(boeker, g = 1, h = 1, c.labels.inside = T) # constructs inside the plot
#' biplot2d(boeker,
#' g = 1, h = 1, c.labels.inside = T, # different margins and elem. color
#' mai = c(0, 0, 0, 0), e.color = "red"
#' )
#'
#' biplot2d(boeker, strokes.x = .3, strokes.y = .05) # change length of strokes
#'
#' biplot2d(boeker, flipaxes = c(T, F)) # flip x axis
#' biplot2d(boeker, flipaxes = c(T, T)) # flip x and y axis
#'
#' biplot2d(boeker, outer.positioning = F) # no positioning of con.-labels
#'
#' biplot2d(boeker, c.labels.devangle = 20) # only con. within 20 degree angle
#' }
#'
biplot2d <- function(x, dim = c(1, 2), map.dim = 3,
center = 1,
normalize = 0,
g = 0,
h = 1 - g,
col.active = NA,
col.passive = NA,
# e.color="black",
# c.color="black",
e.point.col = "black",
e.point.cex = .9,
e.label.col = "black",
e.label.cex = .7,
e.color.map = c(.4, 1),
c.point.col = "black",
c.point.cex = 0, # construct positions are not displayed by default
c.label.col = "black",
c.label.cex = .7,
c.color.map = c(.4, 1),
# e.cex.map=.7,
# c.cex.map=.7,
c.points.devangle = 91,
c.labels.devangle = 91,
c.points.show = TRUE,
c.labels.show = TRUE,
e.points.show = TRUE,
e.labels.show = TRUE,
inner.positioning = TRUE,
outer.positioning = TRUE,
c.labels.inside = FALSE,
c.lines = TRUE,
col.c.lines = grey(.9),
flipaxes = c(FALSE, FALSE),
strokes.x = .1, strokes.y = .1,
offsetting = TRUE, offset.labels = .0, offset.e = 1,
axis.ext = .1, mai = c(.2, 1.5, .2, 1.5),
rect.margins = c(.01, .01),
srt = 45,
cex.pos = .7,
xpd = TRUE,
unity = FALSE,
unity3d = FALSE,
scale.e = .9,
zoom = 1,
var.show = TRUE,
var.cex = .7,
var.col = grey(.1),
...) {
x <- calcBiplotCoords(x,
center = center, normalize = normalize,
g = g, h = h,
col.active = col.active, col.passive = col.passive, ...
)
x <- prepareBiplotData(x,
dim = dim, map.dim = map.dim,
e.label.cex = e.label.cex, c.label.cex = c.label.cex,
e.label.col = e.label.col, c.label.col = c.label.col,
e.point.cex = e.point.cex, c.point.cex = c.point.cex,
e.point.col = e.point.col, c.point.col = c.point.col,
# e.color=e.color, c.color=c.color,
# e.cex.map=e.cex.map, c.cex.map=c.cex.map,
e.color.map = e.color.map, c.color.map = c.color.map,
c.points.devangle = c.points.devangle,
c.labels.devangle = c.labels.devangle, c.points.show = c.points.show,
c.labels.show = c.labels.show,
e.points.show = e.points.show,
e.labels.show = e.labels.show,
unity = unity, unity3d = unity3d, scale.e = scale.e, ...
)
biplotDraw(x,
inner.positioning = inner.positioning, outer.positioning = outer.positioning,
c.labels.inside = c.labels.inside,
c.lines = c.lines, col.c.lines = col.c.lines, flipaxes = flipaxes,
strokes.x = strokes.x, strokes.y = strokes.y,
offsetting = offsetting, offset.labels = offset.labels, offset.e = offset.e,
axis.ext = axis.ext, mai = mai, rect.margins = rect.margins,
srt = srt, cex.pos = cex.pos, xpd = xpd, zoom = zoom
)
addVarianceExplainedToBiplot2d(x,
dim = dim, center = center, normalize = normalize,
g = g, h = h, col.active = col.active,
col.passive = col.passive, var.show = var.show,
var.cex = var.cex, var.col = var.col, ...
)
invisible(NULL)
}
#' Draws a biplot of the grid in 2D with depth impression (pseudo 3D).
#'
#' This version is basically a 2D biplot.
#' It only modifies color and size of the symbols in order to create a 3D impression
#' of the data points.
#' This function will call the standard [biplot2d()] function with some
#' modified arguments. For the whole set of arguments that can be used
#' see [biplot2d()]. Here only the arguments special to
#' `biplotPseudo3d` are outlined.
#'
#' @param x `repgrid` object.
#' @param dim Dimensions (i.e. principal components) to be used for biplot
#' (default is `c(1,2)`).
#' @param map.dim Third dimension (depth) used to map aesthetic attributes to
#' (default is `3`).
#' @param e.point.col Color(s) of the element symbols. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all elements
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param e.point.cex Size of the element symbols. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.6, 1.2)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all elements
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param e.label.col Color(s) of the element labels. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all element labels
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param e.label.cex Size of the element labels. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.6, .8)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all element labels
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param e.color.map Value range to determine what range of the color ramp defined in
#' `e.color` will be used for mapping the colors.
#' Default is `c(.4, ,1)`. Usually not important for the user.
#' @param c.point.col Color(s) of the construct symbols. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "darkred")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all elements
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param c.point.cex Size of the construct symbols. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.6, 1.2)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all elements
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param c.label.col Color(s) of the construct labels. Two values can be entered that will
#' create a color ramp. The values of `map.dim` are mapped onto the ramp.
#' The default is `c("white", "black")`. If only one color color value
#' is supplied (e.g. `"black"`) no mapping occurs and all construct labels
#' will have the same color irrespective of their value on the `map.dim`
#' dimension.
#' @param c.label.cex Size of the construct labels. Two values can be entered that will
#' represents the lower and upper size of a range of cex the values of `map.dim`
#' are mapped onto. The default is `c(.6, .9)`. If only one cex value
#' is supplied (e.g. `.7`) no mapping occurs and all construct labels
#' will have the same size irrespective of their value on the `map.dim`
#' dimension.
#' @param c.color.map Value range to determine what range of the color ramp defined in
#' `c.color` will be used for mapping. Default is `c(.4, ,1)`.
#' Usually not important for the user.
#' @param ... Additional parameters passed to [biplot2d()].
#'
#' @export
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#' # biplot with 3D impression
#' biplotPseudo3d(boeker)
#' # Slater's biplot with 3D impression
#' biplotPseudo3d(boeker, g = 1, h = 1, center = 1)
#'
#' # show 2nd and 3rd dim. and map 4th
#' biplotPseudo3d(boeker, dim = 2:3, map.dim = 4)
#'
#' # change elem. colors
#' biplotPseudo3d(boeker, e.color = c("white", "darkgreen"))
#' # change con. colors
#' biplotPseudo3d(boeker, c.color = c("white", "darkgreen"))
#' # change color mapping range
#' biplotPseudo3d(boeker, c.colors.map = c(0, 1))
#'
#' # set uniform con. text size
#' biplotPseudo3d(boeker, c.cex = 1)
#' # change text size mapping range
#' biplotPseudo3d(boeker, c.cex = c(.4, 1.2))
#' }
#'
biplotPseudo3d <- function(x, dim = 1:2, map.dim = 3,
e.point.col = c("white", "black"),
e.point.cex = c(.6, 1.2),
e.label.col = c("white", "black"),
e.label.cex = c(.6, .8),
e.color.map = c(.4, 1),
c.point.col = c("white", "darkred"),
c.point.cex = c(.6, 1.2),
c.label.col = c("white", "darkred"),
c.label.cex = c(.6, .8),
c.color.map = c(.4, 1),
...) {
biplot2d(
x = x, dim = dim, map.dim = map.dim,
e.point.col = e.point.col,
e.point.cex = e.point.cex,
e.label.col = e.label.col,
e.label.cex = e.label.cex,
e.color.map = e.color.map,
c.point.col = c.point.col,
c.point.cex = c.point.cex,
c.label.col = c.label.col,
c.label.cex = c.label.cex,
c.color.map = c.color.map,
...
)
}
#' Draws Slater's INGRID biplot in 2D.
#'
#' The default is to use row centering
#' and no normalization. Note that Slater's biplot is just a
#' special case of a biplot
#' that can be produced using the [biplot2d()] function with the arguments
#' `center=1, g=1, h=1`. The arguments that can be used in this function
#' are the same as in [biplot2d()].
#' Here, only the arguments that are set for Slater's biplot are described.
#' To see all the parameters that can be changed see [biplot2d()].
#'
#' @param x `repgrid` object.
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' Slater's biplot uses `1` (row centering).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param ... Additional parameters for be passed to [biplot2d()].
#' @export
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#' # See examples in [biplot2d()] as the same arguments
#' # can used for this function.
#' }
#'
biplotSlater2d <- function(x, center = 1, g = 1, h = 1, ...) {
biplot2d(x = x, center = center, g = g, h = h, ...)
}
#' Draws Slater's biplot in 2D with depth impression (pseudo 3D).
#'
#' The default is to use row centering
#' and no normalization. Note that Slater's biplot is just a special
#' case of a biplot that can be produced using the [biplotPseudo3d()]
#' function with the arguments `center=1, g=1, h=1`.
#' Here, only the arguments that are modified for Slater's biplot are described.
#' To see all the parameters that can be changed see [biplot2d()]
#' and [biplotPseudo3d()].
#'
#' @param x `repgrid` object.
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' Slater's biplot uses `1` (row centering).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements.
#' @param ... Additional parameters for be passed to [biplotPseudo3d()].
#' @export
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#' # See examples in [biplotPseudo3d()] as the same arguments
#' # can used for this function.
#' }
#'
biplotSlaterPseudo3d <- function(x, center = 1, g = 1, h = 1, ...) {
biplotPseudo3d(x = x, center = center, g = g, h = h, ...)
}
#' Plot an eigenstructure analysis (ESA) biplot in 2D.
#'
#' The ESA is a special type of biplot suggested by Raeithel (e.g. 1998).
#' It uses midpoint centering as a default. Note that the eigenstructure analysis
#' is just a special case of a biplot that can also be produced using the
#' [biplot2d()] function with the arguments
#' `center=4, g=1, h=1`.
#' Here, only the arguments that are modified for the ESA biplot are described.
#' To see all the parameters that can be changed see [biplot2d()].
#'
#' @param x `repgrid` object.
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' Eigenstructure analysis uses midpoint centering (`4`).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs. Eigenstructure analysis uses
#' `g=1`.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements. Eigenstructure analysis uses
#' `h=1`.
#' @param ... Additional parameters for be passed to [biplot2d()].
#'
#' @references Raeithel, A. (1998). Kooperative Modellproduktion von Professionellen
#' und Klienten. Erlaeutert am Beispiel des Repertory Grid.
#' In A. Raeithel (1998). Selbstorganisation, Kooperation,
#' Zeichenprozess. Arbeiten zu einer kulturwissenschaftlichen,
#' anwendungsbezogenen Psychologie (p. 209-254). Opladen:
#' Westdeutscher Verlag.
#' @export
#'
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#' # See examples in [biplot2d()] as the same arguments
#' # can used for this function.
#' }
#'
biplotEsa2d <- function(x, center = 4, g = 1, h = 1, ...) {
biplot2d(x = x, center = center, g = g, h = h, ...)
}
#' Plot an eigenstructure analysis (ESA) in 2D grid with 3D
#' impression (pseudo 3D).
#'
#' The ESA is
#' a special type of biplot suggested by Raeithel (e.g. 1998).
#' It uses midpoint centering as a default. Note that the eigenstructure analysis
#' is just a special case of a biplot that can also be produced using the
#' [biplot2d()] function with the arguments
#' `center=4, g=1, h=1`.
#' Here, only the arguments that are modified for the ESA biplot are described.
#' To see all the parameters that can be changed see [biplot2d()]
#' and [biplotPseudo3d()].
#'
#' @param x `repgrid` object.
#' @param center Numeric. The type of centering to be performed.
#' 0= no centering, 1= row mean centering (construct),
#' 2= column mean centering (elements), 3= double-centering
#' (construct and element means),
#' 4= midpoint centering of rows (constructs).
#' Eigenstructure analysis uses midpoint centering (`4`).
#' @param g Power of the singular value matrix assigned to the left singular
#' vectors, i.e. the constructs. Eigenstructure analysis uses
#' `g=1`.
#' @param h Power of the singular value matrix assigned to the right singular
#' vectors, i.e. the elements. Eigenstructure analysis uses
#' `h=1`.
#' @param ... Additional parameters for be passed to [biplotPseudo3d()].
#' @export
#' @seealso
#' - Unsophisticated biplot: [biplotSimple()];
#' - 2D biplots:[biplot2d()], [biplotEsa2d()], [biplotSlater2d()];
#' - Pseudo 3D biplots: [biplotPseudo3d()], [biplotEsaPseudo3d()], [biplotSlaterPseudo3d()];
#' - Interactive 3D biplots: [biplot3d()], [biplotEsa3d()], [biplotSlater3d()];
#' - Function to set view in 3D: [home()]
#'
#' @examples \dontrun{
#' # See examples in [biplotPseudo3d()] as the same arguments
#' # can used for this function.
#' }
#'
biplotEsaPseudo3d <- function(x, center = 4, g = 1, h = 1, ...) {
biplotPseudo3d(x = x, center = center, g = g, h = h, ...)
}
# //////////////////////////////////////////////////////////
# x <- boeker
# x <- calcBiplotCoords(x, g=1, h=1)
# x <- prepareBiplotData(x, unity=F)
# biplot2d(x)
#
# biplot2d(x)
# //////////////////////////////////////////////////////////
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.