@@ -4,7 +4,6 @@ extractObservationData_1 <- function(
4
4
)
5
5
{
6
6
# kwb.utils::assignPackageObjects("kwb.en13508.2")
7
- # header.info <- kwb.en13508.2::euCodedFileHeader()
8
7
9
8
# Create accessor function to header info fields
10
9
fromHeader <- kwb.utils :: createAccessor(header.info )
@@ -33,7 +32,7 @@ extractObservationData_1 <- function(
33
32
colClasses = colClasses ,
34
33
header = TRUE
35
34
)
36
-
35
+
37
36
indices $ B01 <- indices $ B [grep(" ^#B01=" , eu_lines [indices $ B ])]
38
37
39
38
# Try to generate a vector of inspection numbers assigning to each observation
@@ -133,7 +132,7 @@ getColClasses2 <- function(codes, as.text)
133
132
if (as.text ) {
134
133
colClasses [] <- " character"
135
134
}
136
-
135
+
137
136
colClasses
138
137
}
139
138
@@ -156,9 +155,9 @@ readObservationsFromCsvText <- function(text, sep, dec, quote, colClasses, ...)
156
155
}
157
156
158
157
dot.args <- list (... )
159
- # dot.args <- list() # for debugging!
158
+ # dot.args <- list(header = TRUE ) # for debugging!
160
159
161
- kwb.utils :: callWith(
160
+ result <- try( kwb.utils :: callWith(
162
161
utils :: read.table ,
163
162
text = text ,
164
163
sep = sep ,
@@ -169,5 +168,46 @@ readObservationsFromCsvText <- function(text, sep, dec, quote, colClasses, ...)
169
168
stringsAsFactors = FALSE ,
170
169
colClasses = colClasses ,
171
170
dot.args
171
+ ))
172
+
173
+ if (! kwb.utils :: isTryError(result )) {
174
+ return (result )
175
+ }
176
+
177
+ result <- kwb.utils :: callWith(
178
+ utils :: read.table ,
179
+ text = text ,
180
+ sep = sep ,
181
+ dec = dec ,
182
+ quote = quote ,
183
+ comment.char = " " ,
184
+ blank.lines.skip = FALSE ,
185
+ stringsAsFactors = FALSE ,
186
+ colClasses = NA ,
187
+ dot.args
188
+ )
189
+
190
+ convertTypes(result , codes = inspectionDataFieldCodes())
191
+ }
192
+
193
+ # convertTypes -----------------------------------------------------------------
194
+ convertTypes <- function (data , codes )
195
+ {
196
+ target_classes <- sapply(
197
+ get_elements(codes , names(data )), get_elements , " class"
172
198
)
199
+
200
+ given_classes <- sapply(data , " class" )
201
+
202
+ columns_convert <- names(which(given_classes != target_classes ))
203
+
204
+ for (column in columns_convert ) {
205
+ target_class <- target_classes [column ]
206
+ data [[column ]] <- kwb.utils :: catAndRun(
207
+ sprintf(" Converting column '%s' to %s" , column , target_class ),
208
+ do.call(paste0(" as." , target_class ), list (data [[column ]]))
209
+ )
210
+ }
211
+
212
+ data
173
213
}
0 commit comments