add self_standardize()

jmgirard · Nov 1, 2024 · de4dd82 · de4dd82
1 parent e634681
commit de4dd82
Show file tree

Hide file tree

Showing 18 changed files with 150 additions and 131 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -17,7 +17,6 @@ export(PANO)
 export(anchors)
 export(ggsave)
 export(html_render)
-export(instrument)
 export(instruments)
 export(ipsatize)
 export(items)
@@ -28,6 +27,7 @@ export(poles)
 export(quadrants)
 export(scales)
 export(score)
+export(self_standardize)
 export(ssm_analyze)
 export(ssm_parameters)
 export(ssm_plot_circle)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # circumplex (development version)
 
+* Fix some typos in documentation
+
 # circumplex 1.0.0
 
 ## Breaking changes
@@ -8,7 +10,7 @@
 
 * Removed support for non-standard evaluation
 
-* The `contrast` argument to `ssm_plot()` is now TRUE or FALSE instead of "none", "model", or "test". Model contrasts were removed and TRUE yields test contrasts.
+* The `contrast` argument to `ssm_analyze()` is now TRUE or FALSE instead of "none", "model", or "test". Model contrasts were removed and TRUE yields test contrasts.
 
 * Many arguments renamed (e.g., `.data` to `data`, `.ssm_object` to `ssm_object`, `xy` to `drop_xy`)
 

diff --git a/R/instrument_oop.R b/R/instrument_oop.R
@@ -61,7 +61,6 @@ summary.circumplex_instrument <- function(object, scales = TRUE, anchors = TRUE,
 #' @family instrument functions
 #' @export
 #' @examples
-#' instrument("csip")
 #' scales(csip)
 #' scales(csip, items = TRUE)
 scales <- function(x, items = FALSE) {
@@ -97,7 +96,6 @@ scales <- function(x, items = FALSE) {
 #' @family instrument functions
 #' @export
 #' @examples
-#' instrument("csip")
 #' items(csip)
 items <- function(x) {
   stopifnot(is_instrument(x))
@@ -130,7 +128,6 @@ items <- function(x) {
 #' @family instrument functions
 #' @export
 #' @examples
-#' instrument("csip")
 #' anchors(csip)
 anchors <- function(x) {
   stopifnot(is_instrument(x))
@@ -158,7 +155,6 @@ anchors <- function(x) {
 #' @family instrument functions
 #' @export
 #' @examples
-#' instrument("csip")
 #' norms(csip)
 norms <- function(x) {
 
@@ -202,45 +198,20 @@ instruments <- function() {
 
   cat(
     "The circumplex package currently includes 14 instruments:\n",
-    "1. CSIE: Circumplex Scales of Interpersonal Efficacy (csie)\n",
-    "2. CSIG: Circumplex Scales of Intergroup Goals (csig)\n",
-    "3. CSIP: Circumplex Scales of Interpersonal Problems (csip)\n",
-    "4. CSIV: Circumplex Scales of Interpersonal Values (csiv)\n",
-    "5. IEI: Interpersonal Emotion Inventory (iei)\n",
-    "6. IGI-CR: Interpersonal Goals Inventory for Children, Revised Version (igicr)\n",
-    "7. IIP-32: Inventory of Interpersonal Problems, Brief Version (iip32)\n",
-    "8. IIP-64: Inventory of Interpersonal Problems (iip64)\n",
-    "9. IIP-SC: Inventory of Interpersonal Problems, Short Circumplex (iipsc)\n",
-    "10. IIS-32: Inventory of Interpersonal Strengths, Brief Version (iis32)\n",
-    "11. IIS-64: Inventory of Interpersonal Strengths (iis64)\n",
-    "12. IIT-C: Inventory of Influence Tactics Circumplex (iitc)\n",
-    "13. IPIP-IPC: IPIP Interpersonal Circumplex (ipipipc)\n",
-    "14. ISC: Interpersonal Sensitivities Circumplex (isc)\n"
+    "1. CAIS: Child and Adolescent Interpersonal Survey (cais)\n",
+    "2. CSIE: Circumplex Scales of Interpersonal Efficacy (csie)\n",
+    "3. CSIG: Circumplex Scales of Intergroup Goals (csig)\n",
+    "4. CSIP: Circumplex Scales of Interpersonal Problems (csip)\n",
+    "5. CSIV: Circumplex Scales of Interpersonal Values (csiv)\n",
+    "6. IEI: Interpersonal Emotion Inventory (iei)\n",
+    "7. IGI-CR: Interpersonal Goals Inventory for Children, Revised Version (igicr)\n",
+    "8. IIP-32: Inventory of Interpersonal Problems, Brief Version (iip32)\n",
+    "9. IIP-64: Inventory of Interpersonal Problems (iip64)\n",
+    "10. IIP-SC: Inventory of Interpersonal Problems, Short Circumplex (iipsc)\n",
+    "11. IIS-32: Inventory of Interpersonal Strengths, Brief Version (iis32)\n",
+    "12. IIS-64: Inventory of Interpersonal Strengths (iis64)\n",
+    "13. IIT-C: Inventory of Influence Tactics Circumplex (iitc)\n",
+    "14. IPIP-IPC: IPIP Interpersonal Circumplex (ipipipc)\n",
+    "15. ISC: Interpersonal Sensitivities Circumplex (isc)\n"
   )
 }
-
-#' Load a specific instrument object
-#'
-#' The circumplex package includes information about numerous circumplex
-#' instruments including instructions for scoring and standardizing items to be
-#' used in conjunction with the \code{score} and \code{standardize} functions.
-#' This function loads the information for a specific instrument into memory.
-#' See the \code{instruments} function to list all available instruments.
-#'
-#' @param code Required. A string (e.g., "iip32") or text in non-standard
-#'   evaluation (e.g., iip32). The code of the instrument assigned by this
-#'   package and displayed in parentheses by \code{instruments()}.
-#' @return The instrument object for the requested circumplex instrument. If
-#'   the function is called without a name assignment (LHS), then the object
-#'   will be created in the global environment with the default name as above.
-#'   Or, if a name is assigned (LHS), the object will have that name instead.
-#' @family instrument functions
-#' @export
-#' @examples
-#' instrument("iip32")
-#' x <- instrument("iip32")
-instrument <- function(code) {
-  stopifnot(is.character(code), length(code) == 1)
-  utils::data(list = code)
-  invisible(get(code))
-}
diff --git a/R/tidying_functions.R b/R/tidying_functions.R
@@ -194,3 +194,62 @@ norm_standardize <- function(data, scales, angles = octants(), instrument,
     as.data.frame(scores) 
   }
 }
+
+#' Standardize circumplex scales using sample data
+#'
+#' Take in a data frame containing circumplex scales (or items) and return that
+#' same data frame with each specified variable transformed into standard scores
+#' (i.e., z-scores) based on observed means and SDs.
+#'
+#' @param data Required. A data frame or matrix containing at least circumplex
+#'   scales.
+#' @param scales Required. A character vector containing the column names, or a
+#'   numeric vector containing the column indexes, for the variables (scale
+#'   scores) to be standardized.
+#' @param na.rm Optional. A logical that determines whether to remove missing
+#'   values from scales when calculating the means and SDs used for
+#'   standardization (default = TRUE).
+#' @param prefix Optional. A string to include at the beginning of the newly
+#'   calculated scale variables' names, before the scale name and `suffix`
+#'   (default = "").
+#' @param suffix Optional. A string to include at the end of the newly
+#'   calculated scale variables' names, after the scale name and `prefix`
+#'   (default = "_z").
+#' @param append Optional. A logical that determines whether the calculated
+#'   standardized scores should be added as columns to `data` in the output or
+#'   the standardized scores alone should be output (default = TRUE).
+#' @return A data frame that contains the self-standardized versions of
+#'   `scales`.
+#' @export
+#' @family tidying functions
+#' @examples
+#' self_standardize(aw2009, scales = 1:8)
+self_standardize <- function(data, scales, na.rm = TRUE,
+                             prefix = "", suffix = "_z", append = TRUE) {
+
+  stopifnot(is.data.frame(data) || is.matrix(data))
+  stopifnot(is_var(scales))
+  stopifnot(is_flag(na.rm))
+  stopifnot(is_char(prefix, n = 1))
+  stopifnot(is_char(suffix, n = 1))
+  stopifnot(is_flag(append))
+
+  scale_data <- data[scales]
+  scale_names <- colnames(scale_data)
+
+  scores <- matrix(NA, nrow = nrow(scale_data), ncol = length(scales))
+  colnames(scores) <- paste0(prefix, scale_names, suffix)
+
+  for (i in 1:length(scales)) {
+    m_i <- mean(scale_data[[i]], na.rm = na.rm)
+    s_i <- sd(scale_data[[i]], na.rm = na.rm)
+    scores[, i] <- (scale_data[[i]] - m_i) / s_i
+  }
+  scores[is.nan(scores)] <- NA_real_
+
+  if (append) {
+    cbind(data, scores)
+  } else {
+    as.data.frame(scores) 
+  }
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -31,6 +31,7 @@ reference:
   - ipsatize
   - score
   - norm_standardize
+  - self_standardize
 - title: Primary SSM Functions
   desc: Functions for implementing the Structural Summary Method
   contents:

diff --git a/man/anchors.Rd b/man/anchors.Rd
diff --git a/man/instrument.Rd b/man/instrument.Rd
diff --git a/man/instruments.Rd b/man/instruments.Rd
diff --git a/man/ipsatize.Rd b/man/ipsatize.Rd
diff --git a/man/items.Rd b/man/items.Rd
diff --git a/man/norm_standardize.Rd b/man/norm_standardize.Rd
diff --git a/man/norms.Rd b/man/norms.Rd
diff --git a/man/scales.Rd b/man/scales.Rd
diff --git a/man/score.Rd b/man/score.Rd
diff --git a/man/self_standardize.Rd b/man/self_standardize.Rd
diff --git a/vignettes/intermediate-ssm-analysis.Rmd b/vignettes/intermediate-ssm-analysis.Rmd
@@ -115,7 +115,7 @@ ssm_table(results3, render = FALSE) %>%
 ssm_plot_circle(results3)
 ```
 
-Note that the borders for the "PARDPD: Male" and "SZTPD: Male" blocks are dashed instead of solid. This indicates that these profiles have low fit (i.e., $R^2<.7$). We could alternatively hide these such profiles by adding `lowfit = FALSE` as below (noting that the color guide may change as profiles are dropped).
+Note that the borders for the "PARPD: Male" and "SZTPD: Male" blocks are dashed instead of solid. This indicates that these profiles have low fit (i.e., $R^2<.7$). We could alternatively hide these such profiles by adding `drop_lowfit = TRUE` as below (noting that the color guide may change as profiles are dropped).
 
 ```{r general_plot2, fig.width = 7.5, fig.height = 4, out.width = "100%"}
 ssm_plot_circle(results3, drop_lowfit = TRUE)