From e1ca9e99971048a80e5b8d5a650c071367ce0bfb Mon Sep 17 00:00:00 2001
From: Charlotte1031 <xuxinran2001@gmail.com>
Date: Mon, 16 Sep 2024 00:59:56 -0400
Subject: [PATCH] Add grade test cases for eugly, hyper, and hypo

---
 iglu                              |  1 +
 tests/testthat/test-ea1c.R        | 19 ++++++++++---------
 tests/testthat/test-grade.R       | 31 ++++++++++++++++++++++++++++---
 tests/testthat/test-grade_eugly.R | 31 +++++++++++++++++++++++++++++++
 tests/testthat/test-grade_hyper.R | 31 +++++++++++++++++++++++++++++++
 tests/testthat/test-grade_hypo.R  | 31 +++++++++++++++++++++++++++++++
 6 files changed, 132 insertions(+), 12 deletions(-)
 create mode 160000 iglu
 create mode 100644 tests/testthat/test-grade_eugly.R
 create mode 100644 tests/testthat/test-grade_hyper.R
 create mode 100644 tests/testthat/test-grade_hypo.R

diff --git a/iglu b/iglu
new file mode 160000
index 00000000..7a6a4e54
--- /dev/null
+++ b/iglu
@@ -0,0 +1 @@
+Subproject commit 7a6a4e54de6c2d898c20722392d458c3b66e5b01
diff --git a/tests/testthat/test-ea1c.R b/tests/testthat/test-ea1c.R
index 1f1e1814..891cb4db 100644
--- a/tests/testthat/test-ea1c.R
+++ b/tests/testthat/test-ea1c.R
@@ -1,16 +1,17 @@
-test_data = c(100, 120, 150, 200) # col 'gl'
-test_id = 'test 1' # col 'id'
-test_df <- data.frame(id = test_id, gl = test_data)
+
+test_df <- data.frame(id = 'test 1', gl = c(100, 120, 150, 200))
 
 test_out <- test_df %>%
   dplyr::group_by(id) %>%
-  dplyr::summarise(
-    eA1C = (46.7+mean(gl, na.rm = TRUE) )/28.7
-  )
-
-test_out$id = NULL
+  dplyr::mutate(
+    eA1C = (46.7 + sum(gl, na.rm = TRUE) / sum(!is.na(gl))) / 28.7
+  ) %>%
+  dplyr::ungroup() %>%
+  dplyr::select(-id)
 
 result =
-test_that("iglu::ea1c == base::ea1c", {
+  testthat::test_that("iglu::ea1c", {
   expect_equal(iglu::ea1c(test_data), test_out , tolerance = 0.0001)
 })
+
+
diff --git a/tests/testthat/test-grade.R b/tests/testthat/test-grade.R
index 8849056e..f1394ee6 100644
--- a/tests/testthat/test-grade.R
+++ b/tests/testthat/test-grade.R
@@ -1,3 +1,28 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
-})
+# Helper Function
+grade_formula_tester <- function(x){
+  grade = (425 * (log10(log10(x/18)) + 0.16)^2)
+  grade <- pmin(grade, 50)
+  return(grade)
+}
+
+# Test Case:
+test_df <- data.frame(id = 'test 1', gl = c(100, 120, 150, 200, NA))
+test1 = iglu::example_data_1_subject
+test2 = iglu::example_data_1_subject[1:300, ]
+test3 = iglu::example_data_5_subject
+
+test_out = data.frame(GRADE = mean(grade_formula_tester(test_df$gl)))
+
+out = iglu::grade(test3)$GRADE
+
+result =
+  testthat::test_that("iglu::grade", {
+    expect_equal(iglu::grade(test1)$GRADE, mean(grade_formula_tester(test1$gl)), tolerance = 0.0001)
+    expect_equal(iglu::grade(test2)$GRADE, mean(grade_formula_tester(test2$gl)), tolerance = 0.0001)
+    expect_equal(out[1], mean(grade_formula_tester(test3[test3$id=="Subject 1", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[2], mean(grade_formula_tester(test3[test3$id=="Subject 2", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[3], mean(grade_formula_tester(test3[test3$id=="Subject 3", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[4], mean(grade_formula_tester(test3[test3$id=="Subject 4", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[5], mean(grade_formula_tester(test3[test3$id=="Subject 5", ]$gl)), tolerance = 0.0001)
+  })
+
diff --git a/tests/testthat/test-grade_eugly.R b/tests/testthat/test-grade_eugly.R
new file mode 100644
index 00000000..56490bd0
--- /dev/null
+++ b/tests/testthat/test-grade_eugly.R
@@ -0,0 +1,31 @@
+# Helper Function
+grade_eugly_formula_tester <- function(gl, lower = 70, upper = 140){
+  grade = grade_formula_tester(gl)
+  grade_eugly = sum(grade[gl >= lower & gl <= upper ], na.rm = TRUE) /
+    sum(grade, na.rm = TRUE) * 100
+  return(grade_eugly)
+}
+
+# Test Case:
+test_df <- data.frame(id = 'test 1', gl = c(100, 120, 150, 200, NA))
+test1 = iglu::example_data_1_subject
+test2 = iglu::example_data_1_subject[1:300, ]
+test3 = iglu::example_data_5_subject
+
+test_out = data.frame(GRADE_eugly = mean(grade_eugly_formula_tester(test_df$gl)))
+
+out = iglu::grade_eugly(test3)$GRADE_eugly
+
+
+outresult =
+  testthat::test_that("iglu::grade_eugly", {
+    expect_equal(iglu::grade_eugly(test_df$gl)$GRADE_eugly, test_out$GRADE_eugly, tolerance = 0.0001)
+    expect_equal(iglu::grade_eugly(test1)$GRADE_eugly, mean(grade_eugly_formula_tester(test1$gl)), tolerance = 0.0001)
+    expect_equal(iglu::grade_eugly(test2)$GRADE_eugly, mean(grade_eugly_formula_tester(test2$gl)), tolerance = 0.0001)
+    expect_equal(out[1], mean(grade_eugly_formula_tester(test3[test3$id=="Subject 1", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[2], mean(grade_eugly_formula_tester(test3[test3$id=="Subject 2", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[3], mean(grade_eugly_formula_tester(test3[test3$id=="Subject 3", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[4], mean(grade_eugly_formula_tester(test3[test3$id=="Subject 4", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[5], mean(grade_eugly_formula_tester(test3[test3$id=="Subject 5", ]$gl)), tolerance = 0.0001)
+  })
+
diff --git a/tests/testthat/test-grade_hyper.R b/tests/testthat/test-grade_hyper.R
new file mode 100644
index 00000000..86815690
--- /dev/null
+++ b/tests/testthat/test-grade_hyper.R
@@ -0,0 +1,31 @@
+# Helper Function
+grade_hyper_formula_tester <- function(gl, upper = 140){
+  grade = grade_formula_tester(gl)
+  GRADE_hyper = sum(grade[gl > upper], na.rm = TRUE) /
+    sum(grade, na.rm = TRUE) * 100
+  return(GRADE_hyper)
+}
+
+# Test Case:
+test_df <- data.frame(id = 'test 1', gl = c(100, 120, 150, 200, NA))
+test1 = iglu::example_data_1_subject
+test2 = iglu::example_data_1_subject[1:300, ]
+test3 = iglu::example_data_5_subject
+
+test_out = data.frame(GRADE_hyper = mean(grade_hyper_formula_tester(test_df$gl)))
+
+out = iglu::grade_hyper(test3)$GRADE_hyper
+
+
+outresult =
+  testthat::test_that("iglu::grade_hyper", {
+    expect_equal(iglu::grade_hyper(test_df$gl)$GRADE_hyper, test_out$GRADE_hyper, tolerance = 0.0001)
+    expect_equal(iglu::grade_hyper(test1)$GRADE_hyper, mean(grade_hyper_formula_tester(test1$gl)), tolerance = 0.0001)
+    expect_equal(iglu::grade_hyper(test2)$GRADE_hyper, mean(grade_hyper_formula_tester(test2$gl)), tolerance = 0.0001)
+    expect_equal(out[1], mean(grade_hyper_formula_tester(test3[test3$id=="Subject 1", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[2], mean(grade_hyper_formula_tester(test3[test3$id=="Subject 2", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[3], mean(grade_hyper_formula_tester(test3[test3$id=="Subject 3", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[4], mean(grade_hyper_formula_tester(test3[test3$id=="Subject 4", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[5], mean(grade_hyper_formula_tester(test3[test3$id=="Subject 5", ]$gl)), tolerance = 0.0001)
+  })
+
diff --git a/tests/testthat/test-grade_hypo.R b/tests/testthat/test-grade_hypo.R
new file mode 100644
index 00000000..1273bf64
--- /dev/null
+++ b/tests/testthat/test-grade_hypo.R
@@ -0,0 +1,31 @@
+# Helper Function
+grade_hypo_formula_tester <- function(gl, lower = 80){
+  grade = grade_formula_tester(gl)
+  GRADE_hypo = sum(grade[gl < lower], na.rm = TRUE) /
+    sum(grade, na.rm = TRUE) * 100
+  return(GRADE_hypo)
+}
+
+# Test Case:
+test_df <- data.frame(id = 'test 1', gl = c(100, 120, 150, 200, NA))
+test1 = iglu::example_data_1_subject
+test2 = iglu::example_data_1_subject[1:300, ]
+test3 = iglu::example_data_5_subject
+
+test_out = data.frame(GRADE_hyper = mean(grade_hypo_formula_tester(test_df$gl)))
+
+out = iglu::grade_hypo(test3)$GRADE_hypo
+
+
+outresult =
+  testthat::test_that("iglu::grade_hypo", {
+    expect_equal(iglu::grade_hypo(test_df$gl)$GRADE_hypo, test_out$GRADE_hyper, tolerance = 0.0001)
+    expect_equal(iglu::grade_hypo(test1)$GRADE_hypo, mean(grade_hypo_formula_tester(test1$gl)), tolerance = 0.0001)
+    expect_equal(iglu::grade_hypo(test2)$GRADE_hypo, mean(grade_hypo_formula_tester(test2$gl)), tolerance = 0.0001)
+    expect_equal(out[1], mean(grade_hypo_formula_tester(test3[test3$id=="Subject 1", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[2], mean(grade_hypo_formula_tester(test3[test3$id=="Subject 2", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[3], mean(grade_hypo_formula_tester(test3[test3$id=="Subject 3", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[4], mean(grade_hypo_formula_tester(test3[test3$id=="Subject 4", ]$gl)), tolerance = 0.0001)
+    expect_equal(out[5], mean(grade_hypo_formula_tester(test3[test3$id=="Subject 5", ]$gl)), tolerance = 0.0001)
+  })
+