fix and add tests

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

Hide file tree

Showing 27 changed files with 53 additions and 104 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,11 @@
 # circumplex (development version)
 
+## New features
+
+* Add the `self_standardize()` function for standardizing variables using sample means and SDs
+
+## Minor improvements and fixes
+
 * Fix some typos in documentation
 
 # circumplex 1.0.0

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -13,10 +13,6 @@ angle_median <- function(x) {
     .Call(`_circumplex_angle_median`, x)
 }
 
-compare_pi <- function(x) {
-    .Call(`_circumplex_compare_pi`, x)
-}
-
 ssm_parameters_cpp <- function(scores, angles) {
     .Call(`_circumplex_ssm_parameters_cpp`, scores, angles)
 }

diff --git a/R/instrument_data.R b/R/instrument_data.R
@@ -8,7 +8,6 @@
 #' @source \doi{10.1207/s15327752jpa8703_12}
 #' @keywords internal
 #' @examples
-#' instrument("cais")
 #' summary(cais)
 #' scales(cais, items = TRUE)
 "cais"
@@ -25,7 +24,6 @@
 #' @source \url{https://www.webpages.uidaho.edu/klocke/csie.htm}
 #' @keywords internal
 #' @examples
-#' instrument("csie")
 #' summary(csie)
 #' scales(csie, items = TRUE)
 "csie"
@@ -40,7 +38,6 @@
 #' @source \url{https://www.webpages.uidaho.edu/klocke/csig.htm}
 #' @keywords internal
 #' @examples
-#' instrument("csig")
 #' summary(csig)
 #' scales(csig, items = TRUE)
 "csig"
@@ -55,7 +52,6 @@
 #' @source \doi{10.1037/pas0000505}
 #' @keywords internal
 #' @examples
-#' instrument("csip")
 #' summary(csip)
 #' scales(csip, items = TRUE)
 "csip"
@@ -70,7 +66,6 @@
 #' @source \url{https://www.webpages.uidaho.edu/klocke/csiv.htm}
 #' @keywords internal
 #' @examples
-#' instrument("csiv")
 #' summary(csiv)
 #' scales(csiv, items = TRUE)
 "csiv"
@@ -86,7 +81,6 @@
 #' @source \doi{10.1080/00223891.2024.2400266}
 #' @keywords internal
 #' @examples
-#' instrument("iei")
 #' summary(iei)
 #' scales(iei, items = TRUE)
 "iei"
@@ -102,7 +96,6 @@
 #' @source \doi{10.1177/1073191111411672}
 #' @keywords internal
 #' @examples
-#' instrument("igicr")
 #' summary(igicr)
 #' scales(igicr, items = TRUE)
 "igicr"
@@ -120,7 +113,6 @@
 #' @source \url{https://www.mindgarden.com/113-inventory-of-interpersonal-problems}
 #' @keywords internal
 #' @examples
-#' instrument("iip32")
 #' summary(iip32)
 "iip32"
 
@@ -136,7 +128,6 @@
 #' @source \url{https://www.mindgarden.com/113-inventory-of-interpersonal-problems}
 #' @keywords internal
 #' @examples
-#' instrument("iip64")
 #' summary(iip64)
 "iip64"
 
@@ -151,7 +142,6 @@
 #' @source \doi{10.1080/00223890802388665}
 #' @keywords internal
 #' @examples
-#' instrument("iipsc")
 #' summary(iipsc)
 "iipsc"
 
@@ -166,7 +156,6 @@
 #' @source \doi{10.1080/00223891.2012.681818}
 #' @keywords internal
 #' @examples
-#' instrument("iis32")
 #' summary(iis32)
 #' scales(iis32, items = TRUE)
 "iis32"
@@ -181,7 +170,6 @@
 #' @source \doi{10.1037/a0017269}
 #' @keywords internal
 #' @examples
-#' instrument("iis64")
 #' summary(iis64)
 #' scales(iis64, items = TRUE)
 "iis64"
@@ -196,7 +184,6 @@
 #' @source \doi{10.1177/1073191119864661}
 #' @keywords internal
 #' @examples
-#' instrument("iitc")
 #' summary(iitc)
 #' scales(iitc, items = TRUE)
 "iitc"
@@ -210,7 +197,6 @@
 #' @source \doi{10.1177/1073191109340382}
 #' @keywords internal
 #' @examples
-#' instrument("ipipipc")
 #' summary(ipipipc)
 #' scales(ipipipc, items = TRUE)
 "ipipipc"
@@ -225,7 +211,6 @@
 #' @source \doi{10.1111/j.1467-6494.2011.00696.x}
 #' @keywords internal
 #' @examples
-#' instrument("isc")
 #' summary(isc)
 #' scales(isc, items = TRUE)
 "isc"
diff --git a/R/tidying_functions.R b/R/tidying_functions.R
@@ -81,7 +81,6 @@ ipsatize <- function(data, items, na.rm = TRUE,
 #' @export
 #' @examples
 #' data("raw_iipsc")
-#' instrument("iipsc")
 #' score(raw_iipsc, items = 1:32, instrument = iipsc, prefix = "IIPSC_")
 score <- function(data, items, instrument, na.rm = TRUE, 
                   prefix = "", suffix = "", append = TRUE) {
@@ -153,7 +152,6 @@ score <- function(data, items, instrument, na.rm = TRUE,
 #' @family tidying functions
 #' @examples
 #' data("jz2017")
-#' instrument("iipsc")
 #' norm_standardize(jz2017, scales = 2:9, instrument = iipsc, sample = 1)
 norm_standardize <- function(data, scales, angles = octants(), instrument, 
                        sample = 1, prefix = "", suffix = "_z", append = TRUE) {
@@ -236,15 +234,13 @@ self_standardize <- function(data, scales, na.rm = TRUE,
 
   scale_data <- data[scales]
   scale_names <- colnames(scale_data)
+
+  zscore <- function(x, na.rm = na.rm) {
+    (x - mean(x, na.rm = na.rm)) / stats::sd(x, na.rm = na.rm)
+  }
 
-  scores <- matrix(NA, nrow = nrow(scale_data), ncol = length(scales))
+  scores <- sapply(scale_data, FUN = zscore, na.rm = na.rm)
   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) {

diff --git a/man/cais.Rd b/man/cais.Rd
diff --git a/man/csie.Rd b/man/csie.Rd
diff --git a/man/csig.Rd b/man/csig.Rd
diff --git a/man/csip.Rd b/man/csip.Rd
diff --git a/man/csiv.Rd b/man/csiv.Rd
diff --git a/man/iei.Rd b/man/iei.Rd
diff --git a/man/igicr.Rd b/man/igicr.Rd
diff --git a/man/iip32.Rd b/man/iip32.Rd
diff --git a/man/iip64.Rd b/man/iip64.Rd
diff --git a/man/iipsc.Rd b/man/iipsc.Rd
diff --git a/man/iis32.Rd b/man/iis32.Rd
diff --git a/man/iis64.Rd b/man/iis64.Rd
diff --git a/man/iitc.Rd b/man/iitc.Rd
diff --git a/man/ipipipc.Rd b/man/ipipipc.Rd
diff --git a/man/isc.Rd b/man/isc.Rd
diff --git a/man/norm_standardize.Rd b/man/norm_standardize.Rd
diff --git a/man/score.Rd b/man/score.Rd
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -45,17 +45,6 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
-// compare_pi
-NumericVector compare_pi(NumericVector x);
-RcppExport SEXP _circumplex_compare_pi(SEXP xSEXP) {
-BEGIN_RCPP
-    Rcpp::RObject rcpp_result_gen;
-    Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP);
-    rcpp_result_gen = Rcpp::wrap(compare_pi(x));
-    return rcpp_result_gen;
-END_RCPP
-}
 // ssm_parameters_cpp
 arma::vec ssm_parameters_cpp(arma::vec scores, arma::vec angles);
 RcppExport SEXP _circumplex_ssm_parameters_cpp(SEXP scoresSEXP, SEXP anglesSEXP) {
@@ -135,7 +124,6 @@ static const R_CallMethodDef CallEntries[] = {
     {"_circumplex_angle_mean", (DL_FUNC) &_circumplex_angle_mean, 1},
     {"_circumplex_angle_dev", (DL_FUNC) &_circumplex_angle_dev, 2},
     {"_circumplex_angle_median", (DL_FUNC) &_circumplex_angle_median, 1},
-    {"_circumplex_compare_pi", (DL_FUNC) &_circumplex_compare_pi, 1},
     {"_circumplex_ssm_parameters_cpp", (DL_FUNC) &_circumplex_ssm_parameters_cpp, 2},
     {"_circumplex_group_parameters", (DL_FUNC) &_circumplex_group_parameters, 2},
     {"_circumplex_col_means", (DL_FUNC) &_circumplex_col_means, 1},

diff --git a/src/circular.cpp b/src/circular.cpp
@@ -57,18 +57,3 @@ double angle_median(NumericVector x) {
   // The median is the angular mean of these candidates
   return angle_mean(candidates);
 }
-
-// Rescale to between -pi and pi radians (or -180 and 180 degrees)
-// [[Rcpp::export]]
-NumericVector compare_pi(NumericVector x) {
-  int n = x.size();
-  NumericVector y = clone(x);
-  for (int i(0); i < n; i++) {
-    // If less than -PI, add 2 * PI
-    y[i] = (y[i] < -M_PI) ? (y[i] + (2 * M_PI)) : (y[i]);
-    // If greater than PI, subtract 2 * PI
-    y[i] = (y[i] > M_PI) ? (y[i] - (2 * M_PI)) : (y[i]);
-    // If between -PI and PI, leave as is
-  }
-  return y;
-}
diff --git a/tests/testthat/_snaps/instrument_oop.md b/tests/testthat/_snaps/instrument_oop.md
@@ -410,18 +410,19 @@
 # The instruments function produces the expected output
 
     The circumplex package currently includes 14 instruments:
-     1. CSIE: Circumplex Scales of Interpersonal Efficacy (csie)
-     2. CSIG: Circumplex Scales of Intergroup Goals (csig)
-     3. CSIP: Circumplex Scales of Interpersonal Problems (csip)
-     4. CSIV: Circumplex Scales of Interpersonal Values (csiv)
-     5. IEI: Interpersonal Emotion Inventory (iei)
-     6. IGI-CR: Interpersonal Goals Inventory for Children, Revised Version (igicr)
-     7. IIP-32: Inventory of Interpersonal Problems, Brief Version (iip32)
-     8. IIP-64: Inventory of Interpersonal Problems (iip64)
-     9. IIP-SC: Inventory of Interpersonal Problems, Short Circumplex (iipsc)
-     10. IIS-32: Inventory of Interpersonal Strengths, Brief Version (iis32)
-     11. IIS-64: Inventory of Interpersonal Strengths (iis64)
-     12. IIT-C: Inventory of Influence Tactics Circumplex (iitc)
-     13. IPIP-IPC: IPIP Interpersonal Circumplex (ipipipc)
-     14. ISC: Interpersonal Sensitivities Circumplex (isc)
+     1. CAIS: Child and Adolescent Interpersonal Survey (cais)
+     2. CSIE: Circumplex Scales of Interpersonal Efficacy (csie)
+     3. CSIG: Circumplex Scales of Intergroup Goals (csig)
+     4. CSIP: Circumplex Scales of Interpersonal Problems (csip)
+     5. CSIV: Circumplex Scales of Interpersonal Values (csiv)
+     6. IEI: Interpersonal Emotion Inventory (iei)
+     7. IGI-CR: Interpersonal Goals Inventory for Children, Revised Version (igicr)
+     8. IIP-32: Inventory of Interpersonal Problems, Brief Version (iip32)
+     9. IIP-64: Inventory of Interpersonal Problems (iip64)
+     10. IIP-SC: Inventory of Interpersonal Problems, Short Circumplex (iipsc)
+     11. IIS-32: Inventory of Interpersonal Strengths, Brief Version (iis32)
+     12. IIS-64: Inventory of Interpersonal Strengths (iis64)
+     13. IIT-C: Inventory of Influence Tactics Circumplex (iitc)
+     14. IPIP-IPC: IPIP Interpersonal Circumplex (ipipipc)
+     15. ISC: Interpersonal Sensitivities Circumplex (isc)