context("completeness") skip_on_cran() # CTU05 l_ctu05 <- read_secuTrial(system.file("extdata", "sT_exports", "lnames", "s_export_CSV-xls_CTU05_long_ref_miss_en_utf8.zip", package = "secuTrialR")) s_ctu05 <- read_secuTrial(system.file("extdata", "sT_exports", "snames", "s_export_CSV-xls_CTU05_short_ref_miss_en_utf8.zip", package = "secuTrialR")) # polish s_ctu05_pl <- read_secuTrial(system.file("extdata", "sT_exports", "snames", "s_export_CSV-xls_CTU05_short_meta_ref_miss_pl_utf8.zip", package = "secuTrialR")) # TES05 # warning can be suppressed (it is expected) suppressWarnings( s_tes05_iso <- read_secuTrial(system.file("extdata", "sT_exports", "encodings", "s_export_CSV-xls_TES05_short_ref_en_iso8859-15.zip", package = "secuTrialR")) ) # warning can be suppressed (it is expected) suppressWarnings( l_tes05_utf <- read_secuTrial(system.file("extdata", "sT_exports", "encodings", "s_export_CSV-xls_TES05_long_ref_en_utf8.zip", package = "secuTrialR")) ) test_that("Test fail", { expect_error(form_status_counts(1337)) expect_error(form_status_counts(c(1, 3, 3, 7))) }) # long and short cannot match on form_names, so we just check the data columns cols_counts <- c("pat_id", "completely_filled", "partly_filled", "empty", "with_warnings", "with_errors") test_that("Test output equality for different export options", { expect_equal(form_status_counts(s_ctu05)[, cols_counts], form_status_counts(l_ctu05)[, cols_counts]) expect_equal(form_status_counts(s_tes05_iso)[, cols_counts], form_status_counts(l_tes05_utf)[, cols_counts]) # polish vs. english should be the same expect_equal(form_status_counts(s_ctu05_pl)[, cols_counts], form_status_counts(l_ctu05)[, cols_counts]) }) test_that("Test column sums", { expect_equal(as.vector(colSums(form_status_counts(l_ctu05)[, 3:7])), c(74, 5, 0, 0, 0)) expect_equal(as.vector(colSums(form_status_counts(s_tes05_iso)[, 3:7])), c(21, 12, 4, 0, 0)) }) # custom count checks # as manually compared to the secuTrial web interface counts_for_custom_tests <- form_status_counts(s_tes05_iso) test_that("Individual entries", { # RPACKRIG-USZ-11111 has 4 (1x baseline, 3x fu visit) empty forms and nothing is filled at all expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-11111" & counts_for_custom_tests$form_name == "bl"), ]$empty, 1) expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-11111" & counts_for_custom_tests$form_name == "fuvisit"), ]$empty, 3) # RPACKRIG-USZ-4 has 1x baseline completely filled, # 3x fu visit completely filled, # 1x fu visit partly filled, # 1x intervals completely filled expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-4" & counts_for_custom_tests$form_name == "bl"), ]$completely_filled, 1) expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-4" & counts_for_custom_tests$form_name == "fuvisit"), ]$completely_filled, 3) expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-4" & counts_for_custom_tests$form_name == "fuvisit"), ]$partly_filled, 1) expect_equal(counts_for_custom_tests[which(counts_for_custom_tests$pat_id == "RPACKRIG-USZ-4" & counts_for_custom_tests$form_name == "intervals"), ]$completely_filled, 1) }) test_that("Test that partly, completely and empty percentages add up to 1 i.e. 100%", { # the vector is made up of ones subtracting one from all of them and summing should always return 0 expect_equal(sum(rowSums(subset(form_status_summary(s_ctu05), select = c("partly_filled.percent", "completely_filled.percent", "empty.percent"))) - 1), 0) expect_equal(sum(rowSums(subset(form_status_summary(l_tes05_utf), select = c("partly_filled.percent", "completely_filled.percent", "empty.percent"))) - 1), 0) }) cols_summary <- c("partly_filled", "completely_filled", "empty", "with_warnings", "with_errors", "partly_filled.percent", "completely_filled.percent", "empty.percent", "with_warnings.percent", "with_errors.percent", "form_count") test_that("Test column sums", { expect_equal(colSums(form_status_summary(s_ctu05)[, cols_summary]), colSums(form_status_summary(l_ctu05)[, cols_summary])) expect_equal(round(as.vector(colSums(form_status_summary(l_ctu05)[, cols_summary])), digits = 4), c(5, 74, 0, 0, 0, 0.3122, 9.6878, 0, 0, 0, 79)) expect_equal(colSums(form_status_summary(s_tes05_iso)[, cols_summary]), colSums(form_status_summary(l_tes05_utf)[, cols_summary])) expect_equal(round(as.vector(colSums(form_status_summary(s_tes05_iso)[, cols_summary])), digits = 4), c(12, 21, 4, 0, 0, 2.9774, 2.6798, 0.3429, 0, 0, 37) ) # polish vs. english should be the same expect_equal(colSums(form_status_summary(s_ctu05_pl)[, cols_summary]), colSums(form_status_summary(l_ctu05)[, cols_summary])) }) # TODO add more tests with warnings and errors and empty data # subset_secuTrial tests for plot_recruitment # centres sdat_berlin <- subset_secuTrial(s_ctu05, centre = "Charité Berlin (RPACK)") sdat_no_berlin <- subset_secuTrial(s_ctu05, centre = "Charité Berlin (RPACK)", exclude = TRUE) summary_all <- form_status_summary(s_ctu05) summary_berlin <- form_status_summary(sdat_berlin) summary_no_berlin <- form_status_summary(sdat_no_berlin) counts_all <- form_status_counts(s_ctu05) counts_berlin <- form_status_counts(sdat_berlin) counts_no_berlin <- form_status_counts(sdat_no_berlin) count_cols <- c("completely_filled", "partly_filled", "empty", "with_warnings", "with_errors") test_that("Test output after subsetting centres", { expect_equal(summary_all[which(summary_all$form_name == "baseline"), ]$partly_filled, (summary_berlin[which(summary_berlin$form_name == "baseline"), ]$partly_filled + summary_no_berlin[which(summary_no_berlin$form_name == "baseline"), ]$partly_filled)) expect_equal(summary_all[which(summary_all$form_name == "baseline"), ]$form_count, (summary_berlin[which(summary_berlin$form_name == "baseline"), ]$form_count + summary_no_berlin[which(summary_no_berlin$form_name == "baseline"), ]$form_count)) expect_equal(summary_all[which(summary_all$form_name == "baseline"), ]$completely_filled, (summary_berlin[which(summary_berlin$form_name == "baseline"), ]$completely_filled + summary_no_berlin[which(summary_no_berlin$form_name == "baseline"), ]$completely_filled)) expect_equal(nrow(counts_all), (nrow(counts_berlin) + nrow(counts_no_berlin))) expect_equal(colSums(counts_all[, count_cols]), (colSums(counts_no_berlin[, count_cols]) + colSums(counts_berlin[, count_cols]))) }) # participants id_set <- c("RPACK-CBE-002", "RPACK-INS-014", "RPACK-USB-123") l_ctu05_rm <- subset_secuTrial(l_ctu05, participant = id_set, exclude = TRUE) l_ctu05_keep <- subset_secuTrial(l_ctu05, participant = id_set) counts_rm_ids <- form_status_counts(l_ctu05_rm) counts_keep_ids <- form_status_counts(l_ctu05_keep) test_that("Test output after subsetting participants", { expect_equal(colSums(counts_all[, count_cols]), (colSums(counts_rm_ids[, count_cols]) + colSums(counts_keep_ids[, count_cols]))) }) # centre and participants no_bern_no_basel <- subset_secuTrial(s_ctu05, participant = "RPACK-USB-123", centre = "Inselspital Bern (RPACK)", exclude = TRUE) counts_no_bern_no_basel <- form_status_counts(no_bern_no_basel) summary_no_bern_no_basel <- form_status_summary(no_bern_no_basel) test_that("Test output after subsetting centres and participants together", { expect_equal(counts_no_bern_no_basel, counts_berlin) expect_equal(summary_no_bern_no_basel, summary_berlin) })