Nothing
# vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4
#' @template readAdvTemplate
#'
#' @template encodingIgnoredTemplate
#'
#' @param start the time of the first sample, typically created with
#' [as.POSIXct()]. This may be a vector of times,
#' if `filename` is a vector of file names.
#'
#' @param deltat the time between samples.
#'
#' @template adReadingMethodTemplate
read.adv.sontek.serial <- function(
file, from = 1, to, by = 1, tz = getOption("oceTz"), longitude = NA, latitude = NA,
start = NULL, deltat = NULL, encoding = NA, monitor = FALSE,
debug = getOption("oceDebug"), processingLog = NULL) {
if (missing(file)) {
stop("must supply 'file'")
}
if (is.character(file)) {
if (!file.exists(file)) {
stop("cannot find file \"", file, "\"")
}
if (0L == file.info(file)$size) {
stop("empty file \"", file, "\"")
}
}
if (!interactive()) {
monitor <- FALSE
}
oceDebug(debug, paste("read.adv.sontek.serial(file[1]=\"", file[1],
"\", from=", format(from),
if (!missing(to)) sprintf(", to=%s, ", format(to)),
", by=", by,
", start[1]=", format(start[1]),
", deltat=", deltat,
", debug=", debug,
", monitor=", monitor,
", processingLog=(not shown)) START\n",
sep = ""
), unindent = 1)
if (is.null(start) || is.numeric(start)) {
stop("'start' must be a string, or a POSIXt time")
}
if (is.character(start)) {
start <- as.POSIXct(start, tz = tz)
}
if (!is.numeric(deltat)) {
stop("must supply deltat, the number of seconds between observations")
}
nstart <- length(start)
nfile <- length(file)
if (nstart != nfile) {
stop("length of 'file' must equal length of 'start', but they are ", nfile, " and ", nstart, " respectively")
}
warning("cannot infer coordinate system, etc., since header=FALSE; see documentation.")
oceDebug(debug, "time series is inferred to start at", format(start[1]), "\n")
if (is.character(deltat)) {
deltat <- ctimeToSeconds(deltat)
}
oceDebug(debug, "time series is inferred to have data every", deltat, "s\n")
if (nstart > 1) {
# handle multiple files
oceDebug(debug, "handling multiple files\n")
buf <- NULL
for (i in 1:nfile) {
oceDebug(debug, "loading \"", file[i], "\" (startTime ", format(start[i]), " ", attr(start[i], "tzone"), ")\n", sep = "")
thisFile <- file(file[i], "rb")
seek(thisFile, 0, "end", rw = "read")
fileSize <- seek(thisFile, 0, origin = "start", rw = "read")
oceDebug(debug, "fileSize=", fileSize, "\n")
buf <- c(buf, readBin(thisFile, what = "raw", n = fileSize, endian = "little"))
close(thisFile)
}
filename <- paste("(\"", file[i], "\", ...)", sep = "")
} else {
# handle single file (which might be a connection, etc)
if (is.character(file)) {
filename <- fullFilename(file)
file <- file(file, "rb")
on.exit(close(file))
}
if (!inherits(file, "connection")) {
stop("argument `file' must be a character string or connection")
}
if (!isOpen(file)) {
filename <- "(connection)"
open(file, "rb")
on.exit(close(file))
}
# read whole file into buffer
seek(file, 0, "end", rw = "read")
fileSize <- seek(file, 0, origin = "start", rw = "read")
oceDebug(debug, "filesize=", fileSize, "\n")
buf <- readBin(file, what = "raw", n = fileSize, endian = "little")
}
p <- .Call("ldc_sontek_adv_22_old", buf, 0) # the 0 means to get all pointers to data chunks
# FIXME <issue 2201> keep this test for a while
pNew <- ldcSontekAdv22(buf, 0)
if (!identical(p, as.integer(pNew))) {
message("IMPORTANT: read.adv.sontek.serial/ldcSontekAdv22 problem -- please report at github.com/dankelley/oce/issues")
warning("IMPORTANT: read.adv.sontek.serial/ldcSontekAdv22 problem -- please report at github.com/dankelley/oce/issues")
}
pp <- sort(c(p, p + 1))
len <- length(p)
oceDebug(debug, "dp:", paste(unique(diff(p)), collapse = ","), "\n")
serialNumber <- readBin(buf[pp + 2], "integer", size = 2, n = len, signed = FALSE, endian = "little")
serialNumber <- .Call("unwrap_sequence_numbers_old", serialNumber, 2)
serialNumberNew <- unwrapSequenceNumbers(serialNumber, 2)
# FIXME <issue 2201> keep this test for a while
if (!identical(serialNumber, as.integer(serialNumberNew))) {
message("IMPORTANT: read.adv.sontek.serial/unwrapSequenceNumbers problem -- please report at github.com/dankelley/oce/issues")
warning("IMPORTANT: read.adv.sontek.serial/unwrapSequenceNumbers problem -- please report at github.com/dankelley/oce/issues")
}
velocityScale <- 1e-4
time <- start[1] + (serialNumber - serialNumber[1]) * deltat
deltat <- mean(diff(as.numeric(time))) # FIXME: should rename this to avoid confusion
res <- new("adv", time = time, filename = filename)
# FIXME: emulate this direct injection in other functions, in hopes of reducing memory footprint
res@data$v <- array(numeric(), dim = c(len, 3))
res@data$v[, 1] <- velocityScale * readBin(buf[pp + 4], "integer", size = 2, n = len, signed = TRUE, endian = "little")
res@data$v[, 2] <- velocityScale * readBin(buf[pp + 6], "integer", size = 2, n = len, signed = TRUE, endian = "little")
res@data$v[, 3] <- velocityScale * readBin(buf[pp + 8], "integer", size = 2, n = len, signed = TRUE, endian = "little")
res@data$a <- array(raw(), dim = c(len, 3))
res@data$a[, 1] <- as.raw(readBin(buf[p + 10], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$a[, 2] <- as.raw(readBin(buf[p + 11], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$a[, 3] <- as.raw(readBin(buf[p + 12], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$q <- array(raw(), dim = c(len, 3))
res@data$q[, 1] <- as.raw(readBin(buf[p + 13], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$q[, 2] <- as.raw(readBin(buf[p + 14], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$q[, 3] <- as.raw(readBin(buf[p + 15], "integer", size = 1, n = len, signed = FALSE, endian = "little"))
res@data$temperature <- 0.01 * readBin(buf[pp + 16], "integer", size = 2, n = len, signed = TRUE, endian = "little")
res@data$pressure <- readBin(buf[pp + 18], "integer", size = 2, n = len, signed = FALSE, endian = "little") # may be 0 for all
# FIXME: Sontek ADV transformation matrix equal for all units? (Nortek Vector is not.)
# below for sontek serial number B373H
# Transformation Matrix -----> 2.710 -1.409 -1.299
# -----> 0.071 2.372 -2.442
# -----> 0.344 0.344 0.344
# > rbind(c(2.710,-1.409,-1.299),c(0.071,2.372,-2.442),c(0.344,0.344,0.344)) * 4096
# [,1] [,2] [,3]
# [1,] 11100.160 -5771.264 -5320.704
# [2,] 290.816 9715.712 -10002.432
# [3,] 1409.024 1409.024 1409.024
# transformationMatrix <- rbind(c(11100, -5771, -5321),
# c( 291, 9716, -10002),
# c( 1409, 1409, 1409)) / 4096
transformationMatrix <- NULL
res@metadata$manufacturer <- "sontek"
res@metadata$instrumentType <- "adv"
res@metadata$filename <- filename
res@metadata$longitude <- longitude
res@metadata$latitude <- latitude
res@metadata$numberOfSamples <- len
res@metadata$numberOfBeams <- 3
res@metadata$serialNumber <- "?"
res@metadata$transformationMatrix <- transformationMatrix
res@metadata$measurementStart <- time[1]
res@metadata$measurementEnd <- time[length(time)]
res@metadata$measurementDeltat <- deltat
res@metadata$subsampleStart <- time[1] # FIXME: this seems wrong
res@metadata$subsampleEnd <- time[length(time)] # FIXME: this seems wrong
res@metadata$subsampleDeltat <- deltat
# ??? very old code, but meaningless -- res@metadata$##velocityScale <- velocityScale
res@metadata$originalCoordinate <- "xyz" # guess
res@metadata$velocityResolution <- velocityScale
res@metadata$velocityMaximum <- velocityScale * 2^15
res@metadata$oceCoordinate <- "xyz" # guess
res@metadata$orientation <- "upward" # guess
warning("sontek adv in serial format lacks heading, pitch and roll: user must fill in")
res@data$heading <- rep(0, len)
res@data$pitch <- rep(0, len)
res@data$roll <- rep(0, len)
res@metadata$units$v <- list(unit = expression(m / s), scale = "")
res@metadata$units$pressure <- list(unit = expression(dbar), scale = "")
res@metadata$units$heading <- list(unit = expression(degree), scale = "")
res@metadata$units$pitch <- list(unit = expression(degree), scale = "")
res@metadata$units$roll <- list(unit = expression(degree), scale = "")
res@metadata$units$temperature <- list(unit = expression(degree * C), scale = "")
if (is.null(processingLog)) {
processingLog <- paste(deparse(match.call()), sep = "", collapse = "")
}
res@processingLog <- processingLogAppend(res@processingLog, processingLog)
res
}
#' @template readAdvTemplate
#'
#' @template encodingIgnoredTemplate
#'
#' @param header A logical value indicating whether the file starts with a header.
#' (This will not be the case for files that are created by data loggers that
#' chop the raw data up into a series of sub-files, e.g. once per hour.)
#'
#' @section References:
#'
#' 1. SonTek/YSI Incorporated. "ADVField/Hydra Operation Manual," September 1, 2001.
#'
#' 2. SonTek/YSI Incorporated. "Argonaut Acoustic Doppler Current Meter Operation Manual Firmware Version 7.9."
#' SonTek/YSI, May 1, 2001.
#' https://eng.ucmerced.edu/snsjho/files/San_Joaquin/Sensors_and_Loggers/SonTek/SonTek_Argonaut/ArgonautXR.pdf.
#'
#' @template adReadingMethodTemplate
read.adv.sontek.adr <- function(
file, from = 1, to, by = 1, tz = getOption("oceTz"), header = TRUE,
longitude = NA, latitude = NA, encoding = NA,
debug = getOption("oceDebug"), monitor = FALSE, processingLog = NULL) {
if (missing(file)) {
stop("must supply 'file'")
}
if (is.character(file)) {
if (!file.exists(file)) {
stop("cannot find file \"", file, "\"")
}
if (0L == file.info(file)$size) {
stop("empty file \"", file, "\"")
}
}
if (!interactive()) {
monitor <- FALSE
}
bisectAdvSontekAdr <- function(burstTime, tFind, add = 0, debug = 0) {
oceDebug(debug, "bisectAdvSontekAdr(tFind=", format(tFind), ", add=", add, "\n")
len <- length(burstTime)
lower <- 1
upper <- len
passes <- floor(10 + log(len, 2)) # won't need this many; only do this to catch coding errors
for (pass in 1:passes) {
middle <- floor((upper + lower) / 2) # nolint (no space before opening parenthesis)
t <- burstTime[middle]
if (tFind < t) {
upper <- middle
} else {
lower <- middle
}
if (upper - lower < 2) {
break
}
oceDebug(debug, paste("burstTime[", middle, "] = ", format(t), " (at pass ", pass, " of ", passes, ")\n", sep = ""))
}
middle <- middle + add # may use add to extend before and after window
if (middle < 1) middle <- 1
if (middle > len) middle <- len
t <- burstTime[middle]
oceDebug(debug, "result: t=", format(t), "\n")
return(list(index = middle, time = t))
}
# The binary format is documented in Appendix 2.2.3 of the Sontek ADV
# operation Manual - Firmware Version 4.0 (Oct 1997).
oceDebug(debug, "read.adv.sontek.adr() START\n", unindent = 1)
if (is.character(file)) {
filename <- fullFilename(file)
file <- file(file, "rb")
on.exit(close(file))
}
if (!inherits(file, "connection")) {
stop("argument `file' must be a character string or connection")
}
if (!isOpen(file)) {
filename <- "(connection)"
open(file, "rb")
on.exit(close(file))
}
# read whole file into 'buf'
seek(file, 0, "end", rw = "read")
fileSize <- seek(file, 0, origin = "start", rw = "read")
oceDebug(debug, "filesize=", fileSize, "\n")
buf <- readBin(file, what = "raw", n = fileSize, endian = "little")
# CONFUSION
#
# Reference 1 (on which the following code is based) says the three headers
# (here called hardwareConfiguration, probeConfiguration and
# deploymentParameters) have lengths 24, 164 and 253 (for a total of 441)
# but Reference 2 says the three headers have lengths 96, 64 and 258 (for a
# total of 418). I have not examined things line by line, but a disparity
# like this is worrisome. Note that we may still be reading the data
# correctly because we key on byte sequences for the starts of burst.
# /CONFUSION
#
# Read header, or create a nominal default one. The info in the next 3 lines
# is from Reference 1. FIXME: I should look at the items one by one, to see
# if the things we read and use are the same in both documents. That could
# be the case, I suppose. But how do we know which of these documents we
# ought to use, even for old data like this?
#
# 24 bytes hardwareConfiguration ("AdvSystemConfigType" in the docs)
# 164 bytes probeConfiguration ("AdvConfType" in the docs)
# 253 bytes deployment setup ("AdvDeploymentSetupType" in the docs)
hardwareConfigurationLength <- 24
probeConfigurationLength <- 164
deploymentParametersLength <- 253
burstHeaderLength <- 60
# checksumLength <- 2
dataLength <- 22 # FIXME: this should be determined based on the headers
res <- new("adv")
res@metadata$manufacturer <- "sontek"
res@metadata$instrumentType <- "adv" # FIXME or "adr"???
res@metadata$filename <- filename
res@metadata$longitude <- longitude
res@metadata$latitude <- latitude
res@metadata$numberOfSamples <- NA # fill in later
res@metadata$numberOfBeams <- NA # fill in later
res@metadata$measurementDeltat <- 1
res@metadata$velocityScale <- 1e-4
if (header) {
# Slice out three headers
hardwareConfiguration <- buf[1:hardwareConfigurationLength]
probeConfiguration <- buf[hardwareConfigurationLength + 1:probeConfigurationLength]
deploymentParameters <- buf[hardwareConfigurationLength + probeConfigurationLength + 1:deploymentParametersLength]
# Analyze "hardwareConfiguration" header
res@metadata$cpuSoftwareVerNum <- 0.1 * as.numeric(hardwareConfiguration[1])
oceDebug(debug, "cpuSoftwareVerNum=", res@metadata$cpuSoftwareVerNum, "\n")
res@metadata$dspSoftwareVerNum <- 0.1 * as.numeric(hardwareConfiguration[2])
oceDebug(debug, "dspSoftwareVerNum=", res@metadata$dspSoftwareVerNum, "\n")
res@metadata$orientation <- c("downward", "upward", "sideways")[1 + as.numeric(hardwareConfiguration[4])]
oceDebug(debug, "orientation=", res@metadata$orientation, "\n")
res@metadata$compassInstalled <- as.integer(hardwareConfiguration[5]) == 1
oceDebug(debug, "compassInstalled=", res@metadata$compassInstalled, "\n")
if (!res@metadata$compassInstalled) {
stop("cannot handle data files for ADV files that lack compass data")
}
res@metadata$recorderInstalled <- if (as.integer(hardwareConfiguration[6]) == 1) TRUE else FALSE
oceDebug(debug, "recorderInstalled=", res@metadata$recorderInstalled, "\n")
res@metadata$thermometerInstalled <- as.integer(hardwareConfiguration[7]) == 1
oceDebug(debug, "thermometerInstalled=", res@metadata$thermometerInstalled, "\n")
if (!res@metadata$thermometerInstalled) {
stop("cannot handle data files for ADV files that lack thermometer data")
}
res@metadata$pressureInstalled <- as.integer(hardwareConfiguration[8]) == 1
oceDebug(debug, "pressureInstalled=", res@metadata$pressureInstalled, "\n")
if (!res@metadata$pressureInstalled) {
stop("cannot handle data files for ADV files that lack pressure data")
}
# we report pressure in dbar, so use the fact that 1 nanobar/count = 1e-8 dbar/count
res@metadata$pressureScale <- 1e-8 * readBin(hardwareConfiguration[9:12], "integer", size = 4, n = 1, endian = "little")
oceDebug(debug, "pressureScale=", res@metadata$pressureScale, " dbar/count (header gives in nanobar/count)\n")
# we report pressure in dbar, so use the fact that 1 microbar = 1e-5 dbar
res@metadata$pressureOffset <- 1e-5 * readBin(hardwareConfiguration[13:16], "integer", size = 4, n = 1, endian = "little")
oceDebug(debug, "pressureOffset=", res@metadata$pressureOffset, " dbar (header gives in microbar)\n")
res@metadata$compassOffset <- readBin(hardwareConfiguration[23:24], "integer", size = 2, n = 1, endian = "little", signed = TRUE)
oceDebug(debug, "compassOffset=", res@metadata$compassOffset, " (degrees to East of North)\n")
res@metadata$pressFreqOffset <- as.integer(hardwareConfiguration[25])
oceDebug(debug, "pressFreqOffset=", res@metadata$pressFreqOffset, " (\"Frequency Pres Sensor Offset\" in docs)\n")
res@metadata$extSensorInstalled <- as.integer(hardwareConfiguration[26])
oceDebug(debug, "extSensorInstalled=", res@metadata$extSensorInstalled, " (\"0=None, 1=Standard (ch 1/3)\" in docs)\n")
res@metadata$extPressInstalled <- as.integer(hardwareConfiguration[27])
oceDebug(debug, "extPressInstalled=", res@metadata$extPressInstalled, " (1=Paros 2=Druck 3=ParosFreq)\n")
# we report pressure in dbar, so use the fact that 1 pbar = 1e-11 dbar
res@metadata$pressureScale2 <- 1e-11 * readBin(hardwareConfiguration[28:29], "integer", size = 2, n = 1, endian = "little", signed = TRUE)
oceDebug(debug, "pressureScale2=", res@metadata$pressureScale2, " dbar/count^2 (file gives in picobar/count^2)\n")
# Analyze "probeConfiguration" header
# Docs (p102 of Sontek-ADV-op-man-2001.pdf) say as follows (the initial index number is mine):
# [1] unsigned char FileType
# [2] unsigned char FileVer
# [3:6] DateType FileDate (4 bytes for real-time clock, 2 for year, 1 for day, 1 for month)
# [7:10] long FileNbytes
# [11:16] SerialNum[6]
# [16] char ProbeType
# [17] char ProbeSize
# [18:19] int ProbeNBeams
# ...
res@metadata$serialNumber <- paste(readBin(probeConfiguration[11:16], "character", n = 5, size = 1), collapse = "") # "B373H"
oceDebug(debug, "serialNumber=", res@metadata$serialNumber, "\n")
res@metadata$probeType <- readBin(probeConfiguration[17], "integer", n = 1, size = 1)
oceDebug(debug, "probeType=", res@metadata$probeType, " (\"3/2-d orientation\", according to the docs)\n")
res@metadata$probeSize <- readBin(probeConfiguration[18], "integer", n = 1, size = 1)
oceDebug(debug, "probeSize=", res@metadata$probeSize, " (0 means 5cm; 1 means 10cm probe, according to docs)\n")
res@metadata$numberOfBeams <- readBin(probeConfiguration[19:20], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "numberOfBeams=", res@metadata$numberOfBeams, " (should be 3)\n")
if (res@metadata$numberOfBeams != 3) {
warning("number of beams should be 3, but it is ", res@metadata$numberOfBeams, " ... reseting to 3")
}
res@metadata$probeNomPeakPos <- readBin(probeConfiguration[21:22], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "probeNomPeakPos=", res@metadata$probeNomPeakPos, " (not used here)\n")
res@metadata$probeNsamp <- readBin(probeConfiguration[23:24], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "probeNsamp=", res@metadata$probeNsamp, " (not used here)\n")
res@metadata$probeSampInterval <- readBin(probeConfiguration[25:26], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "probeSampInterval=", res@metadata$probeSampInterval, " (not used here)\n")
res@metadata$probePulseLag <- readBin(probeConfiguration[27:56], "integer", n = 15, size = 2, endian = "little")
oceDebug(debug, vectorShow(res@metadata$probePulseLag))
res@metadata$probeNxmit <- readBin(probeConfiguration[57:86], "integer", n = 15, size = 2, endian = "little")
oceDebug(debug, vectorShow(res@metadata$probeNxmit))
res@metadata$probeLagDelay <- readBin(probeConfiguration[87:116], "integer", n = 15, size = 2, endian = "little")
oceDebug(debug, vectorShow(res@metadata$probeLagDelay))
res@metadata$probeBeamDelay <- readBin(probeConfiguration[117:118], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "probeBeamDelay=", res@metadata$probeBeamDelay, " (not used here)\n")
res@metadata$probePingDelay <- readBin(probeConfiguration[119:120], "integer", n = 1, size = 2, endian = "little")
oceDebug(debug, "probePingDelay=", res@metadata$probePingDelay, " (not used here)\n")
res@metadata$transformationMatrix <- matrix(readBin(probeConfiguration[121:157], "numeric", n = 9, size = 4, endian = "little"),
nrow = 3, byrow = TRUE
)
oceDebug(debug, "transformation matrix:\n")
oceDebug(debug, " ", format(res@metadata$transformationMatrix[1, ], width = 10, digits = 5, justify = "right"), "\n")
oceDebug(debug, " ", format(res@metadata$transformationMatrix[2, ], width = 10, digits = 5, justify = "right"), "\n")
oceDebug(debug, " ", format(res@metadata$transformationMatrix[3, ], width = 10, digits = 5, justify = "right"), "\n")
# [158:161] float XmitRecDist
# [162:165] float CalCw
# FIXME why is this not 164 bytes in total?
#
# Analyze "deploymentParameters" header
if (deploymentParameters[1] != 0x12) {
stop("first byte of deploymentParameters header should be 0x12 but it is 0x", deploymentParameters[1])
}
if (deploymentParameters[2] != 0x01) {
stop("first byte of deploymentParameters header should be 0x01 but it is 0x", deploymentParameters[2])
}
res@metadata$velocityRangeIndex <- as.numeric(deploymentParameters[20])
oceDebug(debug, "velocityRangeIndex=", res@metadata$velocityRangeIndex, "\n")
if (res@metadata$velocityRangeIndex == 4) {
res@metadata$velocityScale <- 2 * res@metadata$velocityScale
} # range 4 differs from ranges 1:3
originalCoordinateCode <- as.integer(deploymentParameters[22]) # 1 (0=beam 1=xyz 2=ENU)
res@metadata$originalCoordinate <- c("beam", "xyz", "enu")[1 + originalCoordinateCode]
res@metadata$oceCoordinate <- res@metadata$originalCoordinate
oceDebug(debug, "originalCoordinate=", res@metadata$originalCoordinate, "\n")
if (res@metadata$originalCoordinate == "beam") {
stop("cannot handle beam coordinates")
}
# FIXME: bug: docs say samplingRate in units of 0.1Hz, but the SLEIWEX-2008-m3 data file is in 0.01Hz
samplingRate <- 0.01 * readBin(deploymentParameters[23:28], "integer", n = 3, size = 2, endian = "little", signed = FALSE)
if (samplingRate[2] != 0 || samplingRate[3] != 0) {
warning("ignoring non-zero items 2 and/or 3 of samplingRate vector")
}
res@metadata$samplingRate <- samplingRate[1]
if (res@metadata$samplingRate < 0) {
stop("samplingRate must be a positive integer, but got ", res@metadata$samplingRate)
}
res@metadata$measurementDeltat <- 1 / res@metadata$samplingRate
res@metadata$burstInterval <- readBin(deploymentParameters[29:34], "integer", n = 3, size = 2, endian = "little", signed = FALSE)
if (res@metadata$burstInterval[2] != 0 || res@metadata$burstInterval[3] != 0) {
warning("ignoring non-zero items 2 and/or 3 in burstInterval vector")
}
res@metadata$burstInterval <- res@metadata$burstInterval[1]
res@metadata$samplesPerBurst <- readBin(deploymentParameters[35:40], "integer", n = 3, size = 2, endian = "little", signed = FALSE)
if (res@metadata$samplesPerBurst[2] != 0 || res@metadata$samplesPerBurst[3] != 0) {
warning("ignoring non-zero items 2 and/or 3 in samplesPerBurst vector")
}
res@metadata$samplesPerBurst <- res@metadata$samplesPerBurst[1]
if (res@metadata$samplesPerBurst < 0) {
stop("samplesPerBurst must be a positive integer, but got ", res@metadata$samplesPerBurst)
}
res@metadata$deploymentName <- paste(integerToAscii(as.integer(deploymentParameters[49:57])), collapse = "")
res@metadata$comments1 <- paste(integerToAscii(as.integer(deploymentParameters[66:125])), collapse = "")
res@metadata$comments2 <- paste(integerToAscii(as.integer(deploymentParameters[126:185])), collapse = "")
res@metadata$comments3 <- paste(integerToAscii(as.integer(deploymentParameters[126:185])), collapse = "")
}
# Use 3-byte flag to find bursts in buf. Then find their times, and # samples in each.
# Note: checking not just on the 2 "official" bytes, but also on third (3c=60=number of bytes in header)
burstBufindex <- matchBytes(buf, 0xA5, 0x11, 0x3c)
oceDebug(debug, vectorShow(burstBufindex))
nbursts <- length(burstBufindex)
res@metadata$numberOfBursts <- nbursts
burstBufindex2 <- sort(c(burstBufindex, 1 + burstBufindex))
year <- readBin(buf[burstBufindex2 + 18], "integer", n = nbursts, size = 2, endian = "little", signed = FALSE)
day <- as.integer(buf[burstBufindex + 20])
month <- as.integer(buf[burstBufindex + 21])
minute <- as.integer(buf[burstBufindex + 22])
hour <- as.integer(buf[burstBufindex + 23])
sec100 <- as.integer(buf[burstBufindex + 24])
sec <- as.integer(buf[burstBufindex + 25])
burstTime <- as.POSIXct(ISOdatetime(year = year, month = month, day = day, hour = hour, min = minute, sec = sec + 0.01 * sec100, tz = tz))
oceDebug(debug, vectorShow(burstTime))
nbursts <- length(burstTime)
samplesPerBurst <- readBin(buf[burstBufindex2 + 30], "integer", size = 2, n = nbursts, endian = "little", signed = FALSE)
oceDebug(debug, vectorShow(samplesPerBurst))
# ".extended" refers to a burst sequence to which a final item has been appended,
# to allow the use of approx() for various things.
burstTimeExtended <- c(burstTime, burstTime[nbursts] + samplesPerBurst[nbursts] / res@metadata$samplingRate)
attr(burstTimeExtended, "tzone") <- attr(burstTime, "tzone")
oceDebug(debug, vectorShow(burstTimeExtended))
res@metadata$measurementStart <- min(burstTimeExtended)
res@metadata$measurementEnd <- max(burstTimeExtended)
res@metadata$measurementDeltat <- (as.numeric(burstTime[length(burstTime)]) - as.numeric(burstTime[1])) / sum(samplesPerBurst)
# Sample indices (not buf indices) of first sample in each burst
burstSampleIndex.extended <- c(1, cumsum(samplesPerBurst))
burstSampleIndex <- burstSampleIndex.extended[-length(burstSampleIndex.extended)]
oceDebug(debug, vectorShow(burstSampleIndex))
# Map from sample number toBurst number
burst <- 1:nbursts
if (debug > 0) {
cat("first 5 lines:\n")
print(data.frame(burst, burstTime, burstBufindex)[1:5, ])
}
# Interpret 'from', 'to', and 'by', possibly integers, POSIX times, or strings for POSIX tiems
if (missing(from)) {
from <- 1
oceDebug(debug, "set from=", from, " as a default\n", sep = "")
}
if (missing(to)) {
to <- burstSampleIndex[length(burstSampleIndex)]
oceDebug(debug, "set to=", to, " based on file contents\n", sep = "")
}
fromKeep <- from
toKeep <- to
if (inherits(from, "POSIXt")) {
if (!inherits(to, "POSIXt")) {
stop("if 'from' is POSIXt, then 'to' must be, also")
}
fromToPOSIX <- TRUE
fromPair <- bisectAdvSontekAdr(burstTime, from, add = -1, debug = debug - 1)
fromBurst <- fromPair$index
oceDebug(debug, "fromKeep=", format(fromKeep), " yields burstTime[", fromBurst, "]=", format(fromPair$t), "\n")
toPair <- bisectAdvSontekAdr(burstTime, to, add = 1, debug = debug - 1)
toBurst <- toPair$index
oceDebug(debug, "toKeep=", format(toKeep), " yields burstTime[", toBurst, "]=", format(toPair$t), "\n")
# burst offsets FIXME: do we need these?
fromBurstOffset <- floor(0.5 + (as.numeric(from) - as.numeric(burstTime[fromBurst])) * res@metadata$samplingRate)
toBurstOffset <- floor(0.5 + (as.numeric(to) - as.numeric(burstTime[toBurst - 1])) * res@metadata$samplingRate)
oceDebug(debug, "fromBurstOffset=", fromBurstOffset, "toBurstOffset=", toBurstOffset, "\n")
fromIndex <- 1
toIndex <- sum(samplesPerBurst[fromBurst:toBurst])
oceDebug(debug, "fromIndex=", fromIndex, "toIndex=", toIndex, "\n")
} else {
fromToPOSIX <- FALSE
fromIndex <- from
toIndex <- to
# Determine bursts, and offsets within bursts, for fromIndex and toIndex
tmp <- approx(burstSampleIndex, burst, fromIndex)$y
if (is.na(tmp)) {
stop("fromIndex", from, " is not in thisFile")
}
fromBurst <- floor(tmp)
fromBurstOffset <- floor(0.5 + (tmp - fromBurst) * samplesPerBurst[fromBurst])
oceDebug(debug, "from is at index ", fromIndex, ", which is in burst ", fromBurst, ", at offset ", fromBurstOffset, "\n")
tmp <- approx(burstSampleIndex, burst, toIndex)$y
if (is.na(tmp)) {
stop("toIndex", from, " is not in thisFile")
}
toBurst <- floor(tmp)
toBurstOffset <- floor(0.5 + (tmp - toBurst) * samplesPerBurst[toBurst])
oceDebug(debug, "to is at index ", toIndex, ", which is in burst ", toBurst, ", at offset ", toBurstOffset, "\n")
}
# Set up focus region (not needed; just saves some subscripts later)
focus <- unique(seq(fromBurst, toBurst)) # collapse, e.g. if in same burst
burstFocus <- burst[focus]
oceDebug(debug, vectorShow(burstFocus))
nburstsFocus <- length(burstFocus)
burstBufindexFocus <- burstBufindex[focus]
burstTimeFocus <- burstTime[focus]
samplesPerBurstFocus <- samplesPerBurst[focus]
if (debug > 0) {
cat("first 5 lines:\n")
print(data.frame(burstFocus, burstTimeFocus, burstBufindexFocus, samplesPerBurstFocus)[1:5, ])
}
# set up to read everything in every relevant burst (trim later)
oceDebug(
debug, "sum(samplers.burstFocus)", sum(samplesPerBurstFocus), "vs",
nbursts * as.numeric(burstTime[2] - burstTime[1]) * res@metadata$samplingRate, "\n"
)
ntotal <- sum(samplesPerBurstFocus)
oceDebug(debug, vectorShow(ntotal))
v <- array(numeric(), dim = c(ntotal, 3))
time <- array(numeric(), dim = c(ntotal, 1))
heading <- array(numeric(), dim = c(ntotal, 1))
pitch <- array(numeric(), dim = c(ntotal, 1))
roll <- array(numeric(), dim = c(ntotal, 1))
temperature <- array(numeric(), dim = c(ntotal, 1))
pressure <- array(numeric(), dim = c(ntotal, 1))
a <- array(raw(), dim = c(ntotal, 3))
q <- array(raw(), dim = c(ntotal, 3))
rowOffset <- 0
oceDebug(debug, vectorShow(dataLength))
oceDebug(debug, vectorShow(burstHeaderLength))
oceDebug(debug, vectorShow(burstBufindexFocus))
velocityScale <- res@metadata$velocityScale
for (b in 1:nburstsFocus) {
n <- samplesPerBurstFocus[b]
oceDebug(
debug > 1, "burst ", b, " at ", format(burstTimeFocus[b]), ": data start at byte ",
burstBufindexFocus[b] + burstHeaderLength, " and n=", n, "\n"
)
bufSubset <- buf[burstBufindexFocus[b] + burstHeaderLength + 0:(-1 + dataLength * n)]
m <- matrix(bufSubset, ncol = dataLength, byrow = TRUE)
if (n != dim(m)[1]) {
stop("something is wrong with the data. Perhaps the record length is not the assumed value of ", dataLength)
}
r <- rowOffset + seq_len(n)
v[r, 1] <- velocityScale * readBin(t(m[, 1:2]), "integer", n = n, size = 2, signed = TRUE, endian = "little")
v[r, 2] <- velocityScale * readBin(t(m[, 3:4]), "integer", n = n, size = 2, signed = TRUE, endian = "little")
v[r, 3] <- velocityScale * readBin(t(m[, 5:6]), "integer", n = n, size = 2, signed = TRUE, endian = "little")
a[r, 1] <- m[, 7]
a[r, 2] <- m[, 8]
a[r, 3] <- m[, 9]
q[r, 1] <- m[, 10]
q[r, 2] <- m[, 11]
q[r, 3] <- m[, 12]
time[r] <- as.numeric(burstTimeFocus[b]) + seq(0, n - 1) / res@metadata$samplingRate
# cat(sprintf("%.2f %.2f %.2f\n", time[r[1]], time[r[2]], time[r[3]]))
# cat("time=", format(time[r[1]]), ";", format(burstTimeFocus[b]), "\n")
# print(range(time[r]))
heading[r] <- 0.1 * readBin(as.raw(t(m[, 13:14])), "integer", n = n, size = 2, signed = TRUE, endian = "little")
pitch[r] <- 0.1 * readBin(as.raw(t(m[, 15:16])), "integer", n = n, size = 2, signed = TRUE, endian = "little")
roll[r] <- 0.1 * readBin(as.raw(t(m[, 17:18])), "integer", n = n, size = 2, signed = TRUE, endian = "little")
temperature[r] <- 0.01 * readBin(as.raw(t(m[, 19:20])), "integer", n = n, size = 2, signed = TRUE, endian = "little")
# Pressure, using quadratic conversion from counts
p.count <- readBin(as.raw(t(m[, 21:22])), "integer", n = n, size = 2, signed = FALSE, endian = "little")
pressure[r] <- res@metadata$pressureOffset + p.count * (res@metadata$pressureScale + p.count * res@metadata$pressureScale2)
rowOffset <- rowOffset + n
if (monitor) {
cat(".")
if (!(b %% 50)) {
cat(b, "\n")
}
}
}
if (monitor) {
cat("\n")
}
rm(buf, bufSubset, m) # clean up, in case space is tight
class(time) <- c("POSIXt", "POSIXct")
attr(time, "tzone") <- attr(burstTimeFocus[1], "tzone")
oceDebug(debug, "burstTime[1]=", format(burstTimeFocus[1]), "\n times=", format(time[1:20]), "\n")
oceDebug(debug, vectorShow(burstTime))
# Subset data to match the provided 'from', 'to' and 'by'
if (fromToPOSIX) {
iii <- from <= time & time <= to
if (is.character(by)) {
subsamplingRate <- floor(0.5 + ctimeToSeconds(by) * res@metadata$samplingRate)
oceDebug(debug, paste(" by = \"", by, "\" yields subsamplingRate=", subsamplingRate, "\n"), sep = "")
samples <- seq_along(iii)
oceDebug(debug, "before interpreting 'by', iii true for", sum(iii), "cases\n")
iii <- iii & !(samples %% subsamplingRate)
oceDebug(debug, "after interpreting 'by', iii true for", sum(iii), "cases\n")
oceDebug(debug, "'by' is character, so subsampling by", floor(0.5 + ctimeToSeconds(by) * res@metadata$samplingRate), "\n")
}
} else {
indices <- seq(fromIndex, toIndex) # FIXME: ignoring 'by'
oceDebug(debug, vectorShow(indices))
time <- approx(burstSampleIndex.extended, burstTimeExtended - burstTime[1], indices)$y + burstTime[1]
if (any(is.na(time))) {
warning("some times are NA; this is an internal coding error")
}
focusFrom <- fromBurstOffset
oceDebug(debug, vectorShow(focusFrom))
focusTo <- toBurstOffset + sum(samplesPerBurstFocus[-length(samplesPerBurstFocus)])
oceDebug(debug, vectorShow(focusTo))
iii <- seq(focusFrom, focusTo, by = by)
}
oceDebug(debug, vectorShow(iii))
if (any(iii < 0)) {
stop("got negative numbers in iii, which indicates a coding problem; range(iii)=", paste(range(iii), collapse = " to "))
}
oceDebug(debug, "dim(v)=", paste(dim(v), collapse = " "), "\n")
v <- v[iii, ]
a <- a[iii, ]
q <- q[iii, ]
# No need to subset time if 'from' and 'to' are integers; I am not really
# sure we want to in the POSIX case, either, but I am not changing that for now.
# DEK (issue 1386)
if (fromToPOSIX) {
time <- time[iii]
}
pressure <- pressure[iii]
temperature <- temperature[iii]
pitch <- pitch[iii]
heading <- heading[iii]
roll <- roll[iii]
res@metadata$numberOfSamples <- dim(v)[1]
res@metadata$numberOfBeams <- dim(v)[2]
res@metadata$velocityResolution <- velocityScale
res@metadata$velocityMaximum <- velocityScale * 2^15
res@data <- list(
v = v, a = a, q = q,
time = time,
heading = heading,
pitch = pitch,
roll = roll,
temperature = temperature,
pressure = pressure
)
res@metadata$units$v <- list(unit = expression(m / s), scale = "")
res@metadata$units$pressure <- list(unit = expression(dbar), scale = "")
res@metadata$units$heading <- list(unit = expression(degree), scale = "")
res@metadata$units$pitch <- list(unit = expression(degree), scale = "")
res@metadata$units$roll <- list(unit = expression(degree), scale = "")
res@metadata$units$temperature <- list(unit = expression(degree * C), scale = "")
if (is.null(processingLog)) {
processingLog <- paste(deparse(match.call()), sep = "", collapse = "")
}
hitem <- processingLogItem(processingLog)
res@processingLog <- hitem
res
}
#' @template readAdvTemplate
#'
#' @template encodingTemplate
#'
#' @param originalCoordinate character string indicating coordinate system, one
#' of `"beam"`, `"xyz"`, `"enu"` or `"other"`. (This is
#' needed for the case of multiple files that were created by a data logger,
#' because the header information is normally lost in such instances.)
#'
#' @param transformationMatrix transformation matrix to use in converting beam
#' coordinates to xyz coordinates. This will over-ride the matrix in the file
#' header, if there is one. An example is \code{rbind(c(2.710, -1.409,
#' -1.299), c(0.071, 2.372, -2.442), c(0.344, 0.344, 0.344))}.
#'
#' @section Note on file name:
#' The `file` argument does not actually name a file. It names a basename
#' for a file. The actual file names are created by appending suffix
#' `.hd1` for one file and `.ts1` for another.
#'
#' @template adReadingMethodTemplate
read.adv.sontek.text <- function(
file, from = 1, to, by = 1, tz = getOption("oceTz"),
originalCoordinate = "xyz", transformationMatrix, longitude = NA, latitude = NA, encoding = "latin1",
monitor = FALSE, debug = getOption("oceDebug"), processingLog = NULL) {
if (missing(file)) {
stop("must supply 'file'")
}
if (is.character(file)) {
if (!file.exists(file)) {
stop("cannot find file \"", file, "\"")
}
if (0L == file.info(file)$size) {
stop("empty file \"", file, "\"")
}
}
if (!interactive()) {
monitor <- FALSE
}
# FIXME: It would be better to deal with the binary file, but the format is unclear to me;
# FIXME: two files are available to me, and they differ considerably, neither matching the
# FIXME: SonTek documentation.
if (by != 1) {
stop("must have \"by\"=1, in this version of the package")
}
suffices <- c("hd1", "ts1")
itemsPerSample <- 16
if (missing(file)) {
stop("need to supply a file, e.g. \"A\" to read \"A.hd1\" and \"A.ts1\"")
}
basefile <- file
hd <- paste(basefile, suffices[1], sep = ".")
ts <- paste(basefile, suffices[2], sep = ".")
# The hd1 file holds per-burst information
hdt <- read.table(hd, encoding = encoding)
numberOfBursts <- dim(hdt)[1]
oceDebug(debug, "numberOfBursts: ", numberOfBursts, "\n")
t <- ISOdatetime(year = hdt[, 2], month = hdt[, 3], day = hdt[, 4], hour = hdt[, 5], min = hdt[, 6], sec = hdt[, 7], tz = tz)
if (inherits(from, "POSIXt")) {
ignore <- t < from
if (sum(ignore) == 0) {
stop("no data in this time interval, starting at time ", from, "\n")
}
fromBurst <- which(ignore == FALSE)[1]
oceDebug(debug, "\"from\" is burst number", fromBurst, "at", format(t[fromBurst]), "\n")
} else {
fromBurst <- from + 1 # 0 means first burst
}
if (missing(to)) {
stop("must supply \"to\"")
} else {
if (inherits(from, "POSIXt")) {
ignore <- t < to
if (sum(ignore) == 0) {
stop("no data in this time interval, starting at time ", to, "\n")
}
toBurst <- which(ignore == FALSE)[1] + 1 # add 1 since we'll chop later
toBurst <- min(toBurst, length(t))
oceDebug(debug, "\"to\" is burst number", toBurst, "at", format(t[toBurst]), "\n")
} else {
toBurst <- to
}
}
# voltage <- hdt[, 14]
heading <- hdt[, 24]
pitch <- hdt[, 25]
roll <- hdt[, 26]
# spb <- hdt[1, 9] # FIXME may this change over time?
# sr <- spb / 3600
tsFile <- file(ts, "rb")
on.exit(close(tsFile))
if (!inherits(tsFile, "connection")) {
stop("argument `tsFile' must be a character string or connection")
}
# Examine ".ts1" file to see if we can deal with it.
seek(tsFile, where = 0, origin = "end")
bytesInFile <- seek(tsFile, where = 0, origin = "start")
oceDebug(debug, "length of \".", suffices[2], "\" file: ", bytesInFile, " bytes\n")
look <- min(5000, bytesInFile)
b <- readBin(tsFile, "raw", n = look)
newlines <- which(b == 0x0a)
if (0 != diff(range(fivenum(diff(newlines))))) {
stop("need equal line lengths in ", ts)
}
# Line length
bytesInSample <- diff(newlines)[1]
oceDebug(debug, "line length in \".", suffices[2], "\" file: ", bytesInSample, " bytes\n")
# elements per line
seek(tsFile, where = newlines[1], origin = "start")
d <- scan(tsFile, what = "character", nlines = 1, quiet = TRUE)
oceDebug(debug, "first line in \".", suffices[2], "\" file: ", paste(d, collapse = " "), "\n")
# itemsPerLine <- length(d)
if (itemsPerSample != length(d)) {
stop("file \".", suffices[2], "\" should have ", itemsPerSample, " elemetns per line, but it has ", length(d))
}
oceDebug(debug, "elements per line in \".", suffices[2], "\" file: ", length(d), "\n")
linesInFile <- bytesInFile / bytesInSample
oceDebug(debug, "lines in \".", suffices[2], "\" file: ", linesInFile, "\n")
samplesPerBurst <- linesInFile / numberOfBursts
oceDebug(debug, "samplesPerBurst: ", samplesPerBurst, "\n")
fromByte <- fromBurst * samplesPerBurst * bytesInSample
toByte <- toBurst * samplesPerBurst * bytesInSample
oceDebug(debug, "seek from:", fromByte, "\n", "seek to:", toByte, "\n")
seek(tsFile, where = fromByte, origin = "start")
ts <- matrix(scan(tsFile, n = itemsPerSample * (toBurst - fromBurst + 1) * samplesPerBurst, quiet = TRUE),
ncol = itemsPerSample, byrow = TRUE
)
len <- dim(ts)[1]
v <- array(numeric(), dim = c(len, 3))
# FIXME: the odd velocity scale is because text files use cm/s.
velocityScale <- 1e-2
v[, 1] <- velocityScale * ts[, 3]
v[, 2] <- velocityScale * ts[, 4]
v[, 3] <- velocityScale * ts[, 5]
a <- array(raw(), dim = c(len, 3))
a[, 1] <- as.raw(ts[, 6])
a[, 2] <- as.raw(ts[, 7])
a[, 3] <- as.raw(ts[, 8])
q <- array(raw(), dim = c(len, 3))
q[, 1] <- as.raw(ts[, 9])
q[, 2] <- as.raw(ts[, 10])
q[, 3] <- as.raw(ts[, 11])
temperature <- ts[, 15]
pressure <- ts[, 16]
rm(ts) # may run tight on space
tt <- seq(t[fromBurst], t[toBurst], length.out = len)
# trim to the requested interval
ok <- (from - 1 / 2) <= tt & tt <= (to + 1 / 2) # give 1/2 second extra
v <- v[ok, ]
a <- a[ok, ]
q <- q[ok, ]
tt <- tt[ok]
heading <- approx(t, heading, xout = tt, rule = 2)$y
pitch <- approx(t, pitch, xout = tt, rule = 2)$y
roll <- approx(t, roll, xout = tt, rule = 2)$y
res <- new("adv")
res@data <- list(
v = v, a = a, q = q,
time = tt,
heading = heading,
pitch = pitch,
roll = roll,
temperature = temperature,
pressure = pressure
)
res@metadata$manufacturer <- "sontek"
res@metadata$instrumentType <- "adv" # FIXME or "adr"?
res@metadata$filename <- basefile
res@metadata$longitude <- longitude
res@metadata$latitude <- latitude
res@metadata$numberOfSamples <- dim(v)[1]
res@metadata$numberOfBeams <- dim(v)[2]
res@metadata$velocityResolution <- velocityScale / 10 # FIXME: guessing on the resolution for text files
res@metadata$velocityMaximum <- velocityScale / 10 * 2^15 # FIXME: guessing on the max velocity for text files
res@metadata$cpuSoftwareVerNum <- res@metadata$cpuSoftwareVerNum
res@metadata$dspSoftwareVerNum <- res@metadata$dspSoftwareVerNum
res@metadata$transformationMatrix <- if (!missing(transformationMatrix)) transformationMatrix else NULL
res@metadata$orientation <- "upward" # FIXME: guessing on the orientation
res@metadata$deltat <- as.numeric(difftime(tt[2], tt[1], units = "secs"))
res@metadata$subsampleStart <- data$t[1]
res@metadata$units$v <- list(unit = expression(m / s), scale = "")
res@metadata$units$pressure <- list(unit = expression(dbar), scale = "")
res@metadata$units$heading <- list(unit = expression(degree), scale = "")
res@metadata$units$pitch <- list(unit = expression(degree), scale = "")
res@metadata$units$roll <- list(unit = expression(degree), scale = "")
res@metadata$units$temperature <- list(unit = expression(degree * C), scale = "")
res@metadata$oceCoordinate <- originalCoordinate
res@metadata$originalCoordinate <- originalCoordinate
warning("sensor orientation cannot be inferred without a header; \"", res@metadata$orientation, "\" was assumed.")
if (is.null(processingLog)) {
processingLog <- paste(deparse(match.call()), sep = "", collapse = "")
}
hitem <- processingLogItem(processingLog)
res@processingLog <- hitem
}
#' Trim a Sontek ADR adv File
#'
#' Create a Sontek ADR adv (acoustic Doppler velocimeter) file by copying the
#' header plus the first `n` data chunks (recognized by the three-byte sequence
#' `0xA5`, `0x11`, `0x3c') into a new file. This can be useful in supplying
#' small sample files for bug reports.
#'
#' @param infile name of a Sontek ADR adp file.
#'
#' @param n integer indicating the number of data chunks to keep. The default is
#' to keep 100 chunks, a common choice for sample files.
#'
#' @param outfile optional name of the new Sontek ADR adp file to be created. If this is not
#' supplied, a default is used, by adding `_trimmed` to the base filename, e.g.
#' if `infile` is `"x.adr"` then `outfile` will be `x_trimmed.adr`.
#'
#' @param debug an integer value indicating the level of debugging. If
#' this is 1L, then a brief indication is given of the processing steps. If it
#' is > 1L, then information is given about each data chunk, which can yield
#' very extensive output.
#'
#' @return `advSontekAdrFileTrim()` returns the name of the output file, `outfile`, as
#' provided or constructed.
#'
#' @family things related to adv data
#' @family functions that trim data files
advSontekAdrFileTrim <- function(infile, n = 100, outfile, debug = getOption("oceDebug")) {
oceDebug(debug, "advSontekAdrFileTrim(\"", infile, "\", n=", n, ", ...) START\n", sep = "", unindent = 1)
if (missing(infile)) {
stop("provide infile")
}
if (!is.character(infile)) {
stop("infile must be a character value naming a Sontek ADR adv file")
}
magic <- oceMagic(infile)
if (!identical(magic, "adv/sontek/adr")) {
stop("function only works for Sontek ADR adv files, but this is a '", magic, "' file")
}
oceDebug(debug, "infile=\"", infile, "\"\n", sep = "")
if (missing(outfile)) {
outfile <- gsub(".adr", "_trimmed.adr", infile)
}
oceDebug(debug, "outfile=\"", outfile, "\"\n", sep = "")
fileSize <- file.info(infile)$size
oceDebug(debug, "filesize=", fileSize, "\n")
infile <- file(infile, "rb")
on.exit(close(infile))
buf <- readBin(infile, what = "raw", n = fileSize, endian = "little")
burstBufindex <- matchBytes(buf, 0xA5, 0x11, 0x3c)
oceDebug(debug, vectorShow(burstBufindex))
oceDebug(debug, vectorShow(burstBufindex[n + 1]))
bytesToRead <- burstBufindex[n + 1L]
bufOut <- buf[seq_len(bytesToRead)]
oceDebug(debug, vectorShow(bufOut))
writeBin(bufOut, outfile, useBytes = TRUE)
oceDebug(debug, "END advSontekAdrFileTrim\n", unindent = 1)
outfile
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.