R/draw_points.R

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

#' Draw Points on a ggplot Object
#'
#' @description
#' This function overlays points to a ggplot object using data from a CSV file generated by the ggsem Shiny app or any custom dataset.
#' Points can be styled with various shapes, colors, sizes, and orientations.
#' @param points_data A data frame containing information about the points to be drawn. The expected columns include:
#' \itemize{
#'   \item \code{x}, \code{y}: Coordinates of the point.
#'   \item \code{shape}: Shape of the point (\code{"circle"}, \code{"square"}, \code{"triangle"}, \code{"rectangle"}, \code{"oval"}, or \code{"diamond"}).
#'   \item \code{color}: Fill color of the point (hexadecimal color code).
#'   \item \code{size}: Size of the point.
#'   \item \code{border_color}: Border color of the point (hexadecimal color code).
#'   \item \code{border_width}: Width of the border.
#'   \item \code{alpha}: Transparency of the point (numeric, 0 to 1).
#'   \item \code{width_height_ratio}: Ratio of width to height (for shapes like rectangles and ovals).
#'   \item \code{orientation}: Rotation angle of the point in degrees (for shapes like rectangles and diamonds).
#' }
#' @param zoom_level Numeric. Adjusts the size of the points relative to the plot. Default is \code{1}.
#'
#' @return
#' ggplot2 point layers
#' @export
#' @importFrom ggplot2 annotate
#' @importFrom stats setNames
#' @examples
#' library(ggplot2)
#'
#' points_data <- data.frame(
#' x = 0, y = 0, shape = 'square', color = '#1262B3', size = 12,
#' border_color = '#FFFFFF', border_width = 1, alpha = 1,
#' width_height_ratio = 1.6, orientation = 0,
#' lavaan = FALSE, network = FALSE, locked = FALSE,
#' group = 1
#' )
#'
#' p <- ggplot()
#'
#' p + draw_points(points_data, zoom_level = 1.2) +
#' scale_x_continuous(limits = c(0,50)) +
#' scale_y_continuous(limits = c(0,50))
#'

draw_points <- function(points_data, zoom_level = 1) {
  if (nrow(points_data) == 0) return(NULL)

  # Vectorize validation functions
  points_data$color <- sapply(points_data$color, valid_hex)
  points_data$border_color <- sapply(points_data$border_color, valid_hex)
  points_data$shape <- sapply(points_data$shape, valid_shape)
  points_data$alpha <- sapply(points_data$alpha, valid_alpha)
  points_data$locked <- sapply(points_data$locked, valid_logical)

  # Recycle short vectors
  if (length(points_data$color) != nrow(points_data)) {
    points_data$color <- rep(points_data$color[1], nrow(points_data))
  }

  if (length(points_data$border_width) != nrow(points_data)) {
    points_data$border_width <- rep(points_data$border_width[1], nrow(points_data))
  }

  # Pre-calculate common values
  min_size_factor <- 0.25
  scale_factor <- sqrt(2)
  adjusted_strokes <- points_data$border_width / zoom_level

  # Pre-allocate layers list
  layers <- vector("list", nrow(points_data))

  for (i in seq_len(nrow(points_data))) {
    shape <- points_data$shape[i]
    width_height_ratio <- ifelse(!is.null(points_data$width_height_ratio[i]),
                                 points_data$width_height_ratio[i], 1)

    # Calculate adjusted dimensions based on shape
    adjusted_width <- switch(shape,
                             "circle" = points_data$size[i] / scale_factor * min_size_factor,
                             "square" = points_data$size[i] * sqrt(2) * min_size_factor,
                             "triangle" = points_data$size[i] * sqrt(4 / sqrt(3)) * min_size_factor,
                             "rectangle" = points_data$size[i] * min_size_factor * width_height_ratio,
                             "diamond" = points_data$size[i] * 1.4 * sqrt(1.5) * min_size_factor * width_height_ratio,
                             "oval" = points_data$size[i] * min_size_factor / scale_factor * width_height_ratio,
                             points_data$size[i] / 3  # default
    )

    adjusted_height <- switch(shape,
                              "circle" = adjusted_width,
                              "square" = adjusted_width,
                              "triangle" = adjusted_width * sqrt(3) / 2,
                              "rectangle" = points_data$size[i] * min_size_factor,
                              "diamond" = points_data$size[i] * 1.4 * sqrt(1.5) * min_size_factor,
                              "oval" = points_data$size[i] * min_size_factor / scale_factor,
                              adjusted_width / width_height_ratio  # default
    )

    # Generate coordinates based on shape
    if (shape == "circle") {
      t <- seq(0, 2 * pi, length.out = 100)
      x_coords <- points_data$x[i] + adjusted_width * cos(t)
      y_coords <- points_data$y[i] + adjusted_height * sin(t)
      coords <- data.frame(x = x_coords, y = y_coords)
    } else {
      coords <- switch(shape,
                       "triangle" = data.frame(
                         x = c(points_data$x[i], points_data$x[i] - adjusted_width/2, points_data$x[i] + adjusted_width/2),
                         y = c(points_data$y[i] + adjusted_height/2, points_data$y[i] - adjusted_height/2, points_data$y[i] - adjusted_height/2)
                       ),
                       "square" = data.frame(
                         x = c(
                           points_data$x[i] - adjusted_width/2, points_data$x[i] + adjusted_width/2,
                           points_data$x[i] + adjusted_width/2, points_data$x[i] - adjusted_width/2
                         ),
                         y = c(
                           points_data$y[i] - adjusted_height/2, points_data$y[i] - adjusted_height/2,
                           points_data$y[i] + adjusted_height/2, points_data$y[i] + adjusted_height/2
                         )
                       ),
                       "oval" = {
                         t <- seq(0, 2 * pi, length.out = 100)
                         data.frame(
                           x = points_data$x[i] + adjusted_width * cos(t),
                           y = points_data$y[i] + adjusted_height * sin(t)
                         )
                       },
                       "rectangle" = data.frame(
                         x = c(
                           points_data$x[i] - adjusted_width/2, points_data$x[i] + adjusted_width/2,
                           points_data$x[i] + adjusted_width/2, points_data$x[i] - adjusted_width/2
                         ),
                         y = c(
                           points_data$y[i] - adjusted_height/2, points_data$y[i] - adjusted_height/2,
                           points_data$y[i] + adjusted_height/2, points_data$y[i] + adjusted_height/2
                         )
                       ),
                       # diamond (default case)
                       data.frame(
                         x = c(
                           points_data$x[i], points_data$x[i] - adjusted_width/2,
                           points_data$x[i], points_data$x[i] + adjusted_width/2
                         ),
                         y = c(
                           points_data$y[i] + adjusted_height/2, points_data$y[i],
                           points_data$y[i] - adjusted_height/2, points_data$y[i]
                         )
                       )
      )

      # Rotate if needed (all shapes except circle)
      if (!is.null(points_data$orientation[i])) {
        coords <- rotate_coords(coords$x, coords$y, points_data$orientation[i],
                                cx = points_data$x[i], cy = points_data$y[i])
      }
    }

    # Create annotation layer
    layers[[i]] <- annotate(
      "polygon",
      x = coords$x,
      y = coords$y,
      fill = points_data$color[i],
      colour = points_data$border_color[i],
      linewidth = adjusted_strokes[i],
      alpha = points_data$alpha[i]
    )
  }

  return(layers)
}