forked from SwissClinicalTrialOrganisation/secuTrialR
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtest-read_export_options.R
209 lines (182 loc) · 10.4 KB
/
test-read_export_options.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
context("load export options testing")
skip_on_cran()
# shorten table names
export_options_regular_short <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"))
# long table names
export_options_regular_long <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_long_en_utf8.zip",
package = "secuTrialR"))
# rectangular shorten table names
export_options_rect_short <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_rt_short_en_utf8.zip",
package = "secuTrialR"))
# rectangular long table names
export_options_rect_long <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_rt_long_en_utf8.zip",
package = "secuTrialR"))
# unzipped
bmd_unzipped <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"))
# duplicated meta
dup_meta <- read_export_options(system.file("extdata", "sT_exports", "lnames",
"s_export_CSV-xls_CTU05_long_meta_ref_miss_en_utf8.zip",
package = "secuTrialR"))
# ISO-8859-15
exp_opt_tes05_iso <- suppressWarnings(read_export_options(system.file("extdata", "sT_exports", "encodings",
"s_export_CSV-xls_TES05_short_ref_en_iso8859-15.zip",
package = "secuTrialR")))
# Enclosure = ' and Seperator = ;
exp_opt_enclosure1 <-read_export_options(system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV_CTU05_20240513-124040.zip",
package = "secuTrialR"))
# Enclosure = , and Seperator = "
exp_opt_enclosure2 <-read_export_options(system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV_CTU05_20240513-124102.zip",
package = "secuTrialR"))
# test encoding
test_that("Encoding parsed as expected.", {
expect_equal(export_options_regular_short$encoding, "UTF-8")
expect_equal(bmd_unzipped$encoding, "UTF-8")
expect_equal(exp_opt_tes05_iso$encoding, "ISO-8859-15")
})
# test shortened table names
test_that("Shorten names identified.", {
expect_true(bmd_unzipped$short_names)
expect_true(export_options_regular_short$short_names)
expect_false(export_options_regular_long$short_names)
expect_true(export_options_rect_short$short_names)
expect_false(export_options_rect_long$short_names)
})
# test zip
test_that("zip archive ending identified.", {
expect_false(bmd_unzipped$is_zip)
expect_true(export_options_regular_short$is_zip)
expect_true(export_options_regular_long$is_zip)
expect_true(export_options_rect_short$is_zip)
expect_true(export_options_rect_long$is_zip)
})
# test rectangular identification
test_that("Rectangular/regular export identified.", {
expect_true(export_options_rect_short$is_rectangular)
expect_true(export_options_rect_long$is_rectangular)
expect_false(export_options_regular_short$is_rectangular)
expect_false(bmd_unzipped$is_rectangular)
expect_false(export_options_regular_long$is_rectangular)
})
# test meta names
test_that("Meta names available.", {
expect_equal(as.vector(unlist(export_options_regular_short$meta_names)), c("fs", "cn", "ctr", "is",
"qs", "qac", "vp", "vpfs",
"atcn", "atcvp", "cts", "miv", "cl"))
expect_equal(as.vector(unlist(export_options_regular_long$meta_names)), c("forms", "casenodes",
"centres", "items",
"questions", "queries",
"visitplan", "visitplanforms",
"atcasenodes", "atcasevisitplans",
"comments", "miv", "cl"))
})
# prepare path to example export
export_location <- system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR")
# load all export data
sT_export <- read_secuTrial_raw(data_dir = export_location)
# capture the print
captured_print <- capture.output(print(sT_export$export_options))
# test print.secutrialoptions
test_that("Print export options working.", {
expect_equal(captured_print[1], "secuTrial version: 5.3.4.6 ")
expect_equal(captured_print[2], "Time of export on server: 25.02.2019 - 15:14:27 (CET) ")
expect_equal(captured_print[6], "Enclosure: '\\\"'")
expect_equal(captured_print[7], "Seperator: '\\t'")
expect_equal(captured_print[8], "14 files exported")
expect_equal(captured_print[10], "Reference values not exported - factorize not possible")
})
sT_export2 <- read_secuTrial_raw(data_dir = system.file("extdata", "sT_exports", "snames",
"s_export_CSV-xls_CTU05_short_miss_en_utf8.zip",
package = "secuTrialR"))
# project version
test_that("Project version parsing", {
expect_equal(sT_export$export_options$project_version, "(25.02.2019 - 13:13:44 (CET))")
expect_equal(export_options_regular_short$project_version, "(25.02.2019 - 13:13:44 (CET))")
expect_equal(export_options_regular_long$project_version, "(25.02.2019 - 13:13:44 (CET))")
expect_equal(sT_export2$export_options$project_version, "(30.04.2019 - 13:40:52 (CEST))")
expect_equal(bmd_unzipped$project_version, "(25.02.2019 - 13:13:44 (CET))")
})
# project name
test_that("Project name parsing", {
expect_equal(sT_export$export_options$project_name, "BONE MINERAL DENSITY")
expect_equal(export_options_regular_short$project_name, "BONE MINERAL DENSITY")
expect_equal(export_options_regular_long$project_name, "BONE MINERAL DENSITY")
expect_equal(sT_export2$export_options$project_name, "secuTrialR example CDMA")
expect_equal(bmd_unzipped$project_name, "BONE MINERAL DENSITY")
})
# duplicated meta data
test_that("Duplicated meta data parsing", {
expect_false(sT_export$export_options$duplicate_meta)
expect_false(export_options_regular_short$duplicate_meta)
expect_false(export_options_regular_long$duplicate_meta)
expect_false(sT_export2$export_options$duplicate_meta)
expect_false(bmd_unzipped$duplicate_meta)
expect_true(dup_meta$duplicate_meta)
})
# test time of export
# manually checked all of these in the respective ExportOptions.html files
test_that("Time of export", {
expect_equal(sT_export$export_options$time_of_export, "25.02.2019 - 15:14:27 (CET)")
expect_equal(export_options_regular_long$time_of_export, "18.03.2019 - 10:47:03 (CET)")
expect_equal(sT_export2$export_options$time_of_export, "30.04.2019 - 15:29:45 (CEST)")
})
# errors for non CSV exports
test_that("Errored for non CSV format", {
# SAS
expect_error(read_export_options(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_SAS_CTU05_20191115-092453_SAS.zip",
package = "secuTrialR")))
# SPSS
expect_error(read_export_options(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_SPSS_CTU05_20191115-092020_SPSS.zip",
package = "secuTrialR")))
# CDISC
expect_error(read_export_options(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_XML_CTU05_20191115-092559_CDISC.zip",
package = "secuTrialR")))
})
# success for CSV exports
eo_csv <- read_export_options(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV_CTU05_20191115-091627_CSV.zip",
package = "secuTrialR"))
test_that("Success for CSV format", {
expect_equal(eo_csv$format_info, "CSV format")
expect_equal(exp_opt_tes05_iso$format_info, "CSV format for MS Excel")
})
# audit trail parsing
export_location_only_col_names <- system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV-xls_CTU05_only_column_names.zip",
package = "secuTrialR")
sT_export_only_col_names <- read_secuTrial_raw(data_dir = export_location_only_col_names)
test_that("Lack of Audit Trail successfully parsed", {
expect_false(sT_export_only_col_names$export_options$audit_trail)
})
# hidden field parsing
test_that("Hidden fields successfully parsed", {
expect_false(sT_export_only_col_names$export_options$hidden_fields)
expect_true(exp_opt_tes05_iso$hidden_fields)
})
# Form meta data Structure option parsing
test_that("Structure fields successfully parsed", {
expect_false(sT_export_only_col_names$export_options$structure)
expect_true(exp_opt_tes05_iso$structure)
})
# test enclosure and seperator
test_that("Enclosure and separator as expected", {
expect_equal(export_options_regular_short$quote, "\"")
expect_equal(export_options_regular_short$sep, "\t")
expect_equal(exp_opt_enclosure1$quote, "'")
expect_equal(exp_opt_enclosure1$sep, ";")
expect_equal(exp_opt_enclosure2$quote, ",")
expect_equal(exp_opt_enclosure2$sep, "\"")
})