Nothing
#' Draw standard axes in the origin in an rgl plot.
#'
#' @param max.dim maximum length of axis.
#' @param lwd line width.
#' @param a.cex cex for axis labels.
#' @param a.col axis color.
#' @param a.radius radius of spheres at the end points of the axes.
#' @param labels logical. whether to draw axis labels.
#' @param spheres logical. whether to draw axis spheres at the end points.
#' @param ... not evaluated.
#' @export
#' @keywords internal
rglDrawStandardAxes <- function(max.dim = 1, lwd = 1, a.cex = 1.1, a.col = "black",
a.radius = .05, labels = TRUE, spheres = FALSE, ...) {
rgl::lines3d(c(0, max.dim), c(0, 0), c(0, 0), lwd = lwd, col = a.col)
rgl::lines3d(c(0, 0), c(0, max.dim), c(0, 0), lwd = lwd, col = a.col)
rgl::lines3d(c(0, 0), c(0, 0), c(0, max.dim), lwd = lwd, col = a.col)
if (labels) {
rgl::text3d(max.dim, 0, 0, "X", cex = a.cex, adj = c(1, 1), col = a.col)
rgl::text3d(0, max.dim, 0, "Y", cex = a.cex, adj = c(1, 1), col = a.col)
rgl::text3d(0, 0, max.dim, "Z", cex = a.cex, adj = c(1, 1), col = a.col)
}
if (spheres) {
rgl::spheres3d(max.dim, 0, 0, radius = a.radius, col = a.col)
rgl::spheres3d(0, max.dim, 0, radius = a.radius, col = a.col)
rgl::spheres3d(0, 0, max.dim, radius = a.radius, col = a.col)
}
}
# open3d()
# points3d(rnorm(1000), rnorm(1000), rnorm(1000), color=heat.colors(1000))
# rglDrawStandardAxes(3)
#' Draw standard ellipses in the origin in an rgl plot.
#'
#' @param max.dim soon
#' @param lwd soon
#' @param col soon
#' @export
#' @keywords internal
#'
rglDrawStandardEllipses <- function(max.dim = 1, lwd = 1, col = "black") {
x <- seq(0, 2 * pi, len = 361)
x <- data.frame(sin(x), cos(x)) * max.dim
rgl::lines3d(x[, 1], x[, 2], 0, col = col, lwd = lwd)
rgl::lines3d(x[, 1], 0, x[, 2], col = col, lwd = lwd)
rgl::lines3d(0, x[, 1], x[, 2], col = col, lwd = lwd)
}
rglDrawElementPoints <- function(coords, dim = 1:3, e.radius = .1, e.sphere.col = "black", ...) {
if (!requireNamespace("rgl", quietly = TRUE)) {
stop("The 'rgl' package is required to use OpenRepGrid's 3D features => please install 'rgl'.", call. = FALSE)
}
coords <- coords[, dim]
rgl::spheres3d(coords[, 1], coords[, 2], coords[, 3],
radius = e.radius, color = e.sphere.col, aspect = F
)
}
rglDrawElementLabels <- function(coords, labels = FALSE, dim = 1:3, e.radius = .1, e.cex = .6, e.text.col = "black", ...) {
if (!requireNamespace("rgl", quietly = TRUE)) {
stop("The 'rgl' package is required to use OpenRepGrid's 3D features => please install 'rgl'.", call. = FALSE)
}
coords <- coords[, dim]
if (!identical(labels, FALSE)) {
coords.text <- coords - e.radius / 2 # offset text for elements
rgl::texts3d(
x = coords.text[, 1],
y = coords.text[, 2],
z = coords.text[, 3],
texts = labels, adj = c(1, 1), cex = e.cex, col = e.text.col, aspect = F
)
}
}
#' draw constructs in rgl
#'
#' @param coords coordinates for construct points.
#' @param dim dimensions of coordinates to use.
#' @param c.radius radius of construct spheres.
#' @param c.sphere.col color of construct spheres.
#' @param ... not evaluated.
#' @export
#' @keywords internal
#'
rglDrawConstructPoints <- function(coords, dim = 1:3, c.radius = .02, c.sphere.col = grey(.4),
...) {
if (!requireNamespace("rgl", quietly = TRUE)) {
stop("The 'rgl' package is required to use OpenRepGrid's 3D features => please install 'rgl'.", call. = FALSE)
}
coords <- coords[, dim]
coords[is.na(coords)] <- 0 # replace NAs by zero, so Na can be entered as dim for 2d projection
rgl::spheres3d(coords[, dim], radius = c.radius, color = c.sphere.col)
}
#' draw constructs in rgl
#'
#' @param coords coordinates for constructs labels.
#' @param labels labels for constructs.
#' @param dim dimensions of coordinates to use.
#' @param c.cex cex for construct text.
#' @param c.text.col color for construct text.
#' @param ... not evaluated.
#' @export
#' @keywords internal
#'
rglDrawConstructLabels <- function(coords, labels = FALSE, dim = 1:3,
c.cex = .6, c.text.col = grey(.4), ...) {
if (!requireNamespace("rgl", quietly = TRUE)) {
stop("The 'rgl' package is required to use OpenRepGrid's 3D features => please install 'rgl'.", call. = FALSE)
}
coords <- coords[, dim]
coords[is.na(coords)] <- 0 # replace NAs by zero, so Na can be entered as dim for 2d projection
if (!identical(labels, FALSE)) {
rgl::texts3d(coords,
texts = labels, adj = c(.5, .5),
cex = c.cex, col = c.text.col, aspect = F
)
}
}
# biplot3dBase2 is the workhorse to draw a grid in rgl (3D device).
#
# @param x `repgrid` object.
# @param dim Dimensions to display.
# @param labels.e Logical. whether element labels are displayed.
# @param labels.c Logical. whether construct labels are displayed.
# @param lines.c Numeric. The way lines are drawn through the construct vectors.
# `0 =` no lines, `1 =` lines from constructs to outer frame,
# `2 =` lines from the center to outer frame.
# @param lef Construct lines extension factor.
# @param alpha.sphere Numeric. alpha blending of the surrounding sphere (default`".05"`).
# @param col.sphere Color of surrounding sphere (default`"black"`).
# @param ext.sphere Extension factor for sphere
# @param col.frame Color of the surrounding frame.
# @param zoom Not yet used. Scaling factor for all vectors. Can be used to zoom
# the plot in and out (default `1`).
# @param draw.xyz.axes Draw standard XYZ axes.
# @param ... Parameters to be passed on.
# @keywords internal
# @export
#
biplot3dBase2 <- function(x, dim = 1:3, labels.e = TRUE, labels.c = TRUE, lines.c = 1,
lef = 1.1, frame = 1, col.frame = grey(.6),
col.sphere = "black", alpha.sphere = .05, zoom = 1,
draw.xyz.axes = TRUE,
# c.points.show=TRUE,
# c.labels.show=TRUE,
# e.points.show=TRUE,
# e.labels.show=TRUE,
...) {
if (!requireNamespace("rgl", quietly = TRUE)) {
stop("The 'rgl' package is required to use OpenRepGrid's 3D features => please install 'rgl'.", call. = FALSE)
}
x <- calcBiplotCoords(x, ...)
x <- prepareBiplotData(x, ...)
showpoint <- showlabel <- type <- NULL # to prevent 'R CMD check' from noting a missing binding
# as the variables are provided in object x as default
rgl::open3d() # open rgl device
rgl::par3d(params = list(
windowRect = c(100, 100, 600, 600)
)) # enlarge and position 3d device
rgl::view3d(theta = 0, phi = 0, zoom = .6) # change 3d view angle
rgl::bg3d(color = "white") # set background color
# select spheres to draw and labels to show
# select which elements to show
if (identical(labels.e, TRUE)) {
labels.e <- elements(x)
}
if (identical(labels.c, TRUE)) {
labels.l <- constructs(x)$leftpole
labels.r <- constructs(x)$rightpole
} else {
labels.r <- FALSE
labels.l <- FALSE
}
X <- x@calcs$biplot$X # pre-transformed (centered etc.) grid matrix
Eu <- x@calcs$biplot$e.unity # element coordinates scaled/unified
Cu <- x@calcs$biplot$c.unity # construct coordinates scaled/unified
pdat <- x@plotdata # plotdata prepared by prepareBiplotData()
mval <- max(abs(rbind(Eu[, dim], Cu[, dim])), # get maximum value of construct and element coordinates
na.rm = TRUE
)
# Eu <- Eu * zoom
# Cu <- Cu * zoom
# prolongation of construct vector to outer side
Cu.norm <- apply(Cu[, dim]^2, 1, sum, na.rm = TRUE)^.5
Cup <- Cu[, dim] / Cu.norm * (lef * mval)
# plot element spheres
es.p <- subset(pdat, type == "e" & showpoint == T)
rglDrawElementPoints(es.p[c("x", "y", "z")], e.radius = mval / 50, ...)
# labels for elements
es.l <- subset(pdat, type == "e" & showlabel == T & showpoint == T)
rglDrawElementLabels(es.l[c("x", "y", "z")], labels = es.l$label, e.radius = mval / 50, ...)
standardizeCoords <- function(x, dim = 1:3) {
x.norm <- apply(x[, dim]^2, 1, sum, na.rm = TRUE)^.5
xsc <- x[, dim] / x.norm * (lef * mval)
xsc
}
# make construct spheres
cs.p <- subset(pdat, type %in% c("cl", "cr") & showpoint == T)
cs.p.xyz <- cs.p[c("x", "y", "z")]
# labels for constructs
cs.l <- subset(pdat, type %in% c("cl", "cr") & showlabel == T)
cl.l.xyz <- cs.l[c("x", "y", "z")]
cl.l.xyz.outer <- standardizeCoords(cs.l[c("x", "y", "z")])
if (lines.c == 0) { # no construct lines labels at cons pos
rglDrawConstructLabels(cl.l.xyz, labels = cs.l$label, ...)
if (draw.xyz.axes) rglDrawStandardAxes(mval, spheres = F)
# rglDrawConstructLabels(Cu[, dim], labels=labels.r, ...)
# rglDrawConstructLabels(-Cu[, dim], labels=labels.l, ...)
} else if (lines.c == 1) { # construct lines from cons pos to outside
rgl::segments3d(interleave(cl.l.xyz, cl.l.xyz.outer), col = "grey")
rglDrawConstructLabels(cl.l.xyz.outer, labels = cs.l$label, ...)
if (draw.xyz.axes) rglDrawStandardAxes(lef * mval, a.col = "black")
# segments3d(interleave(-Cu[, dim], -Cup), col="grey") # Cu and Cup from older implementation without use if x@plotdata
# rglDrawConstructLabels(Cup, labels=labels.r, ...)
# rglDrawConstructLabels(-Cup, labels=labels.l, ...)
} else if (lines.c == 2) { # construct lines from center to outside
nm <- matrix(0, ncol = 3, nrow = nrow(cl.l.xyz.outer))
rgl::segments3d(interleave(nm, as.matrix(cl.l.xyz.outer)), col = "grey")
rglDrawConstructLabels(cl.l.xyz.outer, labels = cs.l$label, ...)
if (draw.xyz.axes) rglDrawStandardAxes(lef * mval, a.col = "black")
} else {
stop("'lines.c' can only take numeric values from 0 to 2")
}
rglDrawConstructPoints(cs.p.xyz, c.radius = mval / 200, ...)
# rglDrawConstructPoints(-Cu[, dim], c.radius=mval/200, ...)
# rglDrawStandardEllipses(max.dim)
# trick to make user coordinate system's origin the center of rotation
mval <- max(abs(rgl::par3d()$bbox)) # get max value in x,y,z
ps <- interleave(mval * diag(3), -mval * (diag(3)))
rgl::spheres3d(ps, radius = 0) # draw invisible spheres at the extremes
# select type of frame ariound the whole plot
# 0=none, 1= simple box, 2= box with grid, 3=sphere.
if (frame == 1) {
# make box around device
ss <- matrix(c(
mval, mval, mval, # top
-mval, mval, mval,
-mval, mval, mval,
-mval, -mval, mval,
-mval, -mval, mval,
mval, -mval, mval,
mval, -mval, mval,
mval, mval, mval,
mval, mval, -mval, # bottom
-mval, mval, -mval,
-mval, mval, -mval,
-mval, -mval, -mval,
-mval, -mval, -mval,
mval, -mval, -mval,
mval, -mval, -mval,
mval, mval, -mval,
mval, mval, mval, # sides
mval, mval, -mval,
-mval, mval, mval,
-mval, mval, -mval,
-mval, -mval, mval,
-mval, -mval, -mval,
mval, -mval, mval,
mval, -mval, -mval
), ncol = 3, byrow = T)
rgl::segments3d(ss, col = col.frame)
} else if (frame == 2) {
rgl::grid3d(c("x+", "x-", "y+", "y-", "z+", "z-"))
} else if (frame == 3) {
# sphere for easier 3D impression if prompted
rgl::spheres3d(0, 0, 0,
radius = mval, color = col.sphere,
alpha = alpha.sphere, aspect = F, front = "lines", back = "lines"
)
}
}
#' Draw grid in rgl (3D device).
#'
#' The 3D biplot opens an interactive
#' 3D device that can be rotated and zoomed using the mouse.
#' A 3D device facilitates the exploration of grid data as
#' significant proportions of the sum-of-squares are often
#' represented beyond the first two dimensions. Also, in a lot of
#' cases it may be of interest to explore the grid space from
#' a certain angle, e.g. to gain an optimal view onto the set
#' of elements under investigation (e.g. Raeithel, 1998).
#'
#' @param x `repgrid` object.
#' @param dim Dimensions to display.
#' @param labels.e Logical. whether element labels are displayed.
#' @param labels.c Logical. whether construct labels are displayed.
#' @param lines.c Numeric. The way lines are drawn through the construct vectors.
#' `0 =` no lines, `1 =` lines from constructs to outer frame,
#' `2 =` lines from the center to outer frame.
#' @param lef Construct lines extension factor
#'
#' @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).
#' 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 c.sphere.col Color of construct spheres.
#' @param c.cex Size of construct text.
#' @param c.text.col Color for construct text.
#'
#' @param e.sphere.col Color of elements.
#' @param e.cex Size of element labels.
#' @param e.text.col Color of element labels.
#'
#' @param alpha.sphere Numeric. alpha blending of the surrounding sphere (default`".05"`).
#' @param col.sphere Color of surrounding sphere (default`"black"`).
#'
#' @param unity Scale elements and constructs coordinates to unit scale (maximum of 1)
#' so they are printed more neatly (default `TRUE`).
#' @param unity3d To come.
#' @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 Not yet used. Scaling factor for all vectors. Can be used to zoom
#' the plot in and out (default `1`).
#' @param ... Parameters to be passed on.
#' @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()].
#'
#' @references Raeithel, A. (1998). Kooperative Modellproduktion von
#' Professionellen und Klienten - erlauetert am Beispiel des
#' Repertory Grid. *Selbstorganisation, Kooperation, Zeichenprozess:
#' Arbeiten zu einer kulturwissenschaftlichen, anwendungsbezogenen
#' Psychologie* (pp. 209-254). Opladen: Westdeutscher Verlag.
#'
#' @examples \dontrun{
#'
#' biplot3d(boeker)
#' biplot3d(boeker, unity3d = T)
#'
#' biplot3d(boeker,
#' e.sphere.col = "red",
#' c.text.col = "blue"
#' )
#' biplot3d(boeker, e.cex = 1)
#' biplot3d(boeker, col.sphere = "red")
#'
#' biplot3d(boeker, g = 1, h = 1) # INGRID biplot
#' biplot3d(boeker,
#' g = 1, h = 1, # ESA biplot
#' center = 4
#' )
#' }
#'
biplot3d <- function(x, dim = 1:3, labels.e = TRUE, labels.c = TRUE, lines.c = TRUE,
lef = 1.3, center = 1, normalize = 0, g = 0, h = 1, col.active = NA,
col.passive = NA,
c.sphere.col = grey(.4), c.cex = .6, c.text.col = grey(.4),
e.sphere.col = grey(0), e.cex = .6, e.text.col = grey(0),
alpha.sphere = .05, col.sphere = "black",
unity = FALSE,
unity3d = FALSE,
scale.e = .9, zoom = 1, ...) {
biplot3dBase2(
x = x, dim = dim, labels.e = labels.e, labels.c = labels.c, lines.c = lines.c,
lef = lef, center = center, normalize = normalize, g = g, h = h,
col.active = col.active, col.passive = col.passive,
c.sphere.col = c.sphere.col, c.cex = c.cex, c.text.col = c.text.col,
e.sphere.col = e.sphere.col, e.cex = e.cex, e.text.col = e.text.col,
alpha.sphere = alpha.sphere, col.sphere = col.sphere,
unity = unity, unity3d = unity3d, scale.e = scale.e, zoom = zoom, ...
)
}
#' Draw the Slater's INGRID biplot in rgl (3D device).
#'
#' The 3D biplot opens an interactive
#' 3D device that can be rotated and zoomed using the mouse.
#' A 3D device facilitates the exploration of grid data as
#' significant proportions of the sum-of-squares are often
#' represented beyond the first two dimensions. Also, in a lot of
#' cases it may be of interest to explore the grid space from
#' a certain angle, e.g. to gain an optimal view onto the set
#' of elements under investigation (e.g. Raeithel, 1998).
#' Note that Slater's biplot is just a special case of a biplot
#' that can be produced using the [biplot3d()]
#' function with the arguments `center=1, g=1, h=1`.
#'
#' @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).
#' Default is `1` (row i.e. construct 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 arguments to be passed to biplot3d.
#' @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{
#'
#' biplotSlater3d(boeker)
#' biplotSlater3d(boeker, unity3d = T)
#'
#' biplotSlater3d(boeker,
#' e.sphere.col = "red",
#' c.text.col = "blue"
#' )
#' biplotSlater3d(boeker, e.cex = 1)
#' biplotSlater3d(boeker, col.sphere = "red")
#' }
#'
biplotSlater3d <- function(x, center = 1, g = 1, h = 1, ...) {
biplot3d(x = x, center = center, g = g, h = h, ...)
}
#' Draw the eigenstructure analysis (ESA) biplot in rgl (3D device).
#'
#' The 3D biplot opens an interactive
#' 3D device that can be rotated and zoomed using the mouse.
#' A 3D device facilitates the exploration of grid data as
#' significant proportions of the sum-of-squares are often
#' represented beyond the first two dimensions. Also, in a lot of
#' cases it may be of interest to explore the grid space from
#' a certain angle, e.g. to gain an optimal view onto the set
#' of elements under investigation (e.g. Raeithel, 1998).
#' Note that the eigenstructure analysis just a special case
#' of a biplot that can also be produced using the
#' [biplot3d()] function with the arguments
#' `center=4, g=1, h=1`.
#'
#' @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).
#' Default is `4` (scale midpoint 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 arguments to be passed to [biplot3d()].
#' @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{
#'
#' biplotEsa3d(boeker)
#' biplotEsa3d(boeker, unity3d = T)
#'
#' biplotEsa3d(boeker,
#' e.sphere.col = "red",
#' c.text.col = "blue"
#' )
#' biplotEsa3d(boeker, e.cex = 1)
#' biplotEsa3d(boeker, col.sphere = "red")
#' }
#'
biplotEsa3d <- function(x, center = 1, g = 1, h = 1, ...) {
biplot3d(x = x, center = center, g = g, h = h, ...)
}
#' Rotate the interactive 3D device to default views.
#'
#' Rotate the interactive 3D device to a default viewpoint or
#' to a position defined by `theta` and `phi` in Euler angles.
#' Three default viewpoints are implemented rendering a view
#' so that two axes span a plane and the third axis is
#' pointing out of the screen.
#'
#' @param view Numeric. Specifying one of three default views.
#' 1 = XY, 2=XZ and 3=YZ-plane.
#' @param theta Numeric. Euler angle. Overrides view setting.
#' @param phi Numeric. Euler angle. Overrides view setting.
#'
#' return `NULL`.
#' @export
#' @seealso Interactive 3D biplots:
#' [biplot3d()],
#' [biplotSlater3d()],
#' [biplotEsa3d()].
#'
#' @examples \dontrun{
#'
#' biplot3d(boeker)
#' home(2)
#' home(3)
#' home(1)
#' home(theta = 45, phi = 45)
#' }
#'
home <- function(view = 1, theta = NULL, phi = NULL) {
if (!view %in% 1:3) {
stop("'view' must take a numeric value between 1 and 3")
}
p3d <- rgl::par3d()
if (is.null(theta) & is.null(phi)) {
if (view == 1) {
theta <- 0
phi <- 0
} else if (view == 2) {
theta <- 0
phi <- 90
} else if (view == 3) {
theta <- 90
phi <- 0
}
}
rgl::view3d(theta = theta, phi = phi, zoom = p3d$zoom) # change 3d view angle
}
# //////////////////////////////////////////////////////////////////////////////
### EXAMPLES ###
# //////////////////////////////////////////////////////////////////////////////
# biplot3d(raeithel, labels.c=F)
#
# x <- raeithel
# x <- calcBiplotCoords(x, g=0, h=1, midp=T, col.active=c(2,4,10))
# x <- prepareBiplotData(x, unity=T)
# biplot3d(x)
#
# M <- par3d("userMatrix") # get current position matrix
# dir <- "/Users/markheckmann/Documents/Magic Briefcase/DA openRepgrid/openrepgrid/basic/output/animation"
# M1 <- rotate3d(M, pi/2, 1, 0, 0)
# M2 <- rotate3d(M1, pi/2, 0, 0, 1)
# movie3d(par3dinterp( userMatrix=list(M, M1, M2, M1, M), method="linear"),
# duration=4, fps=20, convert=F, clean=F, dir=dir)
# open3d()
# lines3d(c(0, 1), c(0,0), c(0,0))
# lines3d(c(0,0), c(0, 1), c(0,0))
# lines3d(c(0,0), c(0,0), c(0, 1))
# mouseTrackballOrigin <- function(button = 1, dev = cur3d(), origin=c(0,0,0) ) {
# width <- height <- rotBase <- NULL
# userMatrix <- list()
# cur <- cur3d()
# offset <- NULL
# scale <- NULL
#
# screenToVector <- function(x, y) {
# radius <- max(width, height)/2
# centre <- c(width, height)/2
# pt <- (c(x, y) - centre)/radius
# len <- vlen(pt)
#
# if (len > 1.e-6) pt <- pt/len
#
# maxlen <- sqrt(2)
# angle <- (maxlen - len)/maxlen*pi/2
# z <- sin(angle)
# len <- sqrt(1 - z^2)
# pt <- pt * len
# return (c(pt, z))
# }
#
# trackballBegin <- function(x, y) {
# vp <- par3d("viewport")
# width <<- vp[3]
# height <<- vp[4]
# cur <<- cur3d()
# bbox <- par3d("bbox")
# center <- c(sum(bbox[1:2])/2, sum(bbox[3:4])/2, sum(bbox[5:6])/2)
# scale <<- par3d("scale")
# offset <<- (center - origin)*scale
# for (i in dev) {
# if (inherits(try(set3d(i, TRUE)), "try-error")) dev <<- dev[dev != i]
# else userMatrix[[i]] <<- par3d("userMatrix")
# }
# set3d(cur, TRUE)
# rotBase <<- screenToVector(x, height - y)
# }
#
# trackballUpdate <- function(x,y) {
# rotCurrent <- screenToVector(x, height - y)
# angle <- angle(rotBase, rotCurrent)
# axis <- xprod(rotBase, rotCurrent)
# mouseMatrix <- rotationMatrix(angle, axis[1], axis[2], axis[3])
# for (i in dev) {
# if (inherits(try(set3d(i, TRUE)), "try-error")) dev <<- dev[dev != i]
# else par3d(userMatrix = t(translationMatrix(-offset[1], -offset[2], -offset[3])) %*% mouseMatrix %*% t(translationMatrix(offset[1], offset[2], offset[3])) %*%userMatrix[[i]])
# }
# set3d(cur, TRUE)
# }
#
# for (i in dev) {
# set3d(i, TRUE)
# rgl.setMouseCallbacks(button, begin = trackballBegin, update = trackballUpdate, end = NULL)
# }
# set3d(cur, TRUE)
# }
# additioally load functions from demo(). see email from Duncan Murdoch 25.04.2011
# mouseTrackballOrigin()
# //////////////////////////////////////////////////////////////////////////////
# TODO: rotations of the biplot
#
# eulerxyz <- function(phi, theta, psi){
# phi <- phi*180/pi # conversion from degree to radians
# theta <- theta*180/pi
# psi <- psi*180/pi
#
# matrix(c(cos(theta)*cos(psi), -cos(phi)*sin(psi) + sin(phi)*sin(theta)*cos(psi), sin(phi)*sin(psi)+ cos(phi)*sin(theta)*cos(psi),
# cos(theta)*sin(psi), cos(phi)*cos(psi) + sin(phi)*sin(theta)*sin(psi), -sin(phi)*cos(psi) + cos(phi)*sin(theta)*sin(psi),
# -sin(theta) , sin(phi)*cos(theta) , cos(phi)*cos(theta)), ncol=3)
# }
#
# m <- par3d()$userMatrix[1:3, 1:3]
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.