From 0683582f3f0bba702bdb3529bbd20835d754a036 Mon Sep 17 00:00:00 2001 From: SiWen314 Date: Fri, 9 Aug 2024 15:35:04 -0400 Subject: [PATCH] Create test function for doing limits of agreement analysis on a split plot study data --- .../tests/testthat/test_limitsOfAgreement.R | 18 +-- .../test_limitsOfAgreement_splitPlot.R | 115 ++++++++++++++++++ .../test_limitsOfAgreement_splitPlot.rda | Bin 0 -> 785 bytes 3 files changed, 124 insertions(+), 9 deletions(-) create mode 100644 Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.R create mode 100644 Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.rda diff --git a/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement.R b/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement.R index c7186a63..e6dc63f4 100644 --- a/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement.R +++ b/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement.R @@ -1,7 +1,7 @@ library(testthat) library(iMRMC) -testthat::context("limitsOfAgreement") +context("limitsOfAgreement") # Simulate data ############################################################### @@ -57,33 +57,33 @@ if(saveData){ # laWRBM output ##################### -testthat::test_that( +test_that( "laWRBM output does not change", { - testthat::expect_equal(target_laWRBM, result_laWRBM, tolerance = 1e-6) + expect_equal(target_laWRBM, result_laWRBM, tolerance = 1e-6) } ) # laBRBM output ##################### -testthat::test_that( +test_that( "laBRBM output does not change", { - testthat::expect_equal(target_laBRBM, result_laBRBM, tolerance = 1e-6) + expect_equal(target_laBRBM, result_laBRBM, tolerance = 1e-6) } ) # laBRWM output ##################### -testthat::test_that( +test_that( "laBRWM output does not change", { - testthat::expect_equal(target_laBRWM, result_laBRWM, tolerance = 1e-6) + expect_equal(target_laBRWM, result_laBRWM, tolerance = 1e-6) } ) # laWRWM output ##################### -testthat::test_that( +test_that( "laWRWM output does not change", { - testthat::expect_equal(target_laWRWM, result_laWRWM, tolerance = 1e-6) + expect_equal(target_laWRWM, result_laWRWM, tolerance = 1e-6) } ) diff --git a/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.R b/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.R new file mode 100644 index 00000000..b54ba32d --- /dev/null +++ b/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.R @@ -0,0 +1,115 @@ +library(testthat) +library(iMRMC) + +context("limitsOfAgreement") + +# Simulate data ############################################################### + +# initialize the random number generator +init.lecuyerRNG(stream = 1) + +# Create a sample configuration file +config <- sim.NormalIG.Hierarchical.config(nR=9, nC=99, + modalityID = c("testA","testB")) + +# Simulate an MRMC agreement data set +dFrame.imrmc <- sim.NormalIG.Hierarchical(config) + +# Create a split-plot data set ################################################ +nG <- 3 + +# Determine reader groups +readerGroups <- createGroups(levels(dFrame.imrmc$readerID), nG) +names(readerGroups) <- c("readerID", "readerGroup") +df <- merge(dFrame.imrmc, readerGroups) + +# Determine case groups +caseGroups <- createGroups(levels(factor(dFrame.imrmc$caseID)), nG) +names(caseGroups) <- c("caseID", "caseGroup") +df <- merge(df, caseGroups) + +# Create split-plot data +df <- df[df$caseGroup == df$readerGroup, ] +df$caseID <- factor(df$caseID) + +# Visualize the design matrix of each modality +dA <- convertDFtoDesignMatrix(df, modality = "testA", dropFlag = FALSE) +dB <- convertDFtoDesignMatrix(df, modality = "testB", dropFlag = FALSE) + +image(dA) +image(dB) + + + +# Do the analysis ############################################################## + +# Do the within-reader between-modality limits of ageement analysis +result_laWRBM <- laWRBM(df) + +# Do the between-reader between-modality limits of agreement analysis +result_laBRBM <- laBRBM(df) + +# Do the between-reader within-modality limits of agreement analysis +result_laBRWM <- laBRWM(df) + +# Do the within-reader within-modality limits of agreement analysis +result_laWRWM <- laWRWM(df) + + +# Test ######################################################################### + +saveData <- FALSE +fileName <-"test_limitsOfAgreement_splitPlot.rda" + +if(saveData){ + # Save the result to a file for future comparisons + target_laWRBM <- result_laWRBM + target_laBRBM <- result_laBRBM + target_laBRWM <- result_laBRWM + target_laWRWM <- result_laWRWM + + save(target_laWRBM, target_laBRBM, target_laBRWM, target_laWRWM, + file = file.path("tests", "testthat", fileName)) + +}else{ + + # Recover the expected results + if (!file.exists(fileName)) { + fileName <- file.path("tests", "testthat", fileName) + } + load(fileName) + +} + +# laWRBM output ##################### + +test_that( + "laWRBM output does not change", { + expect_equal(target_laWRBM, result_laWRBM, tolerance = 1e-6) + } +) + +# laBRBM output ##################### + +test_that( + "laBRBM output does not change", { + expect_equal(target_laBRBM, result_laBRBM, tolerance = 1e-6) + } +) + +# laBRWM output ##################### + +test_that( + "laBRWM output does not change", { + expect_equal(target_laBRWM, result_laBRWM, tolerance = 1e-6) + } +) + +# laWRWM output ##################### + +test_that( + "laWRWM output does not change", { + expect_equal(target_laWRWM, result_laWRWM, tolerance = 1e-6) + } +) + diff --git a/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.rda b/Rpackage/iMRMC/tests/testthat/test_limitsOfAgreement_splitPlot.rda new file mode 100644 index 0000000000000000000000000000000000000000..bbea33b597f19fa404f8ce24f16dcba73bcd056d GIT binary patch literal 785 zcmV+s1Md7EiwFP!000001`BeDFy@NjVqjokW?*4tVqj(kG8x#M0}PE!jTjhMn1DP+ z1{MZRAkABnSd^Yx5}%V89^~Z9z`!I76a*?@2GQ(5%m-4u|3aqz^`&!W!T9#wYo@2n zdwm7Y|Ecb5YGE%6SAXvxr?392dN_ZsYntMg*8wp80oHA-U#uig!uSr1vv>Xr*t8hU zajbcXxv9lKh5*4h0`Wj{XpT$HNi2pr4kpNzl30?cmsSLHH=1(JqWp3_WdFb-}$FExzk|s`x`?P zo@Y&(ZvS82dB(vf9t^LsJ0Lf2cc{q3&QxfrTDZa4?j`3=Btza%PxvoIYhi zH;|(!H8CZ%$kPQDjLC_`sc;^vYf({t5yamp?qPx|5YEZW%`7R_%TLowOfO1J%}vcK zfhXGXe7*9-NKD{sC0RM{}cy4a8hS*$OI?#5C>CGQs?o3>9=1Vag+D0qO1MKE%%I% z?%!Vzwx4~G{q~-p+DCXM?Jopng()%iPr+Hi&3+FkD+r|0IxDafl@+*h^HUOYGD|Aq zBK$D*RwxRE;lda?1R)ABB`C>f{3RJc0ittSIL@5LfB;ze_BSmh4xh`qK&<-xpVwde z@Lb9dt{=`HJ~=I%yh=g0RN$Lzse?m9z_aG3zT6IuZ>HsD&07YOw{O*7dor@5%Ki`2 z+9&CJ@%G1`$v(HZ+%cjmg>XueDq2&Akop76EAIbvO*3PFR|+uxa7n7+w+jFO6EJl> literal 0 HcmV?d00001