Merge pull request #496 from StoXProject/develop

Develop

Author: arnejohannesholmin

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: RstoxData
-Version: 2.2.1-9001
-Date: 2026-03-13
+Version: 2.2.1-9002
+Date: 2026-03-20
 Title: Tools to Read and Manipulate Fisheries Data
 Authors@R: c(
   person(given = "Arne Johannes", 

NAMESPACE

@@ -61,6 +61,7 @@ export(convertBioticFile)
 export(convertToLandingData)
 export(convertToLssData)
 export(createOrderKey)
+export(cropAcoustic)
 export(do.call_robust)
 export(filterData)
 export(filterTables)

NEWS.md

@@ -2,6 +2,7 @@
 * Added a check for existence of the resource file in DefineTranslation().
 * Improved warning when bottomdepthstart or bottomdepthstop used to calcualte BottomDepth in StoxBiotic() contains missing values.
 * Added error message in StoxAcoustic when the Time is not unique in AcousticData in the ICESAcsoutic format, since StoX uses Time as the LogKey in StoxAcousticData.
+* Added the funciton cropAcoustic() to extract only a subset of the logs of an acoustic file.
 
 
 # RstoxData v2.2.0-9011  (2026-01-23)

R/Definitions.R

@@ -317,6 +317,7 @@ initiateRstoxData <- function(){
 		reportingUnit = c("mm", "mm", "cm"), 
 		numericResolution = c(1, 5, 1)
 	)
+	
 	lengthCode_unit_table[, rank := seq_len(.N)]
 
 

R/Read.R

@@ -471,3 +471,76 @@ scaleUsingUnit <- function(x, inputUnit, outputUnit) {
 
 
 
+
+##################################################
+##################################################
+#' Write a cropped copy of an acoustic file
+#' 
+#' This function writes a copy of an acoustic file in either the NMDEchosounder og ICESAcoustic format, keeping only the logs specified by the user.
+#' 
+#' @param filePath Character: The path to the acoustic file.
+#' @param logsToKeep Numeric: The indiced of the logs to keep. NULL implies to keep all logs.
+#' @param newFilePath Optional, character: The path to the new file, defaulted to \code{filePath} with the suffix before file extension
+#' @param ow Logical: If TRUE overwrite the \code{newFilePath}.
+#' @param suffix Character: The suffix to append to the \code{filePath} before the file extension, in the case that \code{newFilePath} is not specified
+#' 
+#' @return
+#' The path to the cropped file.
+#' 
+#' @examples
+#' exampleFile <- system.file("testresources","ICES_Acoustic_2.xml", package="RstoxData")
+#' acousticData <- ReadAcoustic(exampleFile)
+#' newFilePath <- tempfile(fileext = ".xml")
+#' cropAcoustic(exampleFile, logsToKeep = 2, newFilePath = newFilePath)
+#' croppedAcousticData <- ReadAcoustic(newFilePath)
+#' 
+#' @export
+#' 
+cropAcoustic <- function(filePath, logsToKeep = NULL, newFilePath = NULL, ow = FALSE, suffix = "_croppedLogs.") {
+	
+	# Get the file type and the start and end tags for logs:
+	fileType <- autodetectXml(filePath)
+	if(fileType$xsd == "nmdechosounderv1") {
+		startLogTag = "<distance log_start"
+		endLogTag = "</distance>"
+	}
+	else if(fileType$xsd == "icesAcoustic") {
+		startLogTag = "<Log>"
+		endLogTag = "</Log>"
+	}
+	
+	# Read the lines:
+	l <- readLines(filePath)
+	if(length(l) == 1) {
+		stop("The XML must be prettified to be cropped.")
+	}
+	
+	# Find the end log tags:
+	atStartLog <- which(grepl(startLogTag, l))
+	atEndLog <- which(grepl(endLogTag, l))
+	
+	# Subset the logs:
+	if(length(logsToKeep)) {
+		logsToDelete <- setdiff(seq_along(atStartLog), logsToKeep)
+		linesToDelete <- unlist(mapply(seq, atStartLog[logsToDelete], atEndLog[logsToDelete]))
+		l <- l[- linesToDelete]
+	}
+	
+	# Create the file path of the copy:
+	if(!length(newFilePath)) {
+		newFilePath <- paste0(tools::file_path_sans_ext(filePath), suffix, tools::file_ext(filePath))
+	}
+	# And check existence of the copy:
+	if(file.exists(newFilePath) && !ow) {
+		stop("The file ", newFilePath, " exists. Choose a different file path using newFilePath or set ow to TRUE to overwrite.")
+	}
+	
+	# Write the copy:
+	writeLines(l, newFilePath)
+	
+	return(newFilePath)
+}
+
+
+
+

R/StoxAcoustic.R

@@ -105,6 +105,9 @@ StoxAcousticOne <- function(data_list) {
 		#data_list$ChannelReference[, LogKey:= paste0(gsub(' ','T',start_time),'.000Z')]
 		#data_list$NASC[, LogKey:= paste0(gsub(' ','T',start_time),'.000Z')]
 		data_list$Log[, LogKey := formatLogKey(as.POSIXct_NMDEchosounder(start_time))]
+		# Duplicated LogKey is an error:
+		duplicatedLogKeyError(data_list$Log, format = "NMDEchosounder") 
+			
 		data_list$Beam[, LogKey := formatLogKey(as.POSIXct_NMDEchosounder(start_time))]
 		data_list$AcousticCategory[, LogKey := formatLogKey(as.POSIXct_NMDEchosounder(start_time))]
 		data_list$ChannelReference[, LogKey := formatLogKey(as.POSIXct_NMDEchosounder(start_time))]
@@ -323,12 +326,10 @@ StoxAcousticOne <- function(data_list) {
 
 		data_list$Log[, LogKey := getLogKey_ICESAcoustic(Time)]
 
-		# Throw an error if the LogKey is not unique:
-		atDuplicatedLogKey <- data_list$Log[, which(duplicated(LogKey) | duplicated(LogKey, fromLast = TRUE))]
-		if(length(atDuplicatedLogKey)) {
-			duplicatedTimes <- data_list$Log$Time[atDuplicatedLogKey]
-			stop("The AcousticData has duplicated Time, which results in duplicated LogKey in StoxAcoustic, which is not allowed. The data are from an acoustic file in the ICESAcoustic format, and contains the following duplicated Time (first 30):\n", paste(head(duplicatedTimes, 30), collapse = ", "))
-		}
+		# Duplicated LogKey is an error:
+		duplicatedLogKeyError(data_list$Log, format = "ICESAcoustic") 
+		
+		
 
 		data_list$Log[, EDSU:= paste(LocalID,LogKey,sep='/')]
 
@@ -427,9 +428,6 @@ StoxAcousticOne <- function(data_list) {
 
 		#add integration distance
 		PingAxisInterval <- data_list$Beam[, c('PingAxisInterval', 'LogKey')]
-		#if(any(duplicated(PingAxisInterval))) {
-		#	stop("Time in the Beam table is not unique. StoX requires Time to be unique across the rows of the Log table as Time in order to use Time as the LogKey. This problem typically occurs when the resolution of the Time is too low, e.g. hours. Please change the input data so that Time is unique.")
-		#}
 		data_list$Log <- merge(data_list$Log, PingAxisInterval, all.x = TRUE)
 		names(data_list$Log)[names(data_list$Log) == 'PingAxisInterval'] <- 'LogDistance'
 
@@ -549,6 +547,7 @@ StoxAcousticOne <- function(data_list) {
 }
 
 
+
 hasMinuteResoslution_ICESAcoustic <- function(Time) {
 	# Count the number of colons, where 2 indicates seconds and 1 indicates minutes:
 	max(stringi::stri_count(Time, fixed = ':'), na.rm = TRUE) == 1
@@ -567,6 +566,26 @@ getLogKey_ICESAcoustic <- function(Time) {
 }
 
 
+duplicatedLogKeyError <- function(Log, format = c("NMDEchosounder", "ICESAcoustic")) {
+	
+	format <- match.arg(format)
+	
+	atDuplicatedLogKey <- Log[, which(duplicated(LogKey) | duplicated(LogKey, fromLast = TRUE))]
+	if(length(atDuplicatedLogKey)) {
+		if(format == "NMDEchosounder") {
+			duplicatedTimes <- sort(Log$start_time[atDuplicatedLogKey])
+		}
+		else if(format == "ICESAcoustic") {
+			duplicatedTimes <- sort(Log$Time[atDuplicatedLogKey])
+		}
+		
+		badTimes <- head(unique(duplicatedTimes), 30)
+		stop("The AcousticData (from an ", format, " file) has duplicated Time, which results in duplicated LogKey in StoxAcoustic, which is not allowed. Please add sufficient time resolution in your input data (preferrable in the data source). The following Time are duplicated (first ", length(badTimes), "):\n", paste(badTimes, collapse = "\n"))
+	}
+	
+}
+
+
 
 getBeamTiltAngle <- function(x) {
 	# Check code words:
@@ -614,16 +633,19 @@ as.POSIXct_ICESAcoustic <- function(x) {
 		"%Y-%m-%d %H:%M"
 	)
 	allowedTimeFormatsICESAcoustic <- c(
+		# The order here is important, since the allowedTimeFormatsICESAcousticSansSeconds accepts also times WITH seconds. So first convert with seconds, then the remaining sans seconds!!!:
 		paste0(allowedTimeFormatsICESAcousticSansSeconds, ":%OS"), 
 		allowedTimeFormatsICESAcousticSansSeconds
 	)
 
 	areNotNAs <- !is.na(x)
 
-	DateTime <- NULL
+	DateTime <- rep(as.POSIXct(NA), length(x))
+	# Fill inn the missing times. This supports different resolutions in the same object, as we check the highest resolution first (with seconds then minutes, as specified in the allowedTimeFormatsICESAcoustic):
 	for(format in allowedTimeFormatsICESAcoustic) {
-		if(!length(DateTime) || !all(!is.na(DateTime[areNotNAs]))) {
-			DateTime <- as.POSIXct(x, tz = StoxTimeZone, format = format)
+		isNaDateTime <- is.na(DateTime)
+		if(any(isNaDateTime)) {
+			DateTime[isNaDateTime] <- as.POSIXct(x[isNaDateTime], tz = StoxTimeZone, format = format)
 		}
 	}
 

R/StoxExport.R

@@ -743,9 +743,14 @@ BioticData_NMDToICESBioticOne <- function(
 		WeightUnit = "kg", # Always kg in NMDBiotic (see http://www.imr.no/formats/nmdbiotic/)
 		SpeciesCategoryWeight = catchweight,
 		SpeciesSex = NA_character_,
+		
+		#SubsampledNumber = lengthsamplecount,
 		SubsampledNumber = lengthsamplecount,
 		SubsamplingFactor = catchcount / lengthsamplecount,
+		#SubsamplingFactor = ifelse(is.na(lengthsampleweight), 1, catchcount / lengthsamplecount),
 		SubsampleWeight = lengthsampleweight,
+		#SubsampleWeight = ifelse(is.na(lengthsampleweight), catchweight, lengthsampleweight),
+		
 		LengthCode = NA_character_, # NMDBiotic has no way of storing a length distribution.
 		LengthClass = NA_integer_, # NMDBiotic has no way of storing a length distribution.
 		#LengthType = "1", # Should not this be interpreted from the catchsample$lengthmeasurement ???

R/xsdUtils.R

@@ -285,8 +285,13 @@ createXsdObject <- function(xsdFile) {
 
 
 #' @importFrom xml2 xml_child read_html xml_find_all
-autodetectXml <- function(xmlFile, xsdObjects, verbose) {
+autodetectXml <- function(xmlFile, xsdObjects, verbose = FALSE) {
 
+	# Get the xsdObjects:
+	if(missing("xsdObjects")) {
+		data(xsdObjects, package="RstoxData", envir = environment())
+	}
+	
 	# Read first 500 characters
 	tmpText <- tryCatch(
 		{