moar functions

function to reconcile location of paired measurements
function to evaluate NMEA sentence checksums
speed improvements
Internalify helpers with no broader use case

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: em38
 Type: Package
 Title: Process N38 binary files from EM38-MK2 sensors
-Version: 0.0.0.9001
+Version: 0.0.0.9002
 Authors@R: person("Lauren", "O'Brien", email = "[email protected]", role = c('aut', 'cre'))
 Description: Interprets and decodes the '.N38' file format used by the 
     Geonics EM38-MK2 ground conductivity meter, as described in its 

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(em38_pair)
 export(em38_spatial)
 export(n38_chunk)
 export(n38_decode)
@@ -14,10 +15,17 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,ungroup)
 importFrom(purrr,flatten)
 importFrom(purrr,map)
+importFrom(purrr,map2)
 importFrom(purrr,map_lgl)
 importFrom(purrr,transpose)
 importFrom(rlang,.data)
 importFrom(sf,st_as_sf)
+importFrom(sf,st_crs)
+importFrom(sf,st_geometry)
+importFrom(sf,st_point)
+importFrom(sf,st_set_geometry)
+importFrom(sf,st_sf)
+importFrom(sf,st_sfc)
 importFrom(stats,complete.cases)
 importFrom(stats,na.omit)
 importFrom(tidyr,fill)

NEWS.md

@@ -1,8 +1,15 @@
+# v 0.0.0.9002
+
+  * Who's got two thumbs and forgot about `@keywords Internal`? \*gestures at self\*
+  * Function `em38_pair()` added - combines data from manual-mode surveys where horizontal and vertical readings have been taken at each station
+  * Checksums on NMEA-0183 sentences are evaluated for $GPGGA type, failures are dropped.
+
 # v. 0.0.0.9001
 
-  * wrapper function added - `n38_to_points()` goes from on-disk file to spatial points in one line.
-  * rebuilt demo data to match demo extdata
-  * variable name fix in `n38_import()`
+  * Wrapper function added - `n38_to_points()` goes from on-disk file to spatial points in one hit.
+  * Rrebuilt demo data to match demo extdata
+  * Variable name fix in `n38_import()`
+  * Constrain out_mode better in `em38_spatialise()`
 
 # v. 0.0.0.9000
 

R/GPS_data.R

@@ -1,3 +1,31 @@
+#' Calculate NMEA-0183 XOR checksum
+#'
+#' This function calculates the checksum for NMEA-0183 GPGGA strings.
+#' @param string A string with valid NMEA-0183 GPGGA structure.
+#' @return Logical; TRUE if checksum is correct.
+#' @examples
+#' # first GPGGA msg from data('n38_demo')
+#' msg_1   <- "$GPGGA,015808.00,2726.53758,S,15126.05255,E,1,08,1.0,365.1,M,39.5,M,,*79"
+#' msg_2   <- "$GPG5808.00,2726.53758,S,15126.05255,E,1,08,1.0,365.1,M,39.5,M,,*79"
+#' chk_1     <- em38:::nmea_check(string = msg_1)
+#' chk_2     <- em38:::nmea_check(string = msg_2)
+#'
+nmea_check <- function(string = NULL) {
+  prs <- unlist(strsplit(string, '\\*'))[1]
+  chk <- unlist(strsplit(string, '\\*'))[2]
+  # fn still works if starting $ missing already
+  prs <- gsub('^\\$', '', prs)
+  prs <- sapply(unlist(strsplit(prs, '*')), charToRaw)
+  # lower case required for comparison
+  chk <- tolower(unlist(strsplit(string, '\\*'))[2])
+
+  prs_chksum <- base::Reduce(xor, prs)
+
+  # good ol' coercion rules, see ?base::Comparison
+  if(prs_chksum == chk) { TRUE } else { FALSE }
+}
+
+
 #' Process NMEA-0183 GPGGA messages
 #'
 #' This function pulls out position fix data from NMEA-0183 GPGGA strings and dumps it into a list.
@@ -6,7 +34,7 @@
 #' are given appropriate data types. NB UTC time is returned as POSIXlt, so Sys.date() comes along
 #' for the ride.
 #' @examples
-#' # first GPGGA msg from decoded demo dataset
+#' # first GPGGA msg from data('n38_demo')
 #' msg_1   <- "$GPGGA,015808.00,2726.53758,S,15126.05255,E,1,08,1.0,365.1,M,39.5,M,,*79"
 #' gpgga_1 <- em38:::process_gpgga(string = msg_1)
 #' @importFrom units ud_units
@@ -48,7 +76,7 @@ process_gpgga <- function(string = NULL) {
   # sentence between – but not including – the $ and the * character."
   # https://rietman.wordpress.com/2008/09/25/how-to-calculate-the-nmea-checksum/
   out[['checksum']] <- gsub('^[^\\*]*', '', gga_reading[15])
-  # todo: implement validation
+  # validated later
   out
 }
 
@@ -60,7 +88,7 @@ process_gpgga <- function(string = NULL) {
 #' @return A list containing 6 data elements recorded in NMEA-0183 GPVTG data chunks. Elements
 #' are given appropriate data types.
 #' @examples
-#' # first GPGVTG msg from decoded demo dataset
+#' # first GPGVTG msg from data('n38_demo')
 #' msg_1   <- "$GPVTG,208.02,T,,M,0.32,N,0.59,K,A*38"
 #' gpvtg_1 <- em38:::process_gpvtg(string = msg_1)
 #' @importFrom units ud_units
@@ -92,7 +120,7 @@ process_gpvtg <- function(string = NULL) {
 #' @return A list containing 9 data elements recorded in NMEA-0183 GPRMC data chunks. Elements
 #' are given appropriate data types.
 #' @examples
-#' # first GPRMC msg from decoded demo dataset
+#' # first GPRMC msg from data('n38_demo')
 #' msg_1   <- "$GPRMC,015808.00,A,2726.53758,S,15126.05255,E,0.32,208.02,160318,,,A*48"
 #' gprmc_1 <- em38:::process_gprmc(string = msg_1)
 #'
@@ -134,7 +162,7 @@ process_gprmc <- function(string = NULL) {
 #' @return A list containing n data elements recorded in NMEA-0183 GPGSA data chunks. Elements
 #' are given appropriate data types.
 #' @examples
-#' # first GPGSA msg from decoded demo dataset
+#' # first GPGSA msg from data('n38_demo')
 #' msg_1   <- "$GPGSA,M,3,05,10,15,16,20,21,26,29,,,,,1.6,1.0,1.2*32"
 #' gpgsa_1 <- em38:::process_gpgsa(string = msg_1)
 #'
@@ -178,7 +206,7 @@ process_gpgsa <- function(string = NULL) {
 #' Note also that SNR is receiver-dependant and should only be considered relative to other
 #' readings in the same dataset.
 #' @examples
-#' # first GPGSV msg from decoded demo dataset
+#' # first GPGSV msg from data('n38_demo')
 #' msg_1   <- "$GPGSV,3,1,11,05,14,138,46,10,14,316,37,12,04,012,,13,24,100,*76"
 #' gpgsv_1 <- em38:::process_gpgsv(string = msg_1)
 #'

R/chunk_processing.R

@@ -4,6 +4,7 @@
 #' internal function with no wider use case.
 #' @param file_header A matrix with 2 rows and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 9 information elements recorded in N38 file headers.
+#' @keywords Internal
 #' @examples
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -53,6 +54,7 @@ process_fheader <- function(file_header = NULL) {
 #'  This is an internal function with no wider use case.
 #' @param survline_header A matrix with 4 rows and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 5 information elements recorded in N38 survey line headers.
+#' @keywords Internal
 #' @examples
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -82,6 +84,7 @@ process_slheader <- function(survline_header = NULL) {
 #'  This is an internal function with no wider use case.
 #' @param cal_row A matrix with 1 row and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 3 information elements recorded in N38 calibration rows.
+#' @keywords Internal
 #' @examples
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -104,6 +107,7 @@ process_cal <- function(cal_row = NULL) {
 #' @param timer_rel A matrix with 1 row and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 2 information elements recorded in N38 timer relation rows. Note that
 #' time will be returned in the local timezone.
+#' @keywords Internal
 #' @examples
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -126,6 +130,7 @@ process_timer <- function(timer_rel = NULL) {
 #' is an internal function with no wider use case.
 #' @param reading A matrix with 1 row and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 10 data elements recorded in N38 instrument reading rows.
+#' @keywords Internal
 #' @examples
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -180,6 +185,7 @@ process_reading <- function(reading = NULL) {
 #'  This is an internal function with no wider use case.
 #' @param comment A matrix with 1 row and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 2 data elements recorded in N38 comment rows.
+#' @keywords Internal
 #' @examples \dontrun{
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)
@@ -201,6 +207,7 @@ process_comment <- function(comment = NULL) {
 #'  This is an internal function with no wider use case.
 #' @param nstat A matrix with 1 row and 25 columns, produced by \code{\link{n38_import}}.
 #' @return A list containing 2 data elements recorded in N38 new station rows.
+#' @keywords Internal
 #' @examples \dontrun{
 #' data('n38_demo')
 #' n38_chunked <- n38_chunk(n38_demo)

R/import_export.R

@@ -206,14 +206,14 @@ n38_decode <- function(chunks = NULL) {
     # ditch the `#` newline signifiers and whitespace, convert to string
     locs <- lapply(locs, function(x) {
       x[x == '#'] <- NA
-      x[x == ' ']  <- NA
+      x[x == ' '] <- NA
       paste0(na.omit(x), collapse = '')
     })
 
-    # The following ditches checksum fails - these start with ? not @ and use " instead of # as an
-    # internal newline signifier. Also handled are cases where GPS messages can occasionally get cut
-    # off after the message comes through but before the timestamp does (this where someone hits
-    # pause at the wrong time)
+    # The following ditches checksum fails that have already been flagged by GPS software. These
+    # start with ? not @ and use " instead of # as an internal newline signifier. Also handled are
+    # cases where GPS messages can occasionally get cut off after the message comes through but
+    # before the timestamp does (this where someone hits pause at the wrong time)
     keep <- purrr::map_lgl(locs, function(x) grepl('^@.+\\!', x))
     locs <- locs[keep]
 
@@ -224,8 +224,14 @@ n38_decode <- function(chunks = NULL) {
          type <- substr(x, 3, 7)
          bang <- as.integer(gregexpr('!', x))
          msg  <- substr(x, 9, bang - 1)
-         ts   <-  as.integer(substr(x, bang + 1, nchar(x)))
-         list('TYPE' = type, 'MESSAGE' = msg, 'timestamp_ms' = ts)
+         # only checking GPGGA messages to save time
+         chks <- if(type == 'GPGGA') {
+           nmea_check(substr(x, 2, bang - 1))
+         } else {
+           NA
+         }
+         ts   <- as.integer(substr(x, bang + 1, nchar(x)))
+         list('TYPE' = type, 'MESSAGE' = msg, 'CHKSUM' = chks, 'timestamp_ms' = ts)
        })
 
     out <- purrr::transpose(out)

R/signal_conversion.R

@@ -6,6 +6,7 @@
 #'  isolation.
 #' @param signal Integer.
 #' @return Numeric; uncalibrated instrument reading.
+#' @keywords Internal
 #' @examples
 #' channel_1_or_3 <- em38:::get_cond(30456)
 #' channel_2 <- em38:::get_cond(30456) * 0.00720475
@@ -20,6 +21,7 @@ get_cond <- function(signal = NULL) {
 #' This function calculates temperature from an EM38-MK2 signal recieved on Channel 5 or 6.
 #' @param signal Integer.
 #' @return Temperature in degrees C
+#' @keywords Internal
 #' @examples
 #' channel_5 <- em38:::get_temp(30456)
 #'
@@ -38,6 +40,7 @@ get_temp <- function(signal = NULL) {
 #' @return Numeric, latitude in decimal degrees.
 #' @note Inputting a numeric to lat will give incorrect results for latitude -10 < x < 10 due to
 #' loss of leading zero(s).
+#' @keywords Internal
 #' @examples
 #' lat <- em38:::gpgga_lat('2729.10198', 'S')
 #'
@@ -67,6 +70,7 @@ gpgga_lat <- function(lat = NULL, dir = NULL) {
 #' @return Numeric, longitude in decimal degrees.
 #' @note Inputting a numeric to long will give incorrect results for longitude -100 < x < 100 due to
 #' loss of leading zero(s).
+#' @keywords Internal
 #' @examples
 #' lat <- em38:::gpgga_long('15257.5556', 'E')
 #'