Showing 1 of 1 files from the diff.

@@ -67,47 +67,51 @@
Loading
67 67
                  input.source,
68 68
                  " is apparently empty"))
69 69
    }
70 -
71 -
    data <-
72 -
      data.frame(sample_date = xml2::xml_text(xml2::xml_find_all(xml_data, "./Log/Date")),
73 -
                 sample_time = xml2::xml_text(xml2::xml_find_all(xml_data, "./Log/Time")),
74 -
                 sample_millisecond = xml2::xml_double(xml2::xml_find_all(xml_data, "./Log/ms")),
75 -
                 ch1 = xml2::xml_double(xml2::xml_find_all(xml_data, "./Log/ch1")),
76 -
                 ch2 = xml2::xml_double(xml2::xml_find_all(xml_data, "./Log/ch2")),
77 -
                 stringsAsFactors = FALSE)
78 -
70 +
    
71 +
    # Get variable names for a single record
72 +
    column_names <- 
73 +
      xml2::xml_child(xml_data) %>% 
74 +
      xml2::xml_children() %>% 
75 +
      purrr::map_chr(xml2::xml_name)
76 +
    
77 +
    # Extract into a tibble
78 +
    data <- 
79 +
      column_names %>% 
80 +
      purrr::map_dfc(~sub(pattern = "^", 
81 +
                          replacement = "./Log/",
82 +
                          x = .x) %>% 
83 +
                       xml2::xml_find_all(x = xml_data, 
84 +
                                          xpath = .) %>% 
85 +
                       xml2::xml_text() %>% 
86 +
                       tibble::tibble(.) %>% 
87 +
                       setNames(.x)) %>% 
88 +
      dplyr::mutate(dplyr::across(-(1:2), as.numeric))
89 +
    
79 90
    # Get channel names
80 -
    channel_1 <-
81 -
      xml2::xml_find_first(raw_xml, "./Ch1_data_header")
82 -
83 -
    channel_2 <-
84 -
      xml2::xml_find_first(raw_xml, "./Ch2_data_header")
85 -
86 -
    ch1_name <-
87 -
      paste(tolower(xml2::xml_text(xml2::xml_child(channel_1, "./Identification"))),
88 -
            tolower(xml2::xml_text(xml2::xml_child(channel_1, "./Unit"))),
89 -
            sep = "_")
90 -
91 -
    ch2_name <-
92 -
      paste(tolower(xml2::xml_text(xml2::xml_child(channel_2, "./Identification"))),
93 -
            tolower(xml2::xml_text(xml2::xml_child(channel_2, "./Unit"))),
94 -
            sep = "_")
95 -
96 -
    # Sanitize names
97 -
    ch1_name <-
98 -
      gsub("[^A-z0-9]", "_", ch1_name)
99 -
100 -
    ch1_name <-
101 -
      gsub("_{2,}", "_", ch1_name)
102 -
103 -
    ch2_name <-
104 -
      gsub("[^A-z0-9]", "_", ch2_name)
105 -
106 -
    ch2_name <-
107 -
      gsub("_{2,}", "_", ch2_name)
108 -
91 +
    
92 +
    channel_xpaths <- 
93 +
      xml2::xml_children(raw_xml) %>% 
94 +
      purrr::map_chr(xml2::xml_name) %>% 
95 +
      grep(pattern = "Ch[0-9]{1}_data_header",
96 +
           value = TRUE) %>% 
97 +
      sub(pattern = "^", 
98 +
          replacement = "./")
99 +
    
100 +
    channel_names <- 
101 +
      purrr::map_chr(channel_xpaths,
102 +
                 ~paste(xml2::xml_text(xml2::xml_find_first(raw_xml, paste0(channel_xpaths[1], "/Identification"))),
103 +
                        xml2::xml_text(xml2::xml_find_first(raw_xml, paste0(channel_xpaths[1], "/Unit"))),
104 +
                        sep = "_") %>% 
105 +
                   tolower() %>% 
106 +
                   gsub(pattern = "[^A-z0-9]", 
107 +
                        replacement = "_") %>% 
108 +
                   gsub(pattern = "_{2,}", 
109 +
                        replacement = "_"))
110 +
    
111 +
    # Set Channel Names
112 +
    
109 113
    names(data) <-
110 -
      c("sample_date", "sample_time", "sample_millisecond", ch1_name, ch2_name)
114 +
      c("sample_date", "sample_time", "sample_millisecond", channel_names)
111 115
112 116
    # Convert to timestamp if desired
113 117
    if(collapse.timestamp){
@@ -118,7 +122,7 @@
Loading
118 122
        NULL
119 123
      data$sample_time <-
120 124
        NULL
121 -
      data <- data[,c("sample_timestamp", "sample_millisecond", ch1_name, ch2_name)]
125 +
      data <- data[,c("sample_timestamp", "sample_millisecond", channel_names)]
122 126
    }
123 127
124 128
    # Add source information to data
@@ -130,7 +134,8 @@
Loading
130 134
131 135
        # Get relevant information for the header
132 136
        # These xml2 extractions should be turned into a function or family of
133 -
        # functions
137 +
        # functions. 
138 +
        # This should be generalized using purrr like the channels were
134 139
        header_info <-
135 140
          data.frame(instrument_type = xml2::xml_text(xml2::xml_find_first(raw_xml, "//Instrument_type")),
136 141
                     model_number = xml2::xml_text(xml2::xml_find_first(raw_xml, "//Model_number")),
@@ -165,55 +170,45 @@
Loading
165 170
                        stringsAsFactors = FALSE)
166 171
167 172
        # Add channel 1 parameters to header info
168 -
        ch1_parameter_values <-
169 -
          lapply(xml2::xml_attrs(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch1_data_header//Parameters"))),
170 -
                 function(x){as.numeric(x[[1]])})
171 -
172 -
        ch1_parameter_units <-
173 -
          vapply(xml2::xml_attrs(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch1_data_header//Parameters"))),
174 -
                 function(x){gsub("[^A-z0-9]", "_", x[[2]])},
175 -
                 character(1))
176 -
177 -
        if(length(ch1_parameter_values) > 0){
178 -
          ch1_parameter_names <-
179 -
            paste(tolower(xml2::xml_name(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch1_data_header//Parameters")))),
180 -
                  ch1_parameter_units,
181 -
                  sep = "_")
182 -
183 -
          ch1_parameters <-
184 -
            as.data.frame(ch1_parameter_values,
185 -
                          col.names = ch1_parameter_names,
186 -
                          stringsAsFactors = FALSE)
187 -
188 -
          header_info <-
189 -
            cbind(header_info, ch1_parameters)
190 -
        }
191 -
192 -
        # Add channel 2 parameters to header info
193 -
        ch2_parameter_values <-
194 -
          lapply(xml2::xml_attrs(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch2_data_header//Parameters"))),
195 -
                 function(x){as.numeric(x[[1]])})
196 -
197 -
        ch2_parameter_units <-
198 -
          vapply(xml2::xml_attrs(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch2_data_header//Parameters"))),
199 -
                 function(x){gsub("[^A-z0-9]", "_", x[[2]])},
200 -
                 character(1))
201 -
202 -
        if(length(ch2_parameter_values) > 0){
203 -
          ch2_parameter_names <-
204 -
            paste(tolower(xml2::xml_name(xml2::xml_children(xml2::xml_find_first(raw_xml, "//Ch2_data_header//Parameters")))),
205 -
                  ch2_parameter_units,
206 -
                  sep = "_")
207 -
208 -
          ch2_parameters <-
209 -
            as.data.frame(ch2_parameter_values,
210 -
                          col.names = ch2_parameter_names,
211 -
                          stringsAsFactors = FALSE)
212 -
213 -
          header_info <-
214 -
            cbind(header_info, ch2_parameters)
215 -
216 -
        }
173 +
        channel_metadata <- 
174 +
          channel_xpaths %>% 
175 +
          purrr::map(~xml2::xml_find_first(raw_xml, .x) %>% 
176 +
                       xml2::xml_find_first("./Parameters") %>% 
177 +
                       xml2::xml_children())
178 +
        
179 +
        channel_parameter_values <- 
180 +
          purrr::map(channel_metadata,
181 +
                     xml2::xml_attrs)
182 +
          
183 +
        channel_parameter_names <- 
184 +
          purrr::map(channel_metadata,
185 +
                     xml2::xml_name)
186 +
        
187 +
        # Remove channels that don't have additional metadata
188 +
        has_parameters <- 
189 +
          purrr::map_lgl(channel_parameter_names,
190 +
                         ~length(.x) != 0)
191 +
        
192 +
        channel_header_info <- 
193 +
          purrr::map2_dfc(channel_parameter_values[has_parameters],
194 +
                          channel_parameter_names[has_parameters],
195 +
                          ~{
196 +
                            value <- .x[[1]][1]
197 +
                            unit <- as.character(.x[[1]][2])
198 +
                            name <- tolower(paste(.y, unit, sep = "_"))
199 +
                            
200 +
                            # Convert to numeric if value contains only number and decimals
201 +
                            if(!any(grepl("[^0-9\\.]", value))){
202 +
                              value <- as.numeric(value)
203 +
                            }
204 +
                            
205 +
                            tibble::tibble(x = value) %>% 
206 +
                              setNames(name)
207 +
                            })
208 +
        
209 +
        header_info <- 
210 +
          cbind(header_info,
211 +
                channel_header_info)
217 212
218 213
        # Export header information to a temporary file
219 214
        export_header(header_info,
Files Coverage
R 89.34%
Project Totals (9 files) 89.34%
Notifications are pending CI completion. Periodically Codecov will check the CI state, when complete notifications will be submitted. Push notifications now.
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading