Adjust messages and estimate of duration

I included an attempt to better estimate the total duration of a measurement as used for the limits to step.delay. When possible (not HDR) the too short step.delay is set to zero, otherwise to the estimated minimum step.delay possible.
aphalo · May 6, 2023 · 532546c · 532546c
1 parent bcca8f9
commit 532546c
Show file tree

Hide file tree

Showing 13 changed files with 71 additions and 30 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: ooacquire
 Type: Package
 Title: Acquire Data from OO Spectrometers
-Version: 0.3.2-1
-Date: 2023-04-27
+Version: 0.3.3
+Date: 2023-05-05
 Authors@R:
    c(
     person("Pedro J.", "Aphalo", email = "pedro.aphalo@helsinki.fi", role = c("aut", "trl", "cre")),

diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,12 @@ editor_options:
     wrap: 72
 ---
 
+# ooacquire 0.3.3 (2023-05-05)
+
+-   Improved estimate of measurement duration, and display message.
+-   When possible, if series step delay is too short, set it to zero, and
+    otherwise to the estimated duration.
+
 # ooacquire 0.3.2-1 (2023-04-27)
 
 -   Tweaked menu texts and made it possible to select among types of collection

diff --git a/R/acq-interactive-utils.R b/R/acq-interactive-utils.R
@@ -373,6 +373,7 @@ choose_ch_interactive <- function(instruments,
 #'   repeated measurements. Named vector with member names
 #'   \code{"initial.delay"}, \code{"step.delay"}, and \code{"num.steps"}.
 #' @param measurement.duration numeric Duration of one measurement event (s).
+#' @param minimum.step.delay numeric Minimum duration of \code{"step.delay"} (s).
 #'
 #' @details Function \code{seq.settings()} allows users to enter values needed
 #' to define a sequence of spectral acquisitions. These are the delay or time
@@ -393,7 +394,8 @@ set_seq_interactive <- function(seq.settings = list(start.boundary = "second",
                                                     initial.delay = 0,
                                                     step.delay = 0,
                                                     num.steps = 1),
-                                measurement.duration = 0) {
+                                measurement.duration = 0,
+                                minimum.step.delay = measurement.duration) {
 
   if (!setequal(names(seq.settings),
       c("start.boundary", "initial.delay", "step.delay", "num.steps"))) {
@@ -408,7 +410,7 @@ set_seq_interactive <- function(seq.settings = list(start.boundary = "second",
   repeat{
     if (seq.settings$step.delay < measurement.duration &&
         seq.settings$step.delay != 0) {
-      seq.settings$step.delay <- measurement.duration
+      seq.settings$step.delay <- signif(minimum.step.delay * 1.01, 3)
       message("'step.delay' too short! Reset to ", seq.settings$step.delay, " s.")
     }
     prompt.string <-

diff --git a/R/acq-irrad-interactive.R b/R/acq-irrad-interactive.R
@@ -245,7 +245,7 @@ acq_irrad_interactive <-
         switch(serial_no,
                MAYP11278 = "lfd",
                MAYP112785 = "lfd",
-               MAYP114590 = "ld",
+               MAYP114590 = "lfd",
                FLMS04133 = "ld",
                FLMS00673 = "ld",
                FLMS00440 = "ld",
@@ -268,6 +268,18 @@ acq_irrad_interactive <-
       stop("No spectrometer data found")
     }
 
+    if (interface.mode != "series") {
+      acq.overhead <- NA_real_ # safeguard as it should not be used
+    } else if (grepl("^MAY", serial_no)) {
+      acq.overhead <- 1e-3 # 1 ms
+    } else if (grepl("^FLM", serial_no)) {
+      acq.overhead <- 1e-3 # 1 ms
+    } else if (grepl("^USB", serial_no)) {
+      acq.overhead <- 20e-3 # 20 ms slow
+    } else {
+      acq.overhead <- 50e-3 # 50 ms, just in case
+    }
+
     # We still check serial numbers, really needed only for user supplied descriptors
     descriptor.inst <- get_oo_descriptor(w)
     stopifnot(descriptor[["spectrometer.sn"]] == descriptor.inst[["spectrometer.sn"]])
@@ -407,11 +419,20 @@ acq_irrad_interactive <-
       }
 
       if (grepl("series", interface.mode)) {
+
+        maximum.measurement.durantion <-
+          ((max(settings$tot.time.range) + acq.overhead) * # with HDR one setting
+             length(settings$HDR.mult)) + # number of HDR settings
+          0.75 * mean(settings$in.time) # estimate of worse case overhead due to free-running
+
+        message("Estimated duration of one measurement with overhead: ", signif(maximum.measurement.durantion, 3), " s.")
+
         seq.settings <-
           set_seq_interactive(seq.settings = seq.settings,
-                              measurement.duration =
-                                max(settings$tot.time.range) *
-                                length(settings$HDR.mult) * 1e-6) # ms -> s
+                              measurement.duration = maximum.measurement.durantion,
+                              minimum.step.delay = ifelse(length(settings$HDR.mult) == 1L,
+                                                          0,
+                                                          maximum.measurement.durantion))
       }
 
       if (reuse.old.refs) {
@@ -717,7 +738,7 @@ acq_irrad_interactive <-
       repeat {
         valid.answers <- c("q", "r", "n")
         answer2 <-
-          readline("Measure again? quit/repeat/NEXT (q/r/n-): ")[1]
+          readline("quit/repeat/NEXT (q/r/n-): ")[1]
         answer2 <- ifelse(answer2 == "", "n", answer2)
         if (answer2 %in% valid.answers) {
           break()
@@ -734,18 +755,18 @@ acq_irrad_interactive <-
       }
 
       if (answer2 == "q") {
-        break()
+        break() # out of UI main loop
       } else if (!reuse.old.refs) {
          repeat {
-          answer3 <- readline("Change protocol/MEASURE NEXT (p/n-): ")[1]
+          answer3 <- readline("Change protocol? yes/NO (y/n-): ")[1]
           answer3 <- ifelse(answer3 == "", "n", answer3)
-          if (answer3 %in% c("n", "p")) {
+          if (answer3 %in% c("n", "y")) {
             break()
           } else {
             print("Answer not recognized, please try again...")
           }
         }
-        if (answer3 == "p") {
+        if (answer3 == "y") {
           protocol <- protocol_interactive(protocols)
         }
       }

diff --git a/R/acq-raw.R b/R/acq-raw.R
@@ -107,16 +107,18 @@ acq_raw_spct <- function(descriptor,
       # It should never happen as we check validity value requested
       warning("The spectrometer has overridden the integration time!")
     }
-    # could improve precision in case of rounding errors
+    # ensure validity of date in case of rounding errors or other mismatches
+    #   compared to intended settings
     x$integ.time[i] <- actual.integ.time
 
     rOmniDriver::set_scans_to_avg(y$w, x$num.scans[i], y$sr.index, y$ch.index)
     actual.num.scans <- rOmniDriver::get_scans_to_avg(y$w, y$sr.index, y$ch.index)
     # We need to
     if (x$num.scans[i] != actual.num.scans) {
-      # We guard against failure to set integration time
-      # It should never happen as we check validity value requested
+      # We guard against failure to number of scans
       warning("The spectrometer has overridden the number of scans!")
+      # ensure validity of data in case of mismatche between actual setting
+      #   and intended setting
       x$num.scans[i] <- actual.num.scans
     }
 
@@ -143,6 +145,7 @@ acq_raw_spct <- function(descriptor,
         break()
       }
     }
+    if (!verbose) message("series ready.")
 
     if (!rOmniDriver::is_spectrum_valid(y$w, y$sr.index, y$ch.index) && !x$force.valid)
     {
@@ -198,10 +201,11 @@ acq_raw_spct <- function(descriptor,
 #'   they are interpreted as time offsets from the start of the sequence.
 #'
 #' @note Obviously the duration of the time steps must be longer than the time
-#'   that a measurment takes. This time can be significantly more than the sum
+#'   that a measurement takes. This time can be significantly more than the sum
 #'   of integration times, as there is considerable overhead in both the
 #'   OmniDriver Java code, in USB communication, in the spectrometer
-#'   itself and in R.
+#'   itself and in R. The overhead depends strongly on the model of
+#'   spectrometer.
 #'
 #'   No multitasking is used or supported, so R waits for the spectrometer to
 #'   answer. The operating system and other programs are not blocked, but the
@@ -232,7 +236,8 @@ acq_raw_spct <- function(descriptor,
 #' spectrum is determined by \code{acq.settings}.
 #'
 #' @seealso \code{\link{acq_raw_spct}} which is used to acquire each member
-#' spectrum.
+#' spectrum. Computations on date times are done with
+#' \code{\link[lubridate]{lubridate}}.
 #'
 acq_raw_mspct <- function(descriptor,
                           acq.settings,
@@ -275,7 +280,7 @@ acq_raw_mspct <- function(descriptor,
                               length.out = seq.settings[["num.steps"]] - 1L)))
   }
   # add initial delay
-  steps <- steps + seq.settings[["initial.delay"]]
+  steps <- steps + seq.settings[["initial.delay"]][1]
 
   previous.protocol <- "none"
 
@@ -305,11 +310,11 @@ acq_raw_mspct <- function(descriptor,
       times <-
         lubridate::ceiling_date(lubridate::now(tzone = "UTC"),
                                 unit = seq.settings[["start.boundary"]]) +
-        seconds(steps)
+        lubridate::seconds(steps)
       z.names <- c(z.names,
                    paste(p,
-                       format_idx(seq_along(times)),
-                       sep = "."))
+                         format_idx(seq_along(times)),
+                         sep = "."))
     } else {
       times <- lubridate::now(tzone = "UTC")
       z.names <- c(z.names, p)
@@ -334,7 +339,7 @@ acq_raw_mspct <- function(descriptor,
                               f.trigger.pulses = f.current,
                               what.measured = paste(p, " HS: ", user.label, sep = ""),
                               where.measured = where.measured,
-                              verbose = FALSE, # avoid delays
+                              verbose = TRUE,
                               return.list = TRUE))
     } else {
       messages.enabled <-

diff --git a/R/hs-acq-raw.R b/R/hs-acq-raw.R
@@ -120,12 +120,14 @@ hs_acq_raw_mspct <- function(descriptor,
   # setup memory buffer
   rOmniDriver::highSpdAcq_allocate_buffer(y$w, y$sr.index, num.spectra)
 
-  if (verbose) message("Scans 1 to ", num.spectra, " ... ", appendLF = FALSE)
+  if (verbose) message("Acquiring ", num.spectra, " spectra ... ", appendLF = FALSE)
 
   # start acquisition
   start.time <- lubridate::now(tzone = "UTC")
   rOmniDriver::highSpdAcq_start_acquisition(y$w, y$sr.index)
 
+  if (verbose) message("ready.")
+
   # retrieve actual number of spectra acquired
   actual.num.spectra <-
     rOmniDriver::highSpdAcq_get_number_of_spectra_acquired(y$w)

diff --git a/build-binary-from-source.sh b/build-binary-from-source.sh
@@ -1,4 +1,4 @@
 cd ..
-R CMD INSTALL --build --no-multiarch ooacquire_0.3.2-1.tar.gz
+R CMD INSTALL --build --no-multiarch ooacquire_0.3.3.tar.gz
 cd ./ooacquire
 
diff --git a/man/acq_raw_mspct.Rd b/man/acq_raw_mspct.Rd
diff --git a/man/set_seq_interactive.Rd b/man/set_seq_interactive.Rd
diff --git a/src/MAYP11278-tail-correction.o b/src/MAYP11278-tail-correction.o
diff --git a/src/MAYP112785-tail-correction.o b/src/MAYP112785-tail-correction.o
diff --git a/src/RcppExports.o b/src/RcppExports.o
diff --git a/src/ooacquire.dll b/src/ooacquire.dll