inst/doc/introduction-to-ssm-analysis.R

In circumplex: Analysis and Visualization of Circular Data

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
set.seed(12345)
library(ggforce)
library(kableExtra)
library(ggplot2)
library(knitr)

## ----setup--------------------------------------------------------------------
library(circumplex)

## ----model, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
angles <- c(90, 135, 180, 225, 270, 315, 360, 45)
alabel <- c("PA", "BC", "DE", "FG", "HI", "JK", "LM", "NO")

# Create plot ------------------------------------------------------------------

ggplot2::ggplot() +
  # Require plot to be square and remove default styling
  ggplot2::coord_fixed() +
  ggplot2::theme_void() +
  # Expand the axes multiplicatively to fit the labels
  ggplot2::scale_x_continuous(expand = c(0.10, 0)) +
  ggplot2::scale_y_continuous(expand = c(0.10, 0)) +
  # Draw line segments corresponding to the octants
  ggplot2::geom_segment(
    ggplot2::aes(
      x = 0,
      y = 0,
      xend = 5 * cos(angles[c(1, 3, 5, 7)] * pi / 180),
      yend = 5 * sin(angles[c(1, 3, 5, 7)] * pi / 180)
    ),
    color = "gray60",
    linewidth = 1
  ) +
  # Draw inner labels for the octant angles
  ggplot2::geom_label(
    ggplot2::aes(
      x = 3 * cos(angles * pi / 180),
      y = 3 * sin(angles * pi / 180),
      label = sprintf("%d\u00B0", angles)
    ),
    size = 5,
    color = "black",
    label.size = NA,
    hjust = "center",
    vjust = "center"
  ) +
  # Draw the circle
  ggforce::geom_circle(ggplot2::aes(x0 = 0, y0 = 0, r = 5),
    color = "gray50", linewidth = 1.5
  ) +
  # Draw outer labels for octant abbreviations
  ggplot2::geom_label(
    ggplot2::aes(
      x = 5.1 * cos(angles * pi / 180),
      y = 5.1 * sin(angles * pi / 180),
      label = alabel
    ),
    size = 5,
    color = "black",
    label.size = NA,
    hjust = "outward",
    vjust = "outward"
  )

## ----column, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
data("jz2017")
rmat <- stats::cor(jz2017[c("NARPD", PANO())], method = "pearson")
r <- rmat[2:9, 1]

# Format data for plotting
dat_r <- data.frame(Scale = factor(PANO()), r = r)

# Create column plot
ggplot2::ggplot(dat_r, ggplot2::aes(x = .data$Scale, y = .data$r)) +
  ggplot2::geom_hline(yintercept = 0, linewidth = 1.25, color = "darkgray") +
  ggplot2::geom_col(position = ggplot2::position_dodge(.9), fill = "red") +
  ggplot2::scale_y_continuous(limits = c(-0.02, 0.5)) +
  ggplot2::labs(title = "Scores") +
  ggplot2::theme(
    axis.title = ggplot2::element_blank(),
    panel.grid.major = ggplot2::element_line(linewidth = 1.0),
    panel.grid.minor.y = ggplot2::element_line(linewidth = 0.5),
    panel.grid.minor.x = ggplot2::element_blank()
  )

## ----path, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
dat_r <- data.frame(
  Scale = factor(PANO()),
  est = r,
  Angle = octants()
)

dat_r <- dat_r[order(dat_r$Angle), ]

# Plot correlations as connected point ranges with 95% CI ranges
ggplot2::ggplot(dat_r, ggplot2::aes(x = .data$Angle, y = .data$est)) +
  ggplot2::geom_hline(yintercept = 0, linewidth = 1.25, color = "darkgray") +
  ggplot2::geom_point(size = 3, color = "red") +
  ggplot2::geom_path(linewidth = 1.25, color = "red") +
  ggplot2::geom_label(ggplot2::aes(label = Scale), nudge_y = 0.075) +
  ggplot2::scale_x_continuous(
    breaks = octants(),
    expand = c(0.05, 0),
    labels = function(x) sprintf("%.0f\U00B0", x)
  ) +
  ggplot2::scale_y_continuous(
    limits = c(-0.02, 0.5)
  ) +
  ggplot2::labs(title = "Scores by Angle") +
  ggplot2::theme(
    axis.title = ggplot2::element_blank(),
    plot.margin = ggplot2::unit(c(10, 30, 10, 10), "points"),
    panel.grid.major = ggplot2::element_line(linewidth = 1.0),
    panel.grid.minor.y = ggplot2::element_line(linewidth = 0.5),
    panel.grid.minor.x = ggplot2::element_blank()
  )

## ----curve, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
# Calculate SSM parameters
sp <- ssm_parameters(r, octants())

# Create function for SSM cosine model
f <- function(x) {
  sp$Elev + sp$Ampl * cos((x - sp$Disp) * pi / 180)
}

# Plot correlations along with SSM cosine model
ggplot2::ggplot(dat_r, ggplot2::aes(x = .data$Angle, y = .data$est)) +
  ggplot2::geom_hline(yintercept = 0, linewidth = 1.25, color = "darkgray") +
  ggplot2::geom_point(size = 3) +
  ggplot2::geom_path(linewidth = 1.25) +
  ggplot2::stat_function(fun = f, linewidth = 2, color = "red") +
  ggplot2::scale_x_continuous(
    breaks = octants(),
    expand = c(0.01, 0),
    labels = function(x) sprintf("%.0f\U00B0", x)
  ) +
  ggplot2::scale_y_continuous(
    limits = c(-0.02, 0.5)
  ) +
  ggplot2::labs(title = "Cosine Curve Estimated by SSM") +
  ggplot2::theme(
    axis.title = ggplot2::element_blank(),
    plot.margin = ggplot2::unit(c(10, 30, 10, 10), "points"),
    panel.grid.major = ggplot2::element_line(linewidth = 1.0),
    panel.grid.minor.y = ggplot2::element_line(linewidth = 0.5),
    panel.grid.minor.x = ggplot2::element_blank()
  )

## ----residuals, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
# Plot correlations as path, SSM cosine model, and differences
ggplot2::ggplot(dat_r, ggplot2::aes(x = .data$Angle, y = .data$est)) +
  ggplot2::geom_hline(yintercept = 0, linewidth = 1.25, color = "darkgray") +
  ggplot2::stat_function(fun = f, linewidth = 2, color = "gray20") +
  ggplot2::geom_point(size = 5.5, color = "black") +
  ggplot2::geom_path(linewidth = 1.25, color = "black") +
  ggplot2::geom_segment(
    ggplot2::aes(
      x = .data$Angle, 
      xend = .data$Angle, 
      y = .data$est, 
      yend = f(.data$Angle)
    ),
    linewidth = 4, 
    linetype = "solid", 
    color = "red"
  ) +
  ggplot2::scale_x_continuous(
    breaks = octants(),
    expand = c(0.01, 0),
    labels = function(x) sprintf("%.0f\U00B0", x)
  ) +
  ggplot2::scale_y_continuous(
    limits = c(-0.02, 0.475)
  ) +
  ggplot2::labs(title = sprintf("Fit = %.2f", sp[[6]])) +
  ggplot2::theme(
    axis.title = ggplot2::element_blank(),
    plot.margin = ggplot2::unit(c(10, 30, 10, 10), "points"),
    panel.grid.major = ggplot2::element_line(linewidth = 1.0),
    panel.grid.minor.y = ggplot2::element_line(linewidth = 0.5),
    panel.grid.minor.x = ggplot2::element_blank()
  )

## ----elev, echo = FALSE, out.width = "100%"-----------------------------------
knitr::include_graphics("VIG1-e.gif")

## ----ampl, echo = FALSE, out.width = "100%"-----------------------------------
knitr::include_graphics("VIG1-a.gif")

## ----disp, echo = FALSE, out.width = "100%"-----------------------------------
knitr::include_graphics("VIG1-d.gif")

## ----jz2017-------------------------------------------------------------------
data("jz2017")
head(jz2017)

## ----iipsc, echo = FALSE, fig.width = 7.5, fig.height = 4, out.width = "100%"----
angles <- c(90, 135, 180, 225, 270, 315, 360, 45)
flabel <- c(
  "Domineering",
  "Vindictive",
  "Cold",
  "Socially\nAvoidant",
  "Nonassertive",
  "Easily\nExploited",
  "Overly\nNurturant",
  "Intrusive"
)
alabel <- c("PA", "BC", "DE", "FG", "HI", "JK", "LM", "NO")

# Create plot ------------------------------------------------------------------

ggplot2::ggplot() +
  # Require plot to be square and remove default styling
  ggplot2::coord_fixed() +
  ggplot2::theme_void() +
  # Expand both axes multiplicatively to fit the labels
  ggplot2::scale_x_continuous(expand = c(0.30, 0)) +
  ggplot2::scale_y_continuous(expand = c(0.10, 0)) +
  # Draw line segments corresponding to the octants
  ggplot2::geom_segment(
    ggplot2::aes(
      x = 0,
      y = 0,
      xend = 5 * cos(angles * pi / 180),
      yend = 5 * sin(angles * pi / 180)
    ),
    color = "gray60",
    linewidth = 0.5
  ) +
  # Draw inner labels for the octant abbreviations
  ggplot2::geom_label(
    ggplot2::aes(
      x = 3.75 * cos(angles * pi / 180),
      y = 3.75 * sin(angles * pi / 180),
      label = alabel
    ),
    size = 5,
    color = "gray40",
    label.size = NA,
    hjust = "center",
    vjust = "center"
  ) +
  # Draw inner labels for the octant angles
  ggplot2::geom_label(
    ggplot2::aes(
      x = 2 * cos(angles * pi / 180),
      y = 2 * sin(angles * pi / 180),
      label = sprintf("%d\u00B0", angles)
    ),
    size = 4,
    color = "gray50",
    label.size = NA,
    hjust = "center",
    vjust = "center"
  ) +
  # Draw the circle
  ggforce::geom_circle(
    ggplot2::aes(x0 = 0, y0 = 0, r = 5),
    color = "gray50", 
    size = 1.5
  ) +
  # Draw outer labels for the octant names
  ggplot2::geom_label(
    ggplot2::aes(
      x = 5.1 * cos(angles * pi / 180),
      y = 5.1 * sin(angles * pi / 180),
      label = flabel
    ),
    size = 5,
    color = "black",
    label.size = NA,
    hjust = "outward",
    vjust = "outward"
  )

## ----analyze------------------------------------------------------------------
results <- ssm_analyze(
  data = jz2017,
  scales = c("PA", "BC", "DE", "FG", "HI", "JK", "LM", "NO"),
  angles = c(90, 135, 180, 225, 270, 315, 360, 45)
)

## ----summary1a----------------------------------------------------------------
summary(results)

## ----summary1b----------------------------------------------------------------
results2 <- ssm_analyze(data = jz2017, scales = PANO(), angles = octants())
summary(results2)

## ----table1, echo = FALSE-----------------------------------------------------
ssm_table(results2, render = FALSE) %>%
  knitr::kable(caption = circumplex:::dcaption(results2)) %>%
  kableExtra::kable_styling(full_width = TRUE, font_size = 14)

## ----plot1, fig.width = 7.2, fig.height = 4, out.width = "100%"---------------
ssm_plot_circle(results2)

## ----plot2, fig.width = 7.2, fig.height = 4, out.width = "100%"---------------
ssm_plot_curve(results2)

## ----summary2-----------------------------------------------------------------
results3 <- ssm_analyze(
  data = jz2017, 
  scales = PANO(), 
  angles = octants(),
  measures = "NARPD"
)
summary(results3)

## ----table2, echo = FALSE-----------------------------------------------------
ssm_table(results3, render = FALSE) %>%
  knitr::kable(caption = circumplex:::dcaption(results3)) %>%
  kableExtra::kable_styling(full_width = TRUE, font_size = 14)

## ----plot3, fig.width = 7.5, fig.height = 4, out.width = "100%"---------------
ssm_plot_circle(results3)

## ----plot4, fig.width = 7.5, fig.height = 4, out.width = "100%"---------------
ssm_plot_curve(results3)