forked from SwissClinicalTrialOrganisation/secuTrialR
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtest-read_export_table.R
159 lines (139 loc) · 8.8 KB
/
test-read_export_table.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
context("read export table testing")
skip_on_cran()
# load export options
export_options <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"))
# load export options unzipped
export_options_unzipped <- read_export_options(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"))
# load casenodes, centre, visitplan and bmd table
casenodes <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "cn.xls",
export_options = export_options,
is_meta_table = TRUE)
# unzipped
casenodes_unzipped <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"),
file_name = "cn.xls",
export_options = export_options_unzipped,
is_meta_table = TRUE)
centre <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "ctr.xls",
export_options = export_options,
is_meta_table = TRUE)
# unzipped
centre_unzipped <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"),
file_name = "ctr.xls",
export_options = export_options_unzipped,
is_meta_table = TRUE)
visitplan <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "vp.xls",
export_options = export_options,
is_meta_table = TRUE)
# unzipped
visitplan_unzipped <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"),
file_name = "vp.xls",
export_options = export_options_unzipped,
is_meta_table = TRUE)
# specifically setting this here
# because the availability of the add_id is
# figured out in read_secuTrail_raw()
export_options$add_id <- TRUE
bmd_all <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "bmd.xls",
export_options = export_options,
casenodes_table = casenodes,
centre_table = centre,
visitplan_table = visitplan)
# specifically setting this here
# because the availability of the add_id is
# figured out in read_secuTrail_raw()
export_options_unzipped$add_id <- TRUE
# unzipped
bmd_all_unzipped <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"),
file_name = "bmd.xls",
export_options = export_options_unzipped,
casenodes_table = casenodes_unzipped,
centre_table = centre_unzipped,
visitplan_table = visitplan_unzipped)
bmd_no_patid_ctr_vp <- read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "bmd.xls",
export_options = export_options,
add_pat_id = FALSE,
add_centre = FALSE,
add_visitname = FALSE,
casenodes_table = casenodes,
centre_table = centre,
visitplan_table = visitplan)
# test dimensions
test_that("All dimensions as expected.", {
expect_equal(dim(casenodes), c(113, 13))
expect_equal(dim(centre), c(1, 3))
expect_equal(dim(visitplan), c(1, 10))
expect_equal(dim(bmd_all), c(504, 27))
expect_equal(dim(bmd_no_patid_ctr_vp), c(504, 24))
})
export_options_wrong_zip <- export_options
export_options_wrong_zip$is_zip <- "thatsnotit"
# test zipped and unzipped for equality
test_that("Zipped and unzipped return the same.", {
expect_true(all.equal(casenodes, casenodes_unzipped))
expect_true(all.equal(centre, centre_unzipped))
expect_true(all.equal(visitplan, visitplan_unzipped))
expect_true(all.equal(bmd_all, bmd_all_unzipped))
})
# test exceptions
test_that("Exceptions trigger as expected.", {
expect_error(read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8.zip",
package = "secuTrialR"),
file_name = "bmd.xls",
export_options = export_options_wrong_zip,
casenodes_table = casenodes,
centre_table = centre,
visitplan_table = visitplan))
})
# test custom separator
test_that("custom sep works", {
expect_error(read_export_table(data_dir = system.file("extdata", "sT_exports", "BMD",
"s_export_CSV-xls_BMD_short_en_utf8",
package = "secuTrialR"),
file_name = "cn.xls",
export_options = export_options_unzipped,
is_meta_table = TRUE,
sep = "\t"), NA)
})
ctu_quote_comma <- read_secuTrial_raw(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV-xls_CTU05_all_info.zip",
package = "secuTrialR"))
ctu_single_semicolon <- read_secuTrial_raw(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV_CTU05_20240513-124040.zip",
package = "secuTrialR"))
ctu_comma_quote <- read_secuTrial_raw(data_dir = system.file("extdata", "sT_exports", "exp_opt",
"s_export_CSV_CTU05_20240513-124102.zip",
package = "secuTrialR"))
# test escape of special characters in freetext
test_that("Special characters are escaped.",{
expect_equal(ctu_quote_comma$baseline$baseline_comment[17], "Let's \"test\" all @symbols one, two users may use;")
expect_equal(ctu_quote_comma$baseline$baseline_comment[17], ctu_single_semicolon$baseline$baseline_comment[17])
expect_equal(ctu_quote_comma$baseline$baseline_comment[17], ctu_comma_quote$baseline$baseline_comment[17])
})