R/ifcb_get_ferrybox_data.R

In iRfcb: Tools for Managing Imaging FlowCytobot (IFCB) Data

utils::globalVariables(c("date_from", "date_to", "in_range", "timestamp_minute", ".data", 'timestamp_minute_temp', 'time_difference', 'n'))

#' Retrieve Ferrybox Data for Specified Timestamps
#'
#' This internal SMHI function reads `.txt` files from a specified folder containing Ferrybox data,
#' filters them based on a specified ship name (default is "SveaFB" for R/V Svea), and extracts
#' data (including GPS coordinates) for timestamps (rounded to the nearest minute) falling within the date ranges defined in the file names.
#'
#' @param timestamps A vector of POSIXct timestamps for which GPS coordinates and associated parameter data are to be retrieved.
#' @param ferrybox_folder A string representing the path to the folder containing Ferrybox `.txt` files.
#' @param parameters A character vector specifying the parameters to extract from the Ferrybox data. Defaults to `c("8002", "8003")`.
#' @param ship A string representing the name of the ship to filter Ferrybox files. The default is "SveaFB".
#' @param latitude_param A string specifying the header name for the latitude column in the Ferrybox data. Default is "8002".
#' @param longitude_param A string specifying the header name for the longitude column in the Ferrybox data. Default is "8003".
#' @param timestamp_param A string specifying the header name for the timestamp column in the Ferrybox data. Default is "38059".
#' @param max_time_diff_min Numeric. Maximum allowed difference (in minutes) between the requested timestamp and the closest available Ferrybox data.
#' Defaults to 1 minutes. Timestamps further away than this threshold will not be used for filling missing data.
#'
#' @details
#' The function extracts data from files whose names match the specified ship and fall within the date ranges defined in the file names. The columns corresponding to `latitude_param` and `longitude_param` will be renamed to `gpsLatitude` and `gpsLongitude`, respectively, if they are present in the `parameters` argument.
#'
#' The function also handles cases where the exact timestamp is missing by attempting to interpolate the data using floor and ceiling rounding methods. The final output will ensure that all specified parameters are numeric.
#'
#' @return A data frame containing the input timestamps and corresponding data for the specified parameters.
#' Columns include 'timestamp', 'gpsLatitude', 'gpsLongitude' (if applicable), and the specified parameters.
#'
#' @examples
#' \dontrun{
#' ferrybox_folder <- "/path/to/ferrybox/data"
#' timestamps <- as.POSIXct(c("2016-08-10 10:47:34 UTC",
#'                            "2016-08-10 11:12:21 UTC",
#'                            "2016-08-10 11:35:59 UTC"))
#'
#' result <- ifcb_get_ferrybox_data(timestamps, ferrybox_folder)
#' print(result)
#' }
#'
#' @export
ifcb_get_ferrybox_data <- function(timestamps, ferrybox_folder, parameters = c("8002", "8003"), ship = "SveaFB", latitude_param = "8002", longitude_param = "8003",
                                   timestamp_param = "38059", max_time_diff_min = 1) {
  # Validate inputs
  if (!inherits(timestamps, "POSIXct")) {
    cli_abort("{.arg timestamps} must be a vector of {.cls POSIXct} timestamps.")
  }

  if (!dir.exists(ferrybox_folder)) {
    cli_abort("{.arg ferrybox_folder} does not exist: {.file {ferrybox_folder}}")
  }

  # List all .txt files in the specified folder (excluding subfolders)
  ferrybox_files <- list.files(ferrybox_folder, pattern = "\\.txt$", full.names = TRUE, recursive = FALSE)

  if (length(ferrybox_files) == 0) {
    cli_abort("No {.file .txt} files found in {.arg ferrybox_folder}: {.file {ferrybox_folder}}")
  }

  # Convert ferrybox file names to dataframe and extract timestamps
  ferrybox_files_df <- data.frame(ferrybox_files = ferrybox_files) %>%
    dplyr::filter(grepl(ship, ferrybox_files)) %>%
    dplyr::rowwise()

  if (nrow(ferrybox_files_df) == 0) {
    cli_abort("No ferrybox files matching ship {.val {ship}} were found.")
  }

  ferrybox_files_df <- ferrybox_files_df %>%
    dplyr::mutate(
      date_from = as.POSIXct(substr(regmatches(ferrybox_files, gregexpr("\\d{14}", ferrybox_files))[[1]][1], 1, 14),
                             format = "%Y%m%d%H%M%S", tz = "UTC"),
      date_to = as.POSIXct(substr(regmatches(ferrybox_files, gregexpr("\\d{14}", ferrybox_files))[[1]][2], 1, 14),
                           format = "%Y%m%d%H%M%S", tz = "UTC")
    ) %>%
    dplyr::ungroup()

  # Create a logical column indicating if any timestamp falls within the date range
  ferrybox_files_df <- ferrybox_files_df %>%
    dplyr::rowwise() %>%
    dplyr::mutate(in_range = any(timestamps >= date_from & timestamps <= date_to)) %>%
    dplyr::ungroup()

  # Filter the dataframe based on the in_range column
  filtered_ferrybox_files_df <- ferrybox_files_df %>%
    dplyr::filter(in_range)

  if (nrow(filtered_ferrybox_files_df) == 0) {
    cli_abort("No ferrybox files contain data within the provided timestamps.")
  }

  # Initialize an empty data frame to store ferrybox data
  ferrybox_data <- tibble()

  # Read and concatenate data from filtered ferrybox files
  for (file in filtered_ferrybox_files_df$ferrybox_files) {
    ferrybox_data_temp <- tryCatch({
      read.table(file,
                 header = TRUE,
                 sep = "\t",
                 check.names = FALSE,
                 colClasses = "character",
                 na.strings = "")
    }, error = function(e) {
      cli_warn("Failed to read file {.file {file}}: {e$message}")
      NULL
    })

    if (!is.null(ferrybox_data_temp)) {
      ferrybox_data <- dplyr::bind_rows(ferrybox_data, ferrybox_data_temp)
    }
  }

  if (nrow(ferrybox_data) == 0) {
    cli_abort("No valid ferrybox data could be read from the filtered files.")
  }

  # Ensure that the specified parameters exist in the data
  missing_params <- setdiff(parameters, colnames(ferrybox_data))
  if (length(missing_params) > 0) {
    cli_abort(c(
      "The following {qty(length(missing_params))}parameter{?s} {?is/are} missing from the ferrybox data:",
      "x" = "{.val {missing_params}}"
    ))
  }

  if (!timestamp_param %in% colnames(ferrybox_data)) {
    cli_abort("Timestamp column {.val {timestamp_param}} is missing from the ferrybox data.")
  }

  # Extract and clean ferrybox position data
  ferrybox_position <- ferrybox_data %>%
    dplyr::mutate(
      timestamp_minute_temp = tryCatch({
        ymd_hms(as.numeric(.data[[timestamp_param]]), tz = "UTC")
      }, error = function(e) {
        cli_abort("Error parsing ferrybox timestamp data.")
      })
    ) %>%
    dplyr::mutate(
      timestamp_minute = lubridate::round_date(timestamp_minute_temp, unit = "minute"),
      time_difference = abs(difftime(timestamp_minute_temp, timestamp_minute, units = "secs"))
    )

  # Convert parameters to numeric where applicable
  ferrybox_position <- ferrybox_position %>%
    dplyr::mutate(across(all_of(parameters), as.numeric, .names = "numeric_{col}"))

  if (nrow(ferrybox_position) == 0) {
    cli_abort("No valid position data could be extracted from the ferrybox data.")
  }

  # Merge the ferrybox position data with the input timestamps
  output <- tibble(timestamp = timestamps) %>%
    mutate(timestamp_minute = round_date(timestamp, unit = "minute")) %>%
    left_join(ferrybox_position, by = "timestamp_minute") %>%
    group_by(timestamp_minute) %>%
    slice_min(time_difference, with_ties = FALSE) %>%
    ungroup() %>%
    arrange(match(timestamp, timestamps)) %>%  # Restore original input order
    select(timestamp, all_of(parameters))

  # Convert ferrybox timestamps to POSIXct if not already
  ferrybox_times <- ymd_hms(as.numeric(ferrybox_position[[timestamp_param]]), tz = "UTC")

  # Define maximum allowed difference
  max_diff <- max_time_diff_min * 60

  # For each timestamp in output, find the closest ferrybox timestamp
  closest_indices <- sapply(output$timestamp, function(ts) {
    diffs <- abs(as.numeric(difftime(ferrybox_times, ts, units = "secs")))
    min_diff <- min(diffs)
    if (min_diff <= max_diff) which.min(diffs) else NA_integer_
  })

  # Extract the closest ferrybox rows
  closest_ferrybox <- ferrybox_position[closest_indices, ]
  closest_ferrybox$time_difference <- abs(as.numeric(difftime(ferrybox_times[closest_indices], output$timestamp, units = "secs")))

  # Combine with output
  missing_data <- output %>%
    select(timestamp) %>%
    dplyr::bind_cols(closest_ferrybox %>% select(all_of(parameters)))

  # Update the output with missing data
  output <- output %>%
    left_join(missing_data, by = "timestamp") %>%
    # Dynamically coalesce columns with .x and .y suffixes
    mutate(across(
      .cols = contains(".x"),
      .fns = ~ coalesce(.x, get(gsub(".x", ".y", cur_column()))),
      .names = "{str_remove(.col, '.x')}"
    )) %>%
    select(-contains(".y"), -contains(".x"))

  # Ensure all parameters are numeric
  output <- output %>%
    mutate(across(all_of(parameters), as.numeric))

  # Check for multiple rows per minute and issue a warning
  duplicate_rows <- output %>%
    dplyr::group_by(timestamp) %>%
    dplyr::summarize(n = n()) %>%
    dplyr::filter(n > 1)

  if (nrow(duplicate_rows) > 0) {
    cli_warn(c(
      "Multiple rows detected for the following {qty(nrow(duplicate_rows))}minute timestamp{?s}:",
      "x" = "{.val {as.character(duplicate_rows$timestamp)}}"
    ))
  }

  # Check if latitude_param and longitude_param are in parameters and rename accordingly
  names(output)[names(output) == latitude_param] <- ifelse(latitude_param %in% parameters, "gpsLatitude", names(output)[names(output) == latitude_param])
  names(output)[names(output) == longitude_param] <- ifelse(longitude_param %in% parameters, "gpsLongitude", names(output)[names(output) == longitude_param])

  output
}