feat: calibrated biplot axes and projection lines

NAMESPACE

@@ -39,9 +39,11 @@ export("preferredPoles<-")
 export("ratings<-")
 export("rightpoles<-")
 export(addAvgElement)
+export(addCalibratedAxesToBiplot2d)
 export(addConstruct)
 export(addElement)
 export(addIndexColumnToMatrix)
+export(addProjectionsToBiplot2d)
 export(addVarianceExplainedToBiplot2d)
 export(alignByIdeal)
 export(alignByLoadings)

NEWS.md

@@ -1,5 +1,10 @@
 # OpenRepGrid 0.1.19 (dev version)
 
+* `biplot2d`: New arg `calibrated` draws calibrated axes with tick marks showing original rating scale
+  values on construct axes. Supports `TRUE` (all constructs) or a numeric vector of construct indices.
+* `biplot2d`: New arg `projections` draws perpendicular projection lines from elements onto construct
+  axes. Supports `TRUE` (all) or numeric indices. `projections.e` selects which elements to project (#77)
+  `projections.col`, `projections.lty`, and `projections.lwd` accept per-element vectors for distinct styling.
 * `biplot2d`: Construct pole labels are automatically colorized by preference status (green = preferred,
   red = non-preferred, dark gray = neutral/undefined) when preferred poles are set in the repgrid object.
   New arg `c.color.preferred` controls the behavior (`NULL` = auto-detect, `TRUE` = always, `FALSE` = never) (#71).

R/repgrid-plots.r

@@ -655,6 +655,9 @@ prepareBiplotData <- function(x, dim = c(1, 2), map.dim = 3,
     se <- 1
     sc <- 1
   }
+  x@calcs$biplot$se <- se
+  x@calcs$biplot$sc <- sc
+
   Cu <- C * sc
   Eu <- E * se
 
@@ -1235,6 +1238,218 @@ addVarianceExplainedToBiplot2d <- function(x, dim = c(1, 2, 3), var.cex = .7,
   }
 }
 
+
+#' Add calibrated axes (tick marks with original scale values) to a 2D biplot.
+#'
+#' Calibrated axes allow reading off approximated original ratings by projecting
+#' element points onto construct axes. Each tick mark corresponds to a value on
+#' the original rating scale.
+#'
+#' @param x               `repgrid` object after [calcBiplotCoords()] and [prepareBiplotData()].
+#' @param dim             Dimensions displayed in the biplot (default `c(1, 2)`).
+#' @param center          Centering type used (must match the biplot calculation).
+#' @param normalize       Normalization type used.
+#' @param g               Power for left singular vectors.
+#' @param h               Power for right singular vectors.
+#' @param col.active      Active columns.
+#' @param col.passive     Passive columns.
+#' @param calibrated.tick.length  Length of tick marks in plot coordinates (default `0.02`).
+#' @param calibrated.cex  Text size for tick labels (default `0.6`).
+#' @param calibrated.col  Color for tick marks and labels (default `grey(0.4)`).
+#' @param ...             Not evaluated.
+#' @keywords internal
+#' @export
+#'
+addCalibratedAxesToBiplot2d <- function(x, dim = c(1, 2),
+                                        center = 1,
+                                        normalize = 0,
+                                        g = 0, h = 1 - g,
+                                        col.active = NA,
+                                        col.passive = NA,
+                                        calibrated = TRUE,
+                                        calibrated.tick.length = 0.02,
+                                        calibrated.cex = 0.6,
+                                        calibrated.col = grey(0.4),
+                                        ...) {
+  # get unscaled construct coords and element scaling factor
+  C <- x@calcs$biplot$con
+  se <- x@calcs$biplot$se
+  nc <- nrow(C)
+
+  # compute centering offsets per construct
+  dat <- x@ratings[, , 1]
+  if (center == 0) {
+    offsets <- rep(0, nc)
+  } else if (center == 1) {
+    offsets <- rowMeans(dat, na.rm = TRUE)
+  } else if (center == 2) {
+    offsets <- rep(0, nc)
+  } else if (center == 3) {
+    offsets <- rowMeans(dat, na.rm = TRUE)
+  } else if (center == 4) {
+    offsets <- rep(getScaleMidpoint(x), nc)
+  }
+
+  # scale values
+  v_min <- x@scale$min
+  v_max <- x@scale$max
+  values <- seq(v_min, v_max)
+
+  # determine which constructs to calibrate
+  # calibrated = TRUE: all visible constructs
+  # calibrated = numeric vector: only those construct indices
+  calibrate_idx <- if (isTRUE(calibrated)) seq_len(nc) else as.integer(calibrated)
+
+  # determine which constructs are visible from plotdata
+  pd <- x@plotdata
+  visible <- pd$type == "cr" & pd$showlabel == TRUE
+  # map plotdata row index back to construct index (cr rows are in order)
+  cr_rows <- which(pd$type == "cr")
+
+  # determine plot extent for clipping
+  max.all <- max(abs(pd$x), abs(pd$y))
+  max.ext <- max.all * 1.1
+
+  for (k in seq_along(cr_rows)) {
+    if (!visible[cr_rows[k]]) next
+    if (!(k %in% calibrate_idx)) next
+
+    i <- k # construct index
+    Ci <- C[i, dim[1:2]]
+    norm2 <- sum(Ci^2)
+    if (norm2 < 1e-10) next # skip degenerate constructs
+
+    # perpendicular unit vector for tick marks
+    perp <- c(-Ci[2], Ci[1]) / sqrt(norm2)
+
+    # axis angle for text rotation (perpendicular to axis)
+    axis_angle <- atan2(Ci[2], Ci[1]) * 180 / pi
+    label_srt <- axis_angle + 90
+    # keep angle in readable range
+    if (label_srt > 90) label_srt <- label_srt - 180
+    if (label_srt < -90) label_srt <- label_srt + 180
+
+    for (v in values) {
+      v_centered <- v - offsets[i]
+      tick_x <- se * v_centered * Ci[1] / norm2
+      tick_y <- se * v_centered * Ci[2] / norm2
+
+      # skip ticks too close to origin (avoids clutter in center)
+      tick_dist <- sqrt(tick_x^2 + tick_y^2)
+      if (tick_dist < max.ext * 0.03) next
+
+      # clip to plot area
+      if (abs(tick_x) > max.ext || abs(tick_y) > max.ext) next
+
+      # draw tick mark
+      segments(
+        tick_x - perp[1] * calibrated.tick.length,
+        tick_y - perp[2] * calibrated.tick.length,
+        tick_x + perp[1] * calibrated.tick.length,
+        tick_y + perp[2] * calibrated.tick.length,
+        col = calibrated.col
+      )
+
+      # draw label offset slightly from tick
+      label_offset <- 2.0 * calibrated.tick.length
+      text(
+        tick_x + perp[1] * label_offset,
+        tick_y + perp[2] * label_offset,
+        labels = v, srt = label_srt,
+        cex = calibrated.cex, col = calibrated.col,
+        adj = c(0.5, 0)
+      )
+    }
+  }
+}
+
+
+#' Add projection lines from elements onto construct axes in a 2D biplot.
+#'
+#' Draws perpendicular projection lines from element points onto construct axes,
+#' showing where each element projects on the axis. This visualizes the
+#' approximated original rating for each element-construct combination.
+#'
+#' @param x               `repgrid` object after [calcBiplotCoords()] and [prepareBiplotData()].
+#' @param projections     Logical or numeric. `TRUE` for all construct axes,
+#'                        or a numeric vector of construct indices (default `TRUE`).
+#' @param projections.e   Logical or numeric. `TRUE` for all elements (default),
+#'                        or a numeric vector of element indices.
+#' @param projections.col Color(s) of projection lines (default `grey(0.5)`).
+#'                        A vector of colors is recycled to match the number of selected elements,
+#'                        so each element's projections can have a distinct color.
+#' @param projections.lty Line type(s) for projection lines (default `3`, dotted).
+#'                        Recycled per element like `projections.col`.
+#' @param projections.lwd Line width(s) for projection lines (default `1`).
+#'                        Recycled per element like `projections.col`.
+#' @param ...             Not evaluated.
+#' @keywords internal
+#' @export
+#'
+addProjectionsToBiplot2d <- function(x,
+                                     projections = TRUE,
+                                     projections.e = TRUE,
+                                     projections.col = grey(0.5),
+                                     projections.lty = 3,
+                                     projections.lwd = 1,
+                                     ...) {
+  pd <- x@plotdata
+  nc <- getNoOfConstructs(x)
+  ne <- getNoOfElements(x)
+
+  # which construct axes to project onto
+  c_idx <- if (isTRUE(projections)) seq_len(nc) else as.integer(projections)
+
+  # which elements to project
+  e_idx <- if (isTRUE(projections.e)) seq_len(ne) else as.integer(projections.e)
+  n_e <- length(e_idx)
+
+  # recycle col, lty, lwd to match number of selected elements
+  projections.col <- rep_len(projections.col, n_e)
+  projections.lty <- rep_len(projections.lty, n_e)
+  projections.lwd <- rep_len(projections.lwd, n_e)
+
+  # element display coordinates (type "e" rows are first ne rows in plotdata)
+  e_rows <- which(pd$type == "e")
+  # construct right-pole rows give axis direction (type "cr" rows)
+  cr_rows <- which(pd$type == "cr")
+
+  for (ci in c_idx) {
+    if (ci < 1 || ci > nc) next
+
+    # construct axis direction from "cr" entry
+    cr_row <- cr_rows[ci]
+    ax <- c(pd$x[cr_row], pd$y[cr_row])
+    norm2 <- sum(ax^2)
+    if (norm2 < 1e-10) next
+
+    # unit direction vector
+    u <- ax / sqrt(norm2)
+
+    for (k in seq_along(e_idx)) {
+      ei <- e_idx[k]
+      if (ei < 1 || ei > ne) next
+
+      e_row <- e_rows[ei]
+      ex <- pd$x[e_row]
+      ey <- pd$y[e_row]
+
+      # scalar projection onto axis
+      s <- ex * u[1] + ey * u[2]
+
+      # projection point on axis
+      px <- s * u[1]
+      py <- s * u[2]
+
+      # draw projection line from element to projection point
+      segments(ex, ey, px, py,
+        col = projections.col[k], lty = projections.lty[k], lwd = projections.lwd[k]
+      )
+    }
+  }
+}
+
+
 # x <- randomGrid(20, 40)
 # x <- boeker
 # x <- raeithel
@@ -1480,6 +1695,31 @@ addVarianceExplainedToBiplot2d <- function(x, dim = c(1, 2, 3), var.cex = .7,
 #' @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 calibrated          Logical or numeric. If `TRUE`, draw calibrated axes with tick marks
+#'                            showing original scale values on all construct axes. If a numeric
+#'                            vector, only draw calibrated axes for constructs with these indices
+#'                            (e.g. `c(1, 3)` for constructs 1 and 3). Default is `FALSE`.
+#'                            Calibrated axes allow reading off approximated original ratings
+#'                            by projecting element points onto construct axes.
+#' @param calibrated.tick.length  Length of calibrated axis tick marks in plot coordinates
+#'                            (default `0.02`).
+#' @param calibrated.cex      Text size for calibrated axis tick labels (default `0.6`).
+#' @param calibrated.col      Color for calibrated axis tick marks and labels
+#'                            (default `grey(0.4)`).
+#' @param projections         Logical or numeric. If `TRUE`, draw perpendicular projection
+#'                            lines from elements onto all construct axes. If a numeric vector,
+#'                            only project onto constructs with these indices (e.g. `c(1, 3)`).
+#'                            Default is `FALSE`.
+#' @param projections.e       Logical or numeric. Which elements to project. `TRUE` (default
+#'                            when `projections` is active) projects all elements. A numeric
+#'                            vector selects specific elements by index (e.g. `c(1, 5)`).
+#' @param projections.col     Color(s) of projection lines (default `grey(0.5)`).
+#'                            A vector is recycled per element, so each element can have
+#'                            a distinct color (e.g. `c("red", "blue")` for two elements).
+#' @param projections.lty     Line type(s) for projection lines (default `3`, dotted).
+#'                            Recycled per element like `projections.col`.
+#' @param projections.lwd     Line width(s) for projection lines (default `1`).
+#'                            Recycled per element like `projections.col`.
 #' @param ...                 parameters passed on to  come.
 #' @export
 #' @seealso
@@ -1589,6 +1829,15 @@ biplot2d <- function(x, dim = c(1, 2), map.dim = 3,
                      var.show = TRUE,
                      var.cex = .7,
                      var.col = grey(.1),
+                     calibrated = FALSE,
+                     calibrated.tick.length = 0.02,
+                     calibrated.cex = 0.6,
+                     calibrated.col = grey(0.4),
+                     projections = FALSE,
+                     projections.e = TRUE,
+                     projections.col = grey(0.5),
+                     projections.lty = 3,
+                     projections.lwd = 1,
                      ...) {
   x <- calcBiplotCoords(x,
     center = center, normalize = normalize,
@@ -1633,6 +1882,26 @@ biplot2d <- function(x, dim = c(1, 2), map.dim = 3,
     axis.ext = axis.ext, mai = mai, rect.margins = rect.margins,
     srt = srt, cex.pos = cex.pos, xpd = xpd, zoom = zoom
   )
+  if (!identical(calibrated, FALSE)) {
+    addCalibratedAxesToBiplot2d(x,
+      dim = dim, center = center, normalize = normalize,
+      g = g, h = h, col.active = col.active,
+      col.passive = col.passive,
+      calibrated = calibrated,
+      calibrated.tick.length = calibrated.tick.length,
+      calibrated.cex = calibrated.cex,
+      calibrated.col = calibrated.col, ...
+    )
+  }
+  if (!identical(projections, FALSE)) {
+    addProjectionsToBiplot2d(x,
+      projections = projections,
+      projections.e = projections.e,
+      projections.col = projections.col,
+      projections.lty = projections.lty,
+      projections.lwd = projections.lwd, ...
+    )
+  }
   addVarianceExplainedToBiplot2d(x,
     dim = dim, center = center, normalize = normalize,
     g = g, h = h, col.active = col.active,