R/draw_loops.R

In ggsem: Interactive Structural Equation Modeling (SEM) and Multi-Group Path Diagrams

#' Draw Self-loop Arrows on a ggplot Object
#'
#' @description
#' This function overlays self-loop arrows to a ggplot object based on data describing their positions, sizes, orientations, and styles. Self-loop arrows can be drawn in one direction or bidirectionally with customizable parameters such as color, width, and arrow type. The data can come from a CSV file generated by the ggsem Shiny app or custom input.
#' @param loops_data A data frame containing information about the self-loop arrows. The expected columns include:
#' \itemize{
#'   \item \code{x_center}, \code{y_center}: Center coordinates of the loop.
#'   \item \code{radius}: Radius of the loop.
#'   \item \code{color}: Color of the loop (hexadecimal color code).
#'   \item \code{width}: Width of the loop line (numeric).
#'   \item \code{alpha}: Transparency of the loop line (numeric, 0 to 1).
#'   \item \code{arrow_type}: Type of arrow (\code{"closed"} or \code{"open"}).
#'   \item \code{arrow_size}: Size of the arrowhead.
#'   \item \code{gap_size}: Size of the gap in the loop, specified as a fraction of the full circle (numeric, 0 to 1).
#'   \item \code{loop_width}, \code{loop_height}: Width and height scaling factors for the loop.
#'   \item \code{orientation}: Rotation angle of the loop in degrees.
#'   \item \code{two_way}: Logical, whether the loop is bidirectional (adds arrows at both ends).
#' }
#'
#' @param zoom_level Numeric. Adjusts the size of line widths and arrowheads relative to the plot. Default is \code{1}.
#'
#' @return
#' ggplot2 loop layers
#' @export
#' @importFrom ggplot2 annotate arrow unit
#' @examples
#' library(ggplot2)
#'
#' loops_data <- data.frame(
#' x_center = -5, y_center = 5, radius = 2, color = '#000000',
#' width = 1, alpha = 1, arrow_type = 'closed', arrow_size = 0.1,
#' gap_size = 0.2, loop_width = 5, loop_height = 5, orientation = 0,
#' lavaan = TRUE, two_way = FALSE, locked = FALSE, group = 1
#' )
#'
#' p <- ggplot()
#'
#' p + draw_loops(loops_data, zoom_level = 1.2)
draw_loops <- function(loops_data, zoom_level = 1) {
  if (!is.null(loops_data) && nrow(loops_data) > 0) {
    loops_data$color <- sapply(loops_data$color, valid_hex)
    loops_data$alpha <- sapply(loops_data$alpha, valid_alpha)
    loops_data$locked <- sapply(loops_data$locked, valid_logical)

    layers <- lapply(1:nrow(loops_data), function(i) {
      t <- seq(0, 2 * pi, length.out = 100)
      gap_angle <- loops_data$gap_size[i] * pi

      gap_center_angle <- 0  # Gap centered at 0°
      gap_start_angle <- gap_center_angle - (gap_angle / 2)
      gap_end_angle <- gap_center_angle + (gap_angle / 2)

      gap_start_angle <- gap_start_angle %% (2 * pi)
      gap_end_angle <- gap_end_angle %% (2 * pi)

      if (gap_start_angle < gap_end_angle) {
        loop_t <- t[t < gap_start_angle | t > gap_end_angle]
      } else {
        loop_t <- t[t > gap_end_angle & t < gap_start_angle]
      }

      x_ellipse <- loops_data$x_center[i] + (loops_data$loop_width[i]) * loops_data$radius[i] * cos(loop_t)
      y_ellipse <- loops_data$y_center[i] + (loops_data$loop_height[i]) * loops_data$radius[i] * sin(loop_t)

      effective_orientation <- loops_data$orientation[i] + 90

      theta <- effective_orientation * pi / 180
      x_rotated <- cos(theta) * (x_ellipse - loops_data$x_center[i]) - sin(theta) * (y_ellipse - loops_data$y_center[i]) + loops_data$x_center[i]
      y_rotated <- sin(theta) * (x_ellipse - loops_data$x_center[i]) + cos(theta) * (y_ellipse - loops_data$y_center[i]) + loops_data$y_center[i]

      if (loops_data$two_way[i] == FALSE) {
        annotate("path",
                 x = x_rotated,
                 y = y_rotated,
                 color = loops_data$color[i],
                 linewidth = loops_data$width[i] / zoom_level,
                 alpha = loops_data$alpha[i],
                 arrow = arrow(type = loops_data$arrow_type[i],
                               length = unit(loops_data$arrow_size[i] / zoom_level, "inches")))
      } else {
        annotate("path",
                 x = x_rotated,
                 y = y_rotated,
                 color = loops_data$color[i],
                 linewidth = loops_data$width[i] / zoom_level,
                 alpha = loops_data$alpha[i],
                 arrow = arrow(type = loops_data$arrow_type[i],
                               ends = "both",
                               length = unit(loops_data$arrow_size[i] / zoom_level, "inches")))
      }
    })
    return(layers)
  } else {
    return(NULL)
  }
}