Added getAttenuatedR() and tweakes to whichSetOfN().

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: CECPfuns
 Type: Package
 Title: Package of Utility Functions for Psychological Therapies, Mental Health and Well-being Work (Created by Chris Evans and Clara Paz)
-Version: 0.0.0.9051
+Version: 0.0.0.9052
 Maintainer: Chris Evans <[email protected]>
 Description: This should evolve into a repository of all the functions that I (CE)
   and Clara Paz (CP) have created (so far only CE!) and tested enough to

NAMESPACE

@@ -8,6 +8,7 @@ export(convertClipboardAuthorNames)
 export(convertToCEdate)
 export(convertVector2sentence)
 export(convertVectorToSentence)
+export(getAttenuatedR)
 export(getBootCICSC)
 export(getBootCICorr)
 export(getBootCIalpha)

NEWS.md

@@ -1,5 +1,9 @@
+# Version 0.0.0.9052
+Added getAttenuatedR() and tweakes to whichSetOfN().
+
 # Version 0.0.0.9051
 Added whichSetOfN(), some cleaning and updating and resynchronised these version numbers between this file and DESCRIPTION.
+
 # Version 0.0.0.9050
 Fixed essentially cosmetic bug in plotQuantileCIsfromDat() (CI as percentage in plot label wrong: it showed .1 of what it should have been!) and more serious bug in getCIforQuantiles() that it was always using 95% for the CI not what was entered. Would only have affected things if someone wanted another CI so I think impact zero!
 

R/getAttenuatedR.R

@@ -0,0 +1,80 @@
+#' Function that gives the attenuated R for an unattenuated R and two reliability values
+#' @description
+#' This is just the conventional formula for the attenuation of a (Pearson) correlation by unreliability.
+#'
+#' @param unattR unattenuated R
+#' @param rel1 reliability of first of the variables (order of variables is arbitrary)
+#' @param rel2 reliability of second of the variables (order of variables is arbitrary)
+#'
+#' @return numeric: attenuated correlation
+#'
+#' @family utility functions
+#'
+#' @section Background:
+#' This is ancient psychometrics but still of some use.  For more information, see:
+#' \href{https://www.psyctc.org/psyctc/glossary2/attenuation-by-unreliability-of-measurement/}{OMbook glossary entry for attenuation}
+#' The formula is simple:
+#' \loadmathjax{}
+#'
+#' \mjdeqn{correctedCorr=observedCorr*\sqrt{rel_{1}*rel_{2}}}{}
+#'
+#' The short summary is that unreliability in the measurement of both variables involved in a correlation
+#' always reduces the observed correlation between the variables from what it would have been had the
+#' variables been measured with no unreliability (which is essentially impossible for any self-report measures
+#' and pretty much any measures used in our fields.
+#'
+#'
+#' @export
+#'
+#' @examples
+#' getAttenuatedR(.9, .7, .8)
+#'
+#'
+#'
+#' @author Chris Evans
+#' @section History/development log:
+#' Started 12.x.24
+#'
+getAttenuatedR <- function(unattR, rel1, rel2) {
+  ### sanity checking
+  if (!is.numeric(unattR)) {
+    stop(paste0("You input ",
+                unattR,
+                " for unattR, it must be numeric. Fix it!!"
+    ))
+  }
+  if (!is.numeric(rel1)) {
+    stop(paste0("You input ",
+                rel1,
+                " for rel1, it must be numeric. Fix it!!"
+    ))
+  }
+  if (!is.numeric(rel2)) {
+    stop(paste0("You input ",
+                rel2,
+                " for rel2, it must be numeric. Fix it!!"
+    ))
+  }
+  if (unattR < -1 | unattR > 1) {
+    stop("unattr must be between -1 and +1.")
+  }
+  if (rel1 < .01 | rel1 >= 1) {
+    stop("For this function rel1 must be between .01 and 1.0.")
+  }
+  if (rel2 < .01 | rel2 >= 1) {
+    stop("For this function rel2 must be between .01 and 1.0.")
+  }
+  if (length(unattR) > 1) {
+    stop("Sorry, you entered more than one value for unattr, this function only handles single values.")
+  }
+  if (length(rel1) > 1) {
+    stop("Sorry, you entered more than one value for rel, this function only handles single values.")
+  }
+  if (length(rel2) > 1) {
+    stop("Sorry, you entered more than one value for rel2, this function only handles single values.")
+  }
+
+  ### OK, do it!
+  unattR * sqrt(rel1 * rel2)
+}
+

R/whichSetofN.R

@@ -31,13 +31,21 @@ whichSetOfN <- function(x, n){
   if (x[1] <= 0) {
     stop("Index number, x, must be 1 or higher")
   }
+  if (!is.numeric(x[1])) {
+    stop("Index number, x, must be numeric")
+  }
   if (abs(x[1] - round(x[1])) > .05) {
     warning(paste0("The x value you input: ",
                    x[1],
                    " is not an integer, is this really what you want?"))
   }
+  if (!is.numeric(n)) {
+    stop(paste0("Set size, n, must be 2 or higher. You entered ",
+                n))
+  }
   if (n <= 2) {
-    stop("Set size must be 2 or higher")
+    stop(paste0("Set size, n, must be 2 or higher. You entered ",
+                n))
   }
   if (abs(n - round(n)) > .0000005) {
     stop(paste0("The n value you input: ",

tests/testthat/test-getAttenuatedR.R

@@ -0,0 +1,23 @@
+testthat::test_that("sanity checks work", {
+  testthat::expect_error(getAttenuatedR("A", .7, .7))
+  testthat::expect_error(getAttenuatedR(.9, "A", .7))
+  testthat::expect_error(getAttenuatedR(.9, .7, "A"))
+  testthat::expect_error(getAttenuatedR(c(.9, .7), "A", .7))
+  testthat::expect_error(getAttenuatedR(.9, c(.7, .8), .7))
+  testthat::expect_error(getAttenuatedR(.9, .7, c(.7, .8)))
+  testthat::expect_error(getAttenuatedR(-2, .7, .7))
+  testthat::expect_error(getAttenuatedR(1.2, .7, .7))
+  testthat::expect_error(getAttenuatedR(.8, .0001, .7))
+  testthat::expect_error(getAttenuatedR(.8, .7, .0001))
+  testthat::expect_error(getAttenuatedR(.8, 1.2, .7))
+  testthat::expect_error(getAttenuatedR(.8, .7, 1.2))
+})
+
+## test warnings
+
+### test of outputs
+testthat::test_that("Output correct", {
+  set.seed(12345)
+  testthat::expect_equal(getAttenuatedR(.9, .7, .7),
+                         .63)
+})

tests/testthat/whichSetOfN.R → tests/testthat/test-whichSetOfN.R

@@ -1,10 +1,12 @@
 testthat::test_that("sanity checks work", {
   testthat::expect_error(whichSetOfN(0, 3))
   testthat::expect_error(whichSetOfN(-1:3, 3))
-    testthat::expect_error(whichSetOfN(3, -3))
+  testthat::expect_error(whichSetOfN(3, -3))
   testthat::expect_error(whichSetOfN(3, 0))
   testthat::expect_error(whichSetOfN(3, 1))
   testthat::expect_error(whichSetOfN(3, 2.1))
+  testthat::expect_error(whichSetOfN("A", 3))
+  testthat::expect_error(whichSetOfN(3, "A"))
 })
 
 ## test warnings