jmgirard / circumplex
Showing 3 of 7 files from the diff.

@@ -65,7 +65,7 @@
Loading
65 65
#' @return A ggplot variable containing a completed circular plot.
66 66
67 67
ssm_plot_circle <- function(.ssm_object, amax = NULL, fontsize = 12,
68 -
                            lowfit = TRUE) {
68 +
                            lowfit = TRUE, repel = FALSE) {
69 69
  df <- .ssm_object$results
70 70
  angles <- as.integer(round(.ssm_object$details$angles))
71 71
@@ -131,6 +131,17 @@
Loading
131 131
    ) +
132 132
    ggplot2::scale_linetype_identity()
133 133
134 +
  if (repel == TRUE) {
135 +
    p <- p + 
136 +
      ggrepel::geom_label_repel(
137 +
        data = df_plot,
138 +
        ggplot2::aes(x = x_est, y = y_est, label = label),
139 +
        nudge_x = -25 - df_plot$x_est,
140 +
        direction = "y",
141 +
        hjust = 1
142 +
      ) + ggplot2::theme(legend.position = "none")
143 +
  }
144 +
  
134 145
  p
135 146
}
136 147

@@ -36,6 +36,11 @@
Loading
36 36
#'   be handled by listwise deletion (TRUE) or pairwise deletion (FALSE). Note
37 37
#'   that pairwise deletion may result in different missing data patterns in
38 38
#'   each bootstrap resample and is slower to compute (default = TRUE).
39 +
#' @param measures_labels Optional. A character vector providing a label for
40 +
#'   each measure provided in \code{measures} (in the same order) to appear in
41 +
#'   the results as well as tables and plots derived from the results. If
42 +
#'   omitted or set to NULL will default to using the measures variable names
43 +
#'   (default = NULL).
39 44
#' @return A list containing the results and description of the analysis.
40 45
#'   \item{results}{A tibble with the SSM parameter estimates} \item{details}{A
41 46
#'   list with the number of bootstrap resamples (boots), the confidence
@@ -74,6 +79,11 @@
Loading
74 79
#'   measures = c(NARPD, ASPD), contrast = "test"
75 80
#' )
76 81
#'
82 +
#' ssm_analyze(jz2017,
83 +
#'   scales = PA:NO, angles = octants(), measures = c(NARPD, ASPD), 
84 +
#'   measures_labels = c("Narcissistic", "Antisocial")
85 +
#' )
86 +
#'
77 87
#' # Multiple-group correlation-based SSM
78 88
#' ssm_analyze(jz2017,
79 89
#'   scales = PA:NO, angles = octants(), measures = NARPD,
@@ -89,15 +99,23 @@
Loading
89 99
#' 
90 100
ssm_analyze <- function(.data, scales, angles = octants(), measures = NULL, 
91 101
                        grouping = NULL, contrast = c("none", "test", "model"), 
92 -
                        boots = 2000, interval = 0.95, listwise = TRUE) {
102 +
                        boots = 2000, interval = 0.95, listwise = TRUE,
103 +
                        measures_labels = NULL) {
93 104
  call <- match.call()
94 105
  contrast <- match.arg(contrast)
95 106
96 107
  # Check for valid input arguments
97 108
  assert_that(is_provided(.data), is_provided(angles))
98 109
  assert_that(is_provided(rlang::enquo(scales)))
99 -
  assert_that(is.numeric(angles), is.flag(listwise))
110 +
  assert_that(is.numeric(angles), rlang::is_logical(listwise, n = 1))
100 111
  assert_that(is.count(boots), is.number(interval), interval > 0, interval < 1)
112 +
  assert_that(
113 +
    is.null(measures_labels) || 
114 +
      rlang::is_character(
115 +
        measures_labels, 
116 +
        n = count_measures(.data, {{measures}})
117 +
      )
118 +
    )
101 119
  # TODO: Check that scales and angles have same length
102 120
  # TODO: Check that grouping is missing, null, or single variable
103 121
  # TODO: Add a flag to flip contrast ordering
@@ -121,6 +139,7 @@
Loading
121 139
        boots = boots,
122 140
        interval = interval,
123 141
        listwise = listwise,
142 +
        measures_labels = measures_labels,
124 143
        call = call
125 144
      )
126 145
    } else {
@@ -133,6 +152,7 @@
Loading
133 152
        boots = boots,
134 153
        interval = interval,
135 154
        listwise = listwise,
155 +
        measures_labels = measures_labels,
136 156
        call = call
137 157
      )
138 158
    }
@@ -272,8 +292,9 @@
Loading
272 292
# Perform analyses using the correlation-based SSM -----------------------------
273 293
274 294
ssm_analyze_corrs <- function(.data, scales, angles, 
275 -
                              measures = NULL, grouping = NULL,
276 -
                              contrast, boots, interval, listwise, call) {
295 +
                              measures, grouping = NULL,
296 +
                              contrast, boots, interval, listwise, 
297 +
                              measures_labels, call) {
277 298
278 299
  # Select circumplex scales, measure variables, and grouping variable
279 300
  if (is_provided(rlang::enquo(grouping))) {
@@ -306,11 +327,16 @@
Loading
306 327
307 328
  # Perform listwise deletion if requested
308 329
  if (listwise == TRUE) {
309 -
    bs_input <- 
310 -
      bs_input %>% 
311 -
      tidyr::drop_na()
330 +
    bs_input <- tidyr::drop_na(bs_input)
312 331
  }
313 332
333 +
  # Select and label results
334 +
  if (is.null(measures_labels)) {
335 +
    measure_names <- names(dplyr::select(.data, {{measures}}))
336 +
  } else {
337 +
    measure_names <- measures_labels
338 +
  }
339 +
  
314 340
  # Calculate observed scores (i.e., correlations)
315 341
  cs <- as.matrix(bs_input[, 1:length(angles)])
316 342
  mv <- as.matrix(bs_input[, (length(angles) + 1):(ncol(bs_input) - 1)])
@@ -322,7 +348,7 @@
Loading
322 348
    dplyr::mutate(
323 349
      Group = rep(unique(bs_input$Group), each = ncol(mv)),
324 350
      Measure = rep(
325 -
        names(dplyr::select(bs_input, {{measures}})),
351 +
        measure_names,
326 352
        times = nlevels(bs_input$Group)
327 353
      )
328 354
    ) %>%
@@ -357,8 +383,6 @@
Loading
357 383
    strata = bs_input$Group
358 384
  )
359 385
360 -
  # Select and label results
361 -
  measure_names <- names(dplyr::select(.data, {{measures}}))
362 386
  group_names <- levels(bs_input$Group)
363 387
  if (contrast == "none") {
364 388
    row_data <- bs_output

@@ -64,3 +64,15 @@
Loading
64 64
  }
65 65
  out
66 66
}
67 +
68 +
count_measures <- function(.data, measures) {
69 +
  ncol(dplyr::select(.data, {{measures}}))
70 +
}
71 +
72 +
count_levels <- function(.data, grouping) {
73 +
  if (ncol(dplyr::select(.data, {{grouping}})) > 0) {
74 +
    nlevels(factor(dplyr::pull(.data, {{grouping}})))
75 +
  } else {
76 +
    0
77 +
  }
78 +
}
Files Coverage
R 88.51%
src 100.00%
Project Totals (11 files) 90.20%
Notifications are pending CI completion. Periodically Codecov will check the CI state, when complete notifications will be submitted. Push notifications now.
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading