|
1 | | -# # Copyright 2024 Observational Health Data Sciences and Informatics |
2 | | -# # |
3 | | -# # This file is part of CohortDiagnostics |
4 | | -# # |
5 | | -# # Licensed under the Apache License, Version 2.0 (the "License"); |
6 | | -# # you may not use this file except in compliance with the License. |
7 | | -# # You may obtain a copy of the License at |
8 | | -# # |
9 | | -# # http://www.apache.org/licenses/LICENSE-2.0 |
10 | | -# # |
11 | | -# # Unless required by applicable law or agreed to in writing, software |
12 | | -# # distributed under the License is distributed on an "AS IS" BASIS, |
13 | | -# # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
14 | | -# # See the License for the specific language governing permissions and |
15 | | -# # limitations under the License. |
16 | | -# |
17 | | -# for (nm in names(testServers)) { |
18 | | -# |
19 | | -# server <- testServers[[nm]] |
20 | | -# con <- connect(server$connectionDetails) |
21 | | -# |
22 | | -# exportFolder <- file.path(tempdir(), paste0(nm, "exp")) |
23 | | -# databaseId <- "myDB" |
24 | | -# minCellCount <- 5 |
25 | | -# recordKeepingFile <- file.path(exportFolder, "record.csv") |
26 | | -# cohortTableNames <- CohortGenerator::getCohortTableNames(cohortTable = server$cohortTable) |
27 | | -# |
28 | | -# test_that(paste("test run inclusion statistics output", nm), { |
29 | | -# |
30 | | -# dir.create(exportFolder) |
31 | | -# runInclusionStatistics(connection = con, |
32 | | -# exportFolder = exportFolder, |
33 | | -# databaseId = databaseId, |
34 | | -# cohortDefinitionSet = server$cohortDefinitionSet, |
35 | | -# cohortDatabaseSchema = server$cohortDatabaseSchema, |
36 | | -# cohortTableNames = cohortTableNames, |
37 | | -# incremental = TRUE, |
38 | | -# minCellCount = minCellCount, |
39 | | -# recordKeepingFile = recordKeepingFile) |
40 | | -# |
41 | | -# # Check cohort_inc_result |
42 | | -# expect_true(file.exists(file.path(exportFolder, "cohort_inc_result.csv"))) |
43 | | -# incResult <- read.csv(file.path(exportFolder, "cohort_inc_result.csv")) |
44 | | -# expect_equal(colnames(incResult), c("database_id", "cohort_id", "mode_id", "inclusion_rule_mask" , "person_count")) |
45 | | -# expect_equal(unique(incResult$database_id), databaseId) |
46 | | -# expect_true(all(incResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
47 | | -# |
48 | | -# # Check cohort_inc_stats |
49 | | -# expect_true(file.exists(file.path(exportFolder, "cohort_inc_stats.csv"))) |
50 | | -# incStatsResult <- read.csv(file.path(exportFolder, "cohort_inc_stats.csv")) |
51 | | -# expect_equal(colnames(incStatsResult), c("cohort_definition_id", "rule_sequence", "person_count", "gain_count" , "person_total", "mode_id")) |
52 | | -# |
53 | | -# # Check cohort_inclusion |
54 | | -# expect_true(file.exists(file.path(exportFolder, "cohort_inclusion.csv"))) |
55 | | -# inclusionResult <- read.csv(file.path(exportFolder, "cohort_inclusion.csv")) |
56 | | -# expect_equal(colnames(inclusionResult), c("database_id", "cohort_id", "rule_sequence", "name" , "description")) |
57 | | -# expect_equal(unique(inclusionResult$database_id), databaseId) |
58 | | -# expect_true(all(inclusionResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
59 | | -# |
60 | | -# # Check cohort_summary_stats |
61 | | -# expect_true(file.exists(file.path(exportFolder, "cohort_summary_stats.csv"))) |
62 | | -# sumStatsResult <- read.csv(file.path(exportFolder, "cohort_summary_stats.csv")) |
63 | | -# expect_equal(colnames(sumStatsResult), c("database_id", "cohort_id", "mode_id", "base_count" , "final_count")) |
64 | | -# expect_equal(unique(sumStatsResult$database_id), databaseId) |
65 | | -# expect_true(all(sumStatsResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
66 | | -# |
67 | | -# # Check recordKeepingFile |
68 | | -# expect_true(file.exists(recordKeepingFile)) |
69 | | -# recordKeeping <- read.csv(recordKeepingFile) |
70 | | -# expect_equal(colnames(recordKeeping), c("cohortId", "task", "checksum" , "timeStamp")) |
71 | | -# expect_equal(unique(recordKeeping$task), "runInclusionStatistics") |
72 | | -# expect_true(all(recordKeeping$cohortId %in% server$cohortDefinitionSet$cohortId)) |
73 | | -# |
74 | | -# unlink(exportFolder) |
75 | | -# }) |
76 | | -# } |
| 1 | +# test runInclusionStatistics for all databases |
| 2 | +for (nm in names(testServers)) { |
| 3 | + |
| 4 | + server <- testServers[[nm]] |
| 5 | + con <- connect(server$connectionDetails) |
| 6 | + |
| 7 | + exportFolder <- file.path(tempdir(), paste0(nm, "exp")) |
| 8 | + databaseId <- "myDB" |
| 9 | + minCellCount <- 5 |
| 10 | + recordKeepingFile <- file.path(exportFolder, "record.csv") |
| 11 | + cohortTableNames <- CohortGenerator::getCohortTableNames(cohortTable = server$cohortTable) |
| 12 | + |
| 13 | + test_that(paste("test run inclusion statistics output", nm), { |
| 14 | + |
| 15 | + dir.create(exportFolder) |
| 16 | + runInclusionStatistics(connection = con, |
| 17 | + exportFolder = exportFolder, |
| 18 | + databaseId = databaseId, |
| 19 | + cohortDefinitionSet = server$cohortDefinitionSet, |
| 20 | + cohortDatabaseSchema = server$cohortDatabaseSchema, |
| 21 | + cohortTableNames = cohortTableNames, |
| 22 | + incremental = TRUE, |
| 23 | + minCellCount = minCellCount, |
| 24 | + recordKeepingFile = recordKeepingFile) |
| 25 | + |
| 26 | + # Check cohort_inc_result |
| 27 | + expect_true(file.exists(file.path(exportFolder, "cohort_inc_result.csv"))) |
| 28 | + incResult <- read.csv(file.path(exportFolder, "cohort_inc_result.csv")) |
| 29 | + expect_equal(colnames(incResult), c("database_id", "cohort_id", "mode_id", "inclusion_rule_mask" , "person_count")) |
| 30 | + expect_equal(unique(incResult$database_id), databaseId) |
| 31 | + expect_true(all(incResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
| 32 | + |
| 33 | + # Check cohort_inc_stats |
| 34 | + expect_true(file.exists(file.path(exportFolder, "cohort_inc_stats.csv"))) |
| 35 | + incStatsResult <- read.csv(file.path(exportFolder, "cohort_inc_stats.csv")) |
| 36 | + expect_equal(colnames(incStatsResult), c("cohort_definition_id", "rule_sequence", "person_count", "gain_count" , "person_total", "mode_id")) |
| 37 | + |
| 38 | + # Check cohort_inclusion |
| 39 | + expect_true(file.exists(file.path(exportFolder, "cohort_inclusion.csv"))) |
| 40 | + inclusionResult <- read.csv(file.path(exportFolder, "cohort_inclusion.csv")) |
| 41 | + expect_equal(colnames(inclusionResult), c("database_id", "cohort_id", "rule_sequence", "name" , "description")) |
| 42 | + expect_equal(unique(inclusionResult$database_id), databaseId) |
| 43 | + expect_true(all(inclusionResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
| 44 | + |
| 45 | + # Check cohort_summary_stats |
| 46 | + expect_true(file.exists(file.path(exportFolder, "cohort_summary_stats.csv"))) |
| 47 | + sumStatsResult <- read.csv(file.path(exportFolder, "cohort_summary_stats.csv")) |
| 48 | + expect_equal(colnames(sumStatsResult), c("database_id", "cohort_id", "mode_id", "base_count" , "final_count")) |
| 49 | + expect_equal(unique(sumStatsResult$database_id), databaseId) |
| 50 | + expect_true(all(sumStatsResult$cohort_id %in% server$cohortDefinitionSet$cohortId)) |
| 51 | + |
| 52 | + # Check recordKeepingFile |
| 53 | + expect_true(file.exists(recordKeepingFile)) |
| 54 | + recordKeeping <- read.csv(recordKeepingFile) |
| 55 | + expect_equal(colnames(recordKeeping), c("cohortId", "task", "checksum" , "timeStamp")) |
| 56 | + expect_equal(unique(recordKeeping$task), "runInclusionStatistics") |
| 57 | + expect_true(all(recordKeeping$cohortId %in% server$cohortDefinitionSet$cohortId)) |
| 58 | + |
| 59 | + unlink(exportFolder) |
| 60 | + }) |
| 61 | +} |
0 commit comments