Add ssm_plot_scores

NAMESPACE

@@ -9,6 +9,8 @@ S3method(as_radian,default)
 S3method(print,circumplex_instrument)
 S3method(print,circumplex_ssm)
 S3method(quantile,circumplex_radian)
+S3method(ssm_plot_scores,circumplex_ssm)
+S3method(ssm_plot_scores,data.frame)
 S3method(summary,circumplex_instrument)
 S3method(summary,circumplex_ssm)
 export("%>%")
@@ -35,6 +37,7 @@ export(ssm_analyze)
 export(ssm_append)
 export(ssm_parameters)
 export(ssm_plot)
+export(ssm_plot_scores)
 export(ssm_score)
 export(ssm_table)
 export(standardize)

R/ssm_oop.R

@@ -172,3 +172,5 @@ summary.circumplex_ssm <- function(object, digits = 3, ...) {
   }
   cat("\n")
 }
+
+

R/ssm_visualization.R

@@ -301,7 +301,7 @@ ssm_plot_contrast <- function(.ssm_object, axislabel = "Difference",
 }
 
 # Create an Empty Circular Plot
-circle_base <- function(angles, labels = NULL,
+circle_base <- function(angles, labels = NULL, amin = 0,
                         amax = 0.5, fontsize = 12) {
 
   if (is.null(labels)) labels <- sprintf("%d\u00B0", angles)
@@ -344,7 +344,7 @@ circle_base <- function(angles, labels = NULL,
         y = 0,
         label = sprintf(
           "%.2f",
-          seq(from = 0, to = amax, length.out = 6)[c(3, 5)]
+          seq(from = amin, to = amax, length.out = 6)[c(3, 5)]
         )
       ),
       color = "gray20",
@@ -532,3 +532,122 @@ html_render <- function(df, caption = NULL, align = "l", ...) {
   )
   print(t, type = "html")
 }
+
+# S3 Generic
+#' @export
+ssm_plot_scores <- function(x, ...) {
+  UseMethod("ssm_plot_scores")
+}
+
+#' @method ssm_plot_scores circumplex_ssm
+#' @export
+ssm_plot_scores.circumplex_ssm <- function(.ssm_object,
+                                           amin = NULL, 
+                                           amax = NULL,
+                                           angle_labels = NULL,
+                                           linewidth = 1,
+                                           pointsize = 3) {
+
+  # Get scores from SSM object
+  scores <- .ssm_object$scores
+  # Reshape scores for plotting
+  scores_long <- tidyr::pivot_longer(
+    scores, 
+    cols = -c("Group", "Measure", "label"),
+    names_to = "Scale",
+    values_to = "Score"
+  )
+  # Get angles from SSM object
+  angles <- .ssm_object$details$angles
+  if (is.null(amin)) amin <- pretty_min(scores_long$Score)
+  if (is.null(amax)) amax <- pretty_max(scores_long$Score)
+  scores_long$Angle <- rep(angles, times = nrow(scores_long) / length(angles))
+  scores_long$Radian <- as_radian(as_degree(scores_long$Angle))
+  scores_long$pr <- scales::rescale(
+    scores_long$Score, 
+    to = c(0, 5), 
+    from = c(amin, amax)
+  )
+  scores_long$px <- scores_long$pr * cos(scores_long$Radian)
+  scores_long$py <- scores_long$pr * sin(scores_long$Radian)
+
+  p <- circle_base(
+    angles = angles, 
+    amin = amin,
+    amax = amax,
+    labels = angle_labels
+  )
+
+  p +
+    ggplot2::geom_polygon(
+      data = scores_long,
+      mapping = ggplot2::aes(x = px, y = py, color = label, linetype = label),
+      fill = NA,
+      linewidth = linewidth
+    ) +
+    ggplot2::geom_point(
+      data = scores_long,
+      mapping = ggplot2::aes(x = px, y = py, color = label),
+      size = pointsize
+    )
+
+}
+
+#' @method ssm_plot_scores data.frame
+#' @export
+ssm_plot_scores.data.frame <- function(.data, 
+                                       scales, 
+                                       angles = octants(),
+                                       group = NULL,
+                                       amin = NULL, 
+                                       amax = NULL,
+                                       angle_labels = NULL,
+                                       linewidth = 1,
+                                       pointsize = 3) {
+
+  if (!is_enquo(group)) {
+    .data$group <- "All"
+    group <- "group"
+  }
+  # Get scores from SSM object
+  scores <- dplyr::select(.data, {{group}}, {{scales}})
+  # Reshape scores for plotting
+  scores_long <- tidyr::pivot_longer(
+    scores, 
+    cols = {{scales}},
+    names_to = "Scale",
+    values_to = "Score"
+  )
+  if (is.null(amin)) amin <- pretty_min(scores_long$Score)
+  if (is.null(amax)) amax <- pretty_max(scores_long$Score)
+  scores_long$Angle <- rep(angles, times = nrow(scores_long) / length(angles))
+  scores_long$Radian <- as_radian(as_degree(scores_long$Angle))
+  scores_long$pr <- scales::rescale(
+    scores_long$Score, 
+    to = c(0, 5), 
+    from = c(amin, amax)
+  )
+  scores_long$px <- scores_long$pr * cos(scores_long$Radian)
+  scores_long$py <- scores_long$pr * sin(scores_long$Radian)
+
+  p <- circle_base(
+    angles = angles, 
+    amin = amin, 
+    amax = amax,
+    labels = angle_labels
+  )
+
+  p +
+    ggplot2::geom_polygon(
+      data = scores_long,
+      mapping = ggplot2::aes(x = px, y = py, color = {{group}}, linetype = {{group}}),
+      fill = NA,
+      linewidth = linewidth
+    ) +
+    ggplot2::geom_point(
+      data = scores_long,
+      mapping = ggplot2::aes(x = px, y = py, color = {{group}}),
+      size = pointsize
+    )
+
+}

R/utils.R

@@ -49,15 +49,51 @@ str_percent <- function(x, digits = 2) {
 pretty_max <- function(v) {
   amax <- max(v, na.rm = TRUE)
   options <- c(
+    -5.00, -4.00, -3.00, -2.50, -2.00,
+    -1.50, -1.25, -1.00, -0.75, -0.50,
+    -0.25, -0.20, -0.15, -0.10, -0.05,
+    0,
     0.05, 0.10, 0.15, 0.20, 0.25,
     0.50, 0.75, 1.00, 1.25, 1.50,
     2.00, 2.50, 3.00, 4.00, 5.00
   )
-  match <- options > amax
+  if (amax < 0 ) {
+    scalar <- 0.5
+  } else {
+    scalar <- 1.5
+  }
+  match <- options > amax * scalar
   if (sum(match) >= 1) {
     out <- options[match][[1]]
   } else {
-    out <- ceiling(amax * 1.50)
+    out <- amax
+  }
+  out
+}
+
+# Determine good min amplitude value for circle plot ---------------------------
+pretty_min <- function(v) {
+  amin <- min(v, na.rm = TRUE)
+  options <- c(
+    -5.00, -4.00, -3.00, -2.50, -2.00,
+    -1.50, -1.25, -1.00, -0.75, -0.50,
+    -0.25, -0.20, -0.15, -0.10, -0.05,
+    0,
+    0.05, 0.10, 0.15, 0.20, 0.25,
+    0.50, 0.75, 1.00, 1.25, 1.50,
+    2.00, 2.50, 3.00, 4.00, 5.00
+  )
+  if (amin < 0) {
+    scalar <- 1.5
+  } else {
+    scalar <- 0.5
+  }
+  match <- options < amin * scalar
+  if (sum(match) >= 1) {
+    candidates <- options[match]
+    out <- candidates[length(candidates)]
+  } else {
+    out <- amin
   }
   out
 }