work on testing suite

tests/testthat/_snaps/ssm_oop.md

@@ -0,0 +1,16 @@
+# unit classes are working
+
+    Code
+      octants()
+    Output
+      90 135 180 225 270 315 360 45 
+      Degrees
+
+---
+
+    Code
+      as_radian(octants())
+    Output
+      1.571 2.356 3.142 3.927 4.712 5.498 6.283 0.785 
+      Radians
+

tests/testthat/_snaps/ssm_table.md

@@ -0,0 +1,18 @@
+# ssm_table is correct
+
+    Code
+      ssm_table(res, render = FALSE)
+    Output
+        Profile         Elevation           X.Value              Y.Value
+      1     All 0.92 (0.89, 0.95) 0.35 (0.32, 0.38) -0.25 (-0.28, -0.22)
+                Amplitude         Displacement   Fit
+      1 0.43 (0.40, 0.46) 324.3 (320.9, 328.0) 0.878
+
+---
+
+    Code
+      ssm_table(res, drop_xy = TRUE, render = FALSE)
+    Output
+        Profile         Elevation         Amplitude         Displacement   Fit
+      1     All 0.92 (0.89, 0.95) 0.43 (0.40, 0.46) 324.3 (320.9, 328.0) 0.878
+

tests/testthat/test-ssm_oop.R

@@ -65,3 +65,8 @@ test_that("The ssm display methods is working", {
   expect_output(print(res), "# Contrast \\[PARPD: Male - Female\\]:")
   expect_output(summary(res), "Statistical Basis:\\t Correlation Scores")
 })
+
+test_that("unit classes are working", {
+  expect_snapshot(octants())
+  expect_snapshot(as_radian(octants()))
+})

tests/testthat/test-ssm_visualization.R → tests/testthat/test-ssm_plot.R

@@ -67,45 +67,3 @@ test_that("Removing plots with low fit works as expected", {
   res <- ssm_analyze(jz2017, scales = 2:9, measures = "OCPD")
   expect_error(ssm_plot_circle(res, drop_lowfit = TRUE))
 })
-
-test_that("SSM Table captions are correct", {
-  data("jz2017")
-  res <- ssm_analyze(jz2017, scales = 2:9)
-  expect_equal(
-    dcaption(res),
-    "Mean-based Structural Summary Statistics with 95% CIs"
-  )
-
-  res <- ssm_analyze(
-    jz2017,
-    scales = 2:9,
-    grouping = "Gender",
-    contrast = TRUE
-  )
-  expect_equal(
-    dcaption(res),
-    "Mean-based Structural Summary Statistic Contrasts with 95% CIs"
-  )
-
-  res <- ssm_analyze(
-    jz2017, 
-    scales = 2:9, 
-    measures = "PARPD"
-  )
-  expect_equal(
-    dcaption(res),
-    "Correlation-based Structural Summary Statistics with 95% CIs"
-  )
-
-  res <- ssm_analyze(
-    jz2017,
-    scales = 2:9,
-    measures = "PARPD",
-    grouping = "Gender", 
-    contrast = TRUE
-  )
-  expect_equal(
-    dcaption(res),
-    "Correlation-based Structural Summary Statistic Contrasts with 95% CIs"
-  )
-})

tests/testthat/test-ssm_table.R

@@ -0,0 +1,49 @@
+test_that("SSM Table captions are correct", {
+  data("jz2017")
+  res <- ssm_analyze(jz2017, scales = 2:9)
+  expect_equal(
+    dcaption(res),
+    "Mean-based Structural Summary Statistics with 95% CIs"
+  )
+
+  res <- ssm_analyze(
+    jz2017,
+    scales = 2:9,
+    grouping = "Gender",
+    contrast = TRUE
+  )
+  expect_equal(
+    dcaption(res),
+    "Mean-based Structural Summary Statistic Contrasts with 95% CIs"
+  )
+
+  res <- ssm_analyze(
+    jz2017, 
+    scales = 2:9, 
+    measures = "PARPD"
+  )
+  expect_equal(
+    dcaption(res),
+    "Correlation-based Structural Summary Statistics with 95% CIs"
+  )
+
+  res <- ssm_analyze(
+    jz2017,
+    scales = 2:9,
+    measures = "PARPD",
+    grouping = "Gender", 
+    contrast = TRUE
+  )
+  expect_equal(
+    dcaption(res),
+    "Correlation-based Structural Summary Statistic Contrasts with 95% CIs"
+  )
+})
+
+
+test_that("ssm_table is correct", {
+  data("jz2017")
+  res <- ssm_analyze(jz2017, scales = 2:9)
+  expect_snapshot(ssm_table(res, render = FALSE))
+  expect_snapshot(ssm_table(res, drop_xy = TRUE, render = FALSE))
+})

tests/testthat/test-tidying_functions.R

@@ -15,6 +15,9 @@ test_that("score works", {
     matrix(sample(0:4, size = 32 * 5, replace = TRUE), nrow = 5, ncol = 32)
   )
   new <- score(old, items = 1:32, instrument = instrument("iipsc"))
+  new2 <- score(old, items = 1:32, instrument = instrument("iipsc"), 
+                append = FALSE)
+
   expect_equal(new$PA, c(0.5, 1.25, 2, 0.75, 3.5))
   expect_equal(new$BC, c(1.75, 0.75, 1.5, 1.75, 1.75))
   expect_equal(new$DE, c(1.75, 2.25, 1.75, 3, 3))
@@ -24,6 +27,7 @@ test_that("score works", {
   expect_equal(new$LM, c(2, 2.5, 1.5, 2.75, 1.5))
   expect_equal(new$NO, c(1.75, 2, 1.75, 2.25, 2.5))
   expect_error(score(old, 1:30, instrument("iipsc")))
+  expect_equal(ncol(new), ncol(new2) + ncol(old))
 })
 
 test_that("norm_standardize works", {
@@ -37,6 +41,13 @@ test_that("norm_standardize works", {
     instrument = instrument("iipsc"), 
     sample = 1
   )
+  new2 <- norm_standardize(
+    old, 
+    scales = 1:8,
+    instrument = instrument("iipsc"),
+    sample = 1,
+    append = FALSE
+  )
   expect_equal(round(new$X1_z, 4), c(3.2176, 4.1562, 3.4605, 4.2189, 1.6150))
   expect_equal(round(new$X2_z, 4), c(-0.1841, 0.7361, 1.8035, 3.07, 4.5891))
   expect_equal(round(new$X3_z, 4), c(-0.8911, -0.3398, 2.3892, -1.0473, 0.7776))
@@ -45,4 +56,8 @@ test_that("norm_standardize works", {
   expect_equal(round(new$X6_z, 4), c(0.2045, 1.653, 0.9281, -0.562, 0.649))
   expect_equal(round(new$X7_z, 4), c(2.0691, -1.7467, -0.8656, 1.5301, 0.0187))
   expect_equal(round(new$X8_z, 4), c(0.5269, 3.0627, 3.2395, 1.8059, -0.6111))
+  expect_error(norm_standardize(
+    old, scales = 1:7, instrument = instrument("iipsc", sample = 1)
+  ))
+  expect_equal(ncol(new), ncol(new2) + ncol(old))
 })