From bba8a3950fd5c9024bedfc92d31ac4a2fd49da45 Mon Sep 17 00:00:00 2001 From: Art Eschenlauer Date: Fri, 27 Dec 2019 12:22:59 -0600 Subject: [PATCH] changes to address issue 8 --- R/ClassFilter.R | 16 +- inst/NEWS | 16 +- tests/testthat/exp_cent_centroid_dm.tsv | 16 ++ tests/testthat/exp_cent_centroid_sm.tsv | 3 + tests/testthat/exp_cent_centroid_vm.tsv | 16 ++ tests/testthat/exp_cent_median_dm.tsv | 16 ++ tests/testthat/exp_cent_median_sm.tsv | 3 + tests/testthat/exp_cent_median_vm.tsv | 16 ++ tests/testthat/exp_cent_medoid_dm.tsv | 16 ++ tests/testthat/exp_cent_medoid_sm.tsv | 3 + tests/testthat/exp_cent_medoid_vm.tsv | 16 ++ tests/testthat/exp_cent_none_dm.tsv | 16 ++ tests/testthat/exp_cent_none_sm.tsv | 20 +++ tests/testthat/exp_cent_none_vm.tsv | 16 ++ tests/testthat/in_cent_dm.tsv | 17 +++ tests/testthat/in_cent_sm.tsv | 21 +++ tests/testthat/in_cent_vm.tsv | 17 +++ tests/testthat/test-center2.R | 189 ++++++++++++++++++++++++ 18 files changed, 423 insertions(+), 10 deletions(-) create mode 100644 tests/testthat/exp_cent_centroid_dm.tsv create mode 100644 tests/testthat/exp_cent_centroid_sm.tsv create mode 100644 tests/testthat/exp_cent_centroid_vm.tsv create mode 100644 tests/testthat/exp_cent_median_dm.tsv create mode 100644 tests/testthat/exp_cent_median_sm.tsv create mode 100644 tests/testthat/exp_cent_median_vm.tsv create mode 100644 tests/testthat/exp_cent_medoid_dm.tsv create mode 100644 tests/testthat/exp_cent_medoid_sm.tsv create mode 100644 tests/testthat/exp_cent_medoid_vm.tsv create mode 100644 tests/testthat/exp_cent_none_dm.tsv create mode 100644 tests/testthat/exp_cent_none_sm.tsv create mode 100644 tests/testthat/exp_cent_none_vm.tsv create mode 100644 tests/testthat/in_cent_dm.tsv create mode 100644 tests/testthat/in_cent_sm.tsv create mode 100644 tests/testthat/in_cent_vm.tsv create mode 100644 tests/testthat/test-center2.R diff --git a/R/ClassFilter.R b/R/ClassFilter.R index 8cc35a6..f15043e 100644 --- a/R/ClassFilter.R +++ b/R/ClassFilter.R @@ -755,10 +755,10 @@ w4m_filter_by_sample_class <- function( } metadata_order <- Reduce( - function(a1,a2) { + function(a1, a2) { order( - metadata_df[metadata_names,a1], - metadata_df[metadata_names,a2] + metadata_df[metadata_names, a1], + metadata_df[metadata_names, a2] ) }, order_split @@ -869,7 +869,6 @@ w4m_filter_by_sample_class <- function( treatments <- smpl_metadata[class_column][[1]] nrow_dm <- nrow(data_matrix) unitrts <- unique(treatments) - ntrts <- length(unitrts) smpl_metadata <- data.frame( trt = unitrts, n = sapply(X = unitrts, FUN = function(x) sum(x == treatments)), @@ -893,7 +892,7 @@ w4m_filter_by_sample_class <- function( stringsAsFactors = FALSE ) smpl_metadata_colnames <- colnames(smpl_metadata) - smpl_metadata$sampleMetadata <- smpl_metadata[,class_column] + smpl_metadata$sampleMetadata <- smpl_metadata[,"trt"] smpl_metadata <- smpl_metadata[c("sampleMetadata",smpl_metadata_colnames)] rownames(new_df) <- rownames(data_matrix) data_matrix <- as.matrix(new_df) @@ -902,7 +901,6 @@ w4m_filter_by_sample_class <- function( treatments <- smpl_metadata[class_column][[1]] nrow_dm <- nrow(data_matrix) unitrts <- unique(treatments) - ntrts <- length(unitrts) smpl_metadata <- data.frame( trt = unitrts, n = sapply(X = unitrts, FUN = function(x) sum(x == treatments)), @@ -926,7 +924,7 @@ w4m_filter_by_sample_class <- function( stringsAsFactors = FALSE ) smpl_metadata_colnames <- colnames(smpl_metadata) - smpl_metadata$sampleMetadata <- smpl_metadata[,class_column] + smpl_metadata$sampleMetadata <- smpl_metadata[,"trt"] smpl_metadata <- smpl_metadata[c("sampleMetadata",smpl_metadata_colnames)] rownames(new_df) <- rownames(data_matrix) data_matrix <- as.matrix(new_df) @@ -944,14 +942,14 @@ w4m_filter_by_sample_class <- function( my_pca <- prcomp(t(data_matrix), scale. = TRUE, tol = sqrt(.Machine$double.eps)) # Extract eigenvalues to determine how many are < 1 # ref for extraction: https://stat.ethz.ch/pipermail/r-help/2005-August/076610.html - ev <- my_pca$sdev^2 + ev <- my_pca$sdev ^ 2 # The cut-off for the scree is somewhat arbitrary, # https://en.wikipedia.org/wiki/Scree_plot, which cites # Norman and Steiner, Biostatistics: The Bare Essentials, p. 201 # (https://books.google.com/books?id=8rkqWafdpuoC&pg=PA201) # To be conservative, limit the number of PCs to twice the number of eigenvalues that are greater than 1. # It might be better instead to keep adding components until the residual approaches some threshold. - my_rank <- min(length(ev),2*sum(ev > 1)) + my_rank <- min(length(ev),2 * sum(ev > 1)) my_scores <- my_pca$x my_scores <- my_scores[,1:min(ncol(my_scores),my_rank)] # For each treatment, calculate the medoid, i.e., diff --git a/inst/NEWS b/inst/NEWS index 19fffe2..5fc8210 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,9 +1,23 @@ +# CHANGES IN VERSION 0.98.18 + +## SIGNIFICANT USER-VISIBLE CHANGES + +* Bug fix https://github.com/HegemanLab/w4mclassfilter/issues/8 - "centroid and median computation fails for some inputs" + +## INTERNAL CHANGES + +* Built with R 3.6.2 (2019-12-12) "Dark and Stormy Night" +* Built with the command `R CMD build w4mclassfilter` to assure that vignettes are built as intended. + # CHANGES IN VERSION 0.98.17 ## SIGNIFICANT USER-VISIBLE CHANGES * Enhancement https://github.com/HegemanLab/w4mclassfilter/issues/7 - "enable sorting on multiple columns of metadata" -* Built with R 3.6.1 (2019-07-05) "Action of the Toes" + +## INTERNAL CHANGES + +* Built with R 3.6.2 (2019-12-12) "Dark and Stormy Night" * Built with the command `R CMD build w4mclassfilter` to assure that vignettes are built as intended. # CHANGES IN VERSION 0.98.16 diff --git a/tests/testthat/exp_cent_centroid_dm.tsv b/tests/testthat/exp_cent_centroid_dm.tsv new file mode 100644 index 0000000..dc3e54b --- /dev/null +++ b/tests/testthat/exp_cent_centroid_dm.tsv @@ -0,0 +1,16 @@ + F M +HMDB00191 1055337.6 806733.222222222 +HMDB00208 6523832 2847488.88888889 +HMDB00251 309783.6 475958.333333333 +HMDB00299 603356.5 669856 +HMDB00512 592718.6 368961.222222222 +HMDB00518 150841.1 155697.111111111 +HMDB00715 2303879.4 2735121.22222222 +HMDB01032 6314400.9 17336157.4444444 +HMDB01101 2430552.8 1357405.88888889 +HMDB01101.1 1711126.7 2161230.22222222 +HMDB03193 179434 247385.777777778 +HMDB04824 788488.9 722462.666666667 +HMDB10348 257916.8 266074.666666667 +HMDB13189 1359519 2112920.22222222 +HMDB59717 603835.3 853206.111111111 diff --git a/tests/testthat/exp_cent_centroid_sm.tsv b/tests/testthat/exp_cent_centroid_sm.tsv new file mode 100644 index 0000000..aed0917 --- /dev/null +++ b/tests/testthat/exp_cent_centroid_sm.tsv @@ -0,0 +1,3 @@ +sampleMetadata trt n +F F 10 +M M 9 diff --git a/tests/testthat/exp_cent_centroid_vm.tsv b/tests/testthat/exp_cent_centroid_vm.tsv new file mode 100644 index 0000000..9dd0c83 --- /dev/null +++ b/tests/testthat/exp_cent_centroid_vm.tsv @@ -0,0 +1,16 @@ +variableMetadata name mz rt +HMDB00191 loquor 650 600 +HMDB00208 loquimini 873 476 +HMDB00251 pasamur 500 423 +HMDB00299 bantur 700 500 +HMDB00512 pantur 900 543 +HMDB00518 loquoris 870 250 +HMDB00715 loquitur 725 900 +HMDB01032 loquimur 550 425 +HMDB01101 bar 150 300 +HMDB01101.1 baz 200 225 +HMDB03193 foo 100 200 +HMDB04824 loquantur 950 522 +HMDB10348 batur 300 275 +HMDB13189 baris 800 325 +HMDB59717 bamur 125 400 diff --git a/tests/testthat/exp_cent_median_dm.tsv b/tests/testthat/exp_cent_median_dm.tsv new file mode 100644 index 0000000..1b5b884 --- /dev/null +++ b/tests/testthat/exp_cent_median_dm.tsv @@ -0,0 +1,16 @@ + F M +HMDB03193 103479 242549 +HMDB59717 511026 871209 +HMDB01101 969821 608298 +HMDB01101.1 418933 976436 +HMDB10348 187730.5 176500 +HMDB00251 258349.5 352855 +HMDB01032 1212834 14989438 +HMDB00191 830941 645785 +HMDB00299 488968 614370 +HMDB00715 2421370 2658555 +HMDB13189 938163.5 1941527 +HMDB00518 53461 129886 +HMDB00208 7105002.5 3143654 +HMDB00512 431064 342532 +HMDB04824 901439.5 605191 diff --git a/tests/testthat/exp_cent_median_sm.tsv b/tests/testthat/exp_cent_median_sm.tsv new file mode 100644 index 0000000..aed0917 --- /dev/null +++ b/tests/testthat/exp_cent_median_sm.tsv @@ -0,0 +1,3 @@ +sampleMetadata trt n +F F 10 +M M 9 diff --git a/tests/testthat/exp_cent_median_vm.tsv b/tests/testthat/exp_cent_median_vm.tsv new file mode 100644 index 0000000..4628caa --- /dev/null +++ b/tests/testthat/exp_cent_median_vm.tsv @@ -0,0 +1,16 @@ +variableMetadata name mz rt +HMDB03193 foo 100 200 +HMDB59717 bamur 125 400 +HMDB01101 bar 150 300 +HMDB01101.1 baz 200 225 +HMDB10348 batur 300 275 +HMDB00251 pasamur 500 423 +HMDB01032 loquimur 550 425 +HMDB00191 loquor 650 600 +HMDB00299 bantur 700 500 +HMDB00715 loquitur 725 900 +HMDB13189 baris 800 325 +HMDB00518 loquoris 870 250 +HMDB00208 loquimini 873 476 +HMDB00512 pantur 900 543 +HMDB04824 loquantur 950 522 diff --git a/tests/testthat/exp_cent_medoid_dm.tsv b/tests/testthat/exp_cent_medoid_dm.tsv new file mode 100644 index 0000000..6fb694a --- /dev/null +++ b/tests/testthat/exp_cent_medoid_dm.tsv @@ -0,0 +1,16 @@ + F M +HMDB03193 3732 173175 +HMDB01101.1 608298 4763576 +HMDB00518 0 129886 +HMDB10348 16262 168264 +HMDB01101 831937 229568 +HMDB13189 2003278 2755434 +HMDB59717 289677 1028110 +HMDB00251 167246 293988 +HMDB01032 263055 26222916 +HMDB00208 5402629 3143654 +HMDB00299 242085 808657 +HMDB04824 477259 959381 +HMDB00512 198512 556003 +HMDB00191 910201 785428 +HMDB00715 859466 5140022 diff --git a/tests/testthat/exp_cent_medoid_sm.tsv b/tests/testthat/exp_cent_medoid_sm.tsv new file mode 100644 index 0000000..a5df072 --- /dev/null +++ b/tests/testthat/exp_cent_medoid_sm.tsv @@ -0,0 +1,3 @@ +sampleMetadata medoid injectionOrder mode age bmi gender +F HU_110 53 pos 50 20.9 F +M HU_078 34 pos 46 25.18 M diff --git a/tests/testthat/exp_cent_medoid_vm.tsv b/tests/testthat/exp_cent_medoid_vm.tsv new file mode 100644 index 0000000..93402e4 --- /dev/null +++ b/tests/testthat/exp_cent_medoid_vm.tsv @@ -0,0 +1,16 @@ +variableMetadata name mz rt +HMDB03193 foo 100 200 +HMDB01101.1 baz 200 225 +HMDB00518 loquoris 870 250 +HMDB10348 batur 300 275 +HMDB01101 bar 150 300 +HMDB13189 baris 800 325 +HMDB59717 bamur 125 400 +HMDB00251 pasamur 500 423 +HMDB01032 loquimur 550 425 +HMDB00208 loquimini 873 476 +HMDB00299 bantur 700 500 +HMDB04824 loquantur 950 522 +HMDB00512 pantur 900 543 +HMDB00191 loquor 650 600 +HMDB00715 loquitur 725 900 diff --git a/tests/testthat/exp_cent_none_dm.tsv b/tests/testthat/exp_cent_none_dm.tsv new file mode 100644 index 0000000..e98e3a3 --- /dev/null +++ b/tests/testthat/exp_cent_none_dm.tsv @@ -0,0 +1,16 @@ + HU_028 HU_051 HU_060 HU_110 HU_149 HU_152 HU_175 HU_178 HU_185 HU_208 HU_017 HU_034 HU_078 HU_091 HU_093 HU_099 HU_130 HU_134 HU_138 +HMDB03193 412165 27242 436566 3732 127285 451270 212500 79673 0 43907 76043 44943 173175 242549 57066 559869 339188 471368 262271 +HMDB59717 1030464 67604 306862 289677 895435 715190 1563158 784738 146195 239030 357351 301983 1028110 1530493 270027 1378535 808334 1132813 871209 +HMDB01101 6877586 3158 10789748 831937 442510 1107705 1464339 31250 2724553 32742 30689 52217 229568 4763576 3878773 976436 608298 1605075 72021 +HMDB01101.1 52217 10789748 229568 608298 1107705 1464339 31250 2724553 72900 30689 6877586 3158 4763576 3878773 976436 831937 1605075 72021 442510 +HMDB10348 544877 34582 529874 16262 591487 433529 161069 214392 13781 39315 47259 60885 168264 176500 76457 610110 279156 524468 451573 +HMDB00251 616555 622468 180988 167246 10985 335711 403815 80614 63393 616061 368600 94936 293988 352855 767894 268331 310918 1248919 577184 +HMDB01032 26023086 430453 8103558 263055 1554658 20249262 5588731 871010 15920 44276 2569205 1604999 26222916 257139 675754 59906109 31151730 18648127 14989438 +HMDB00191 771533 392284 888498 910201 2292023 1246459 1945577 710519 773384 622898 560002 575790 785428 645785 591569 960658 639437 1092885 1409045 +HMDB00299 1046138 159386 1013302 242085 1057660 1110050 566050 411886 142233 284775 250551 456162 808657 614370 250403 768004 504108 1014041 1362408 +HMDB00715 2547452 371059 4983588 859466 2615560 3820724 3577833 2295288 625924 1341900 1252089 905408 5140022 2658555 814523 2558923 4184204 3865723 3236644 +HMDB13189 727587 619181 136278 2003278 113937 3132404 2893445 2092753 1034666 841661 2644620 1661412 2755434 593863 837865 3526136 1608814 3446611 1941527 +HMDB00518 58249 0 342102 0 419508 48673 28361 514579 23108 73831 0 85944 129886 175800 13154 230242 440223 315368 10657 +HMDB00208 13420742 1172376 7172632 5402629 7621236 8960828 10335722 7037373 1574738 2540044 747080 595872 3143654 4059767 1433702 5593888 2477288 3346077 4230072 +HMDB00512 319783 85009 1333877 198512 1140422 542345 1171008 827723 222953 85554 0 280560 556003 590779 209285 342532 569970 525240 246282 +HMDB04824 1144386 178517 1046190 477259 1089284 1411802 1020206 782673 346761 387811 374028 539206 959381 605191 310260 1253319 477995 825691 1157093 diff --git a/tests/testthat/exp_cent_none_sm.tsv b/tests/testthat/exp_cent_none_sm.tsv new file mode 100644 index 0000000..302c6fe --- /dev/null +++ b/tests/testthat/exp_cent_none_sm.tsv @@ -0,0 +1,20 @@ +sampleMetadata injectionOrder mode age bmi gender +HU_028 7 pos 41 23.92 F +HU_051 20 pos 24 23.23 F +HU_060 24 pos 55 28.72 F +HU_110 53 pos 50 20.9 F +HU_149 72 pos 35 19.49 F +HU_152 75 pos 26 17.58 F +HU_175 87 pos 35 21.26 F +HU_178 88 pos 60 32.87 F +HU_185 95 pos 42 21.09 F +HU_208 106 pos 27 18.61 F +HU_017 2 pos 41 23.03 M +HU_034 9 pos 52 23.37 M +HU_078 34 pos 46 25.18 M +HU_091 42 pos 61 26.12 M +HU_093 43 pos 53 21.71 M +HU_099 46 pos 23 21.3 M +HU_130 63 pos 33 26.06 M +HU_134 67 pos 48 22.89 M +HU_138 68 pos 42 21.88 M diff --git a/tests/testthat/exp_cent_none_vm.tsv b/tests/testthat/exp_cent_none_vm.tsv new file mode 100644 index 0000000..4628caa --- /dev/null +++ b/tests/testthat/exp_cent_none_vm.tsv @@ -0,0 +1,16 @@ +variableMetadata name mz rt +HMDB03193 foo 100 200 +HMDB59717 bamur 125 400 +HMDB01101 bar 150 300 +HMDB01101.1 baz 200 225 +HMDB10348 batur 300 275 +HMDB00251 pasamur 500 423 +HMDB01032 loquimur 550 425 +HMDB00191 loquor 650 600 +HMDB00299 bantur 700 500 +HMDB00715 loquitur 725 900 +HMDB13189 baris 800 325 +HMDB00518 loquoris 870 250 +HMDB00208 loquimini 873 476 +HMDB00512 pantur 900 543 +HMDB04824 loquantur 950 522 diff --git a/tests/testthat/in_cent_dm.tsv b/tests/testthat/in_cent_dm.tsv new file mode 100644 index 0000000..904612c --- /dev/null +++ b/tests/testthat/in_cent_dm.tsv @@ -0,0 +1,17 @@ +dataMatrix HU_017 HU_028 HU_034 HU_051 HU_060 HU_078 HU_091 HU_093 HU_099 HU_110 HU_130 HU_134 HU_138 HU_149 HU_152 HU_175 HU_178 HU_185 HU_204 HU_208 +HMDB03193 76043 412165 44943 27242 436566 173175 242549 57066 559869 3732 339188 471368 262271 127285 451270 212500 79673 NA 891129 43907 +HMDB01101 30689 6877586 52217 3158 10789748 229568 4763576 3878773 976436 831937 608298 1605075 72021 442510 1107705 1464339 31250 2724553 891129 32742 +HMDB01101 6877586 52217 3158 10789748 229568 4763576 3878773 976436 831937 608298 1605075 72021 442510 1107705 1464339 31250 2724553 72900 891129 30689 +HMDB10348 47259 544877 60885 34582 529874 168264 176500 76457 610110 16262 279156 524468 451573 591487 433529 161069 214392 13781 891129 39315 +HMDB59717 357351 1030464 301983 67604 306862 1028110 1530493 270027 1378535 289677 808334 1132813 871209 895435 715190 1563158 784738 146195 891129 239030 +HMDB00822 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 14627 +HMDB13189 2644620 727587 1661412 619181 136278 2755434 593863 837865 3526136 2003278 1608814 3446611 1941527 113937 3132404 2893445 2092753 1034666 891129 841661 +HMDB00299 250551 1046138 456162 159386 1013302 808657 614370 250403 768004 242085 504108 1014041 1362408 1057660 1110050 566050 411886 142233 891129 284775 +HMDB00191 560002 771533 575790 392284 888498 785428 645785 591569 960658 910201 639437 1092885 1409045 2292023 1246459 1945577 710519 773384 891129 622898 +HMDB00518 -34236 58249 85944 NA 342102 129886 175800 13154 230242 NA 440223 315368 10657 419508 48673 28361 514579 23108 891129 73831 +HMDB00715 1252089 2547452 905408 371059 4983588 5140022 2658555 814523 2558923 859466 4184204 3865723 3236644 2615560 3820724 3577833 2295288 625924 891129 1341900 +HMDB01032 2569205 26023086 1604999 430453 8103558 26222916 257139 675754 59906109 263055 31151730 18648127 14989438 1554658 20249262 5588731 871010 15920 891129 44276 +HMDB00208 747080 13420742 595872 1172376 7172632 3143654 4059767 1433702 5593888 5402629 2477288 3346077 4230072 7621236 8960828 10335722 7037373 1574738 891129 2540044 +HMDB04824 374028 1144386 539206 178517 1046190 959381 605191 310260 1253319 477259 477995 825691 1157093 1089284 1411802 1020206 782673 346761 891129 387811 +HMDB00512 NA 319783 280560 85009 1333877 556003 590779 209285 342532 198512 569970 525240 246282 1140422 542345 1171008 827723 222953 891129 85554 +HMDB00251 368600 616555 94936 622468 180988 293988 352855 767894 268331 167246 310918 1248919 577184 10985 335711 403815 80614 63393 891129 616061 diff --git a/tests/testthat/in_cent_sm.tsv b/tests/testthat/in_cent_sm.tsv new file mode 100644 index 0000000..d77dd52 --- /dev/null +++ b/tests/testthat/in_cent_sm.tsv @@ -0,0 +1,21 @@ +sampleMetadata injectionOrder mode age bmi gender +HU_017 2 pos 41 23.03 M +HU_028 7 pos 41 23.92 F +HU_034 9 pos 52 23.37 M +HU_051 20 pos 24 23.23 F +HU_060 24 pos 55 28.72 F +HU_078 34 pos 46 25.18 M +HU_091 42 pos 61 26.12 M +HU_093 43 pos 53 21.71 M +HU_099 46 pos 23 21.3 M +HU_110 53 pos 50 20.9 F +HU_130 63 pos 33 26.06 M +HU_134 67 pos 48 22.89 M +HU_138 68 pos 42 21.88 M +HU_149 72 pos 35 19.49 F +HU_152 75 pos 26 17.58 F +HU_175 87 pos 35 21.26 F +HU_178 88 pos 60 32.87 F +HU_185 95 pos 42 21.09 F +HU_204 104 pos 31 29.06 M +HU_208 106 pos 27 18.61 F diff --git a/tests/testthat/in_cent_vm.tsv b/tests/testthat/in_cent_vm.tsv new file mode 100644 index 0000000..c715546 --- /dev/null +++ b/tests/testthat/in_cent_vm.tsv @@ -0,0 +1,17 @@ +variable name mz rt +HMDB03193 foo 100 200 +HMDB01101 bar 150 300 +HMDB01101 baz 200 225 +HMDB00208 loquimini 873 476 +HMDB10348 batur 300 275 +HMDB00299 bantur 700 500 +HMDB00191 loquor 650 600 +HMDB00518 loquoris 870 250 +HMDB59717 bamur 125 400 +HMDB00822 bamini 300 199 +HMDB13189 baris 800 325 +HMDB00715 loquitur 725 900 +HMDB01032 loquimur 550 425 +HMDB04824 loquantur 950 522 +HMDB00512 pantur 900 543 +HMDB00251 pasamur 500 423 diff --git a/tests/testthat/test-center2.R b/tests/testthat/test-center2.R new file mode 100644 index 0000000..0cf1446 --- /dev/null +++ b/tests/testthat/test-center2.R @@ -0,0 +1,189 @@ +# test centering for w4mclassfilter::w4m_filter_by_sample_class + + +expect_equivalent_length <- function(target, current, info) { + expect_equivalent(length(target), length(current), info = info) +} +expect_all_equal <- function(target, current, info) { + expect_equivalent_length(target = target, current = current, info = info) + expect_true(all.equal(target = target, current = current, info = info)) +} + +read_data_frame <- function(file_path, kind_string, failure_action = print) { + # --- + # read in the data frame + my.env <- new.env() + my.env$success <- FALSE + my.env$msg <- sprintf("no message reading %s", kind_string) + tryCatch( + expr = { + my.env$data <- utils::read.delim( fill = FALSE, file = file_path ) + my.env$success <- TRUE + } + , error = function(e) { + my.env$ msg <- sprintf("%s read failed", kind_string) + } + ) + if (!my.env$success) { + failure_action(my.env$msg) + return ( FALSE ) + } + return (my.env) +} + +run_center_test <- function( + classes_to_filter, + class_column, + samplename_column = "sampleMetadata", + false_to_exclude_classes_in_filter, + centering = c("none","centroid","median","medoid"), + order_smpl, + order_vrbl + ) { + #### print("order_smpl") + #### print(order_smpl) + # set up variables + variableMetadata_in <- "in_cent_vm.tsv" + variableMetadata_out <- switch(centering, + "none" = "out_cent_none_vm.tsv", + "centroid" = "out_cent_centroid_vm.tsv", + "median" = "out_cent_median_vm.tsv", + "medoid" = "out_cent_medoid_vm.tsv") + variableMetadata_exp <- switch(centering, + "none" = "exp_cent_none_vm.tsv", + "centroid" = "exp_cent_centroid_vm.tsv", + "median" = "exp_cent_median_vm.tsv", + "medoid" = "exp_cent_medoid_vm.tsv") + sampleMetadata_in <- "in_cent_sm.tsv" + sampleMetadata_out <- switch(centering, + "none" = "out_cent_none_sm.tsv", + "centroid" = "out_cent_centroid_sm.tsv", + "median" = "out_cent_median_sm.tsv", + "medoid" = "out_cent_medoid_sm.tsv") + sampleMetadata_exp <- switch(centering, + "none" = "exp_cent_none_sm.tsv", + "centroid" = "exp_cent_centroid_sm.tsv", + "median" = "exp_cent_median_sm.tsv", + "medoid" = "exp_cent_medoid_sm.tsv") + dataMatrix_in <- "in_cent_dm.tsv" + dataMatrix_out <- switch(centering, + "none" = "out_cent_none_dm.tsv", + "centroid" = "out_cent_centroid_dm.tsv", + "median" = "out_cent_median_dm.tsv", + "medoid" = "out_cent_medoid_dm.tsv") + dataMatrix_exp <- switch(centering, + "none" = "exp_cent_none_dm.tsv", + "centroid" = "exp_cent_centroid_dm.tsv", + "median" = "exp_cent_median_dm.tsv", + "medoid" = "exp_cent_medoid_dm.tsv") + # test input files + data_matrix_input_env <- read_data_frame(dataMatrix_in, "data matrix input") + expect_true(data_matrix_input_env$success, info = "read data matrix input") + rm(data_matrix_input_env) + sample_metadata_input_env <- read_data_frame(sampleMetadata_in, "sample metadata input") + expect_true(sample_metadata_input_env$success, info = "read sample metadata input") + rm(sample_metadata_input_env) + variable_metadata_input_env <- read_data_frame(variableMetadata_in, "variable metadata input") + expect_true(variable_metadata_input_env$success, info = "read variable metadata input") + rm(variable_metadata_input_env) + # filter, impute, and write output + filter_result <- w4m_filter_by_sample_class( + dataMatrix_in = dataMatrix_in + , dataMatrix_out = dataMatrix_out + , variableMetadata_in = variableMetadata_in + , variableMetadata_out = variableMetadata_out + , sampleMetadata_out = sampleMetadata_out + , sampleMetadata_in = sampleMetadata_in + , samplename_column = samplename_column + , classes = classes_to_filter + , include = false_to_exclude_classes_in_filter + , class_column = class_column + , centering = centering + , order_smpl = order_smpl + , order_vrbl = order_vrbl + ) + expect_true(filter_result, info = "filter_result should be true") + # read actual output files + data_matrix_output_env <- read_data_frame(dataMatrix_out, "data matrix output") + expect_true(data_matrix_output_env$success, info = "read data matrix output") + sample_metadata_output_env <- read_data_frame(sampleMetadata_out, "sample metadata output") + expect_true(sample_metadata_output_env$success, info = "read sample metadata output") + variable_metadata_output_env <- read_data_frame(variableMetadata_out, "variable metadata output") + expect_true(variable_metadata_output_env$success, info = "read variable metadata output") + # read expected output files + data_matrix_expected_env <- read_data_frame(dataMatrix_exp, "data matrix expected") + expect_true(data_matrix_expected_env$success, info = "read data matrix expected") + sample_metadata_expected_env <- read_data_frame(sampleMetadata_exp, "sample metadata expected") + expect_true(sample_metadata_expected_env$success, info = "read sample metadata expected") + variable_metadata_expected_env <- read_data_frame(variableMetadata_exp, "variable metadata expected") + expect_true(variable_metadata_expected_env$success, info = "read variable metadata expected") + # compare actuals with expecteds + expect_equivalent_length(data_matrix_output_env$data, data_matrix_expected_env$data, info = "validate data matrix length") + expect_equivalent_length(sample_metadata_output_env$data, sample_metadata_expected_env$data, info = "validate sample metadata length") + expect_equivalent_length(variable_metadata_output_env$data, variable_metadata_expected_env$data, info = "validate variable metadata length") + expect_equivalent(data_matrix_output_env$data, data_matrix_expected_env$data, info = "validate data matrix") + expect_equivalent(rownames(data_matrix_output_env$data), rownames(data_matrix_expected_env$data), info = "validate data matrix rownames") + expect_equivalent(colnames(data_matrix_output_env$data), colnames(data_matrix_expected_env$data), info = "validate data matrix colnames") + expect_equivalent(sample_metadata_output_env$data, sample_metadata_expected_env$data, info = "validate sample metadata") + expect_equivalent(variable_metadata_output_env$data, variable_metadata_expected_env$data, info = "validate variable metadata") +} + +#' @import testthat w4mclassfilter +#' @export +test_that("center2 none test", { + #print("*** center2 none test ***") + run_center_test( + classes_to_filter = c() + , class_column = "gender" + , samplename_column = "sampleMetadata" + , false_to_exclude_classes_in_filter = TRUE + , centering = "none" + , order_smpl = c("gender") + , order_vrbl = c("mz") + ) +}) + +#' @import testthat w4mclassfilter +#' @export +test_that("center2 centroid test", { + #print("*** center2 centroid test ***") + run_center_test( + classes_to_filter = c() + , class_column = "gender" + , samplename_column = "sampleMetadata" + , false_to_exclude_classes_in_filter = TRUE + , centering = "centroid" + , order_smpl = c("sampleMetadata") + , order_vrbl = c("variableMetadata") + ) +}) + +#' @import testthat w4mclassfilter +#' @export +test_that("center2 median test", { + #print("*** center2 median test ***") + run_center_test( + classes_to_filter = c() + , class_column = "gender" + , samplename_column = "sampleMetadata" + , false_to_exclude_classes_in_filter = TRUE + , centering = "median" + , order_smpl = c("sampleMetadata") + , order_vrbl = c("mz") + ) +}) + +#' @import testthat w4mclassfilter +#' @export +test_that("center2 medoid test", { + #print("*** center2 medoid test ***") + run_center_test( + classes_to_filter = c() + , class_column = "gender" + , samplename_column = "sampleMetadata" + , false_to_exclude_classes_in_filter = TRUE + , centering = "medoid" + , order_smpl = c("gender") + , order_vrbl = c("rt") + ) +})