R/parser.R

In SerolyzeR: Reading, Quality Control and Preprocessing of MBA (Multiplex Bead Assay) Data

intelliflex_to_xponent_mapping <- VALID_DATA_TYPES
names(intelliflex_to_xponent_mapping) <- c(
  "MEDIAN", "COUNT", "NET.MEDIAN", "NET.AVERAGE.MEDIAN", "AVERAGE.MFI"
)
data_must_contain <- c("Median", "Count") # Median is a must have
location_column_name <- "Location"
sample_column_name <- "Sample"
non_analyte_columns <- c("Location", "Sample", "Total.Events")

filter_list <- function(lst, allowed_names) {
  lst[names(lst) %in% allowed_names]
}

check_data <- function(data) {
  for (must_contain in data_must_contain) {
    if (!(must_contain %in% names(data))) {
      stop("Could not find at least one of the following data types: ", paste(data_must_contain, collapse = ", "))
    }
    if (!(location_column_name %in% colnames(data[[must_contain]]))) {
      stop("Could not find location column in datatype: ", must_contain)
    }
  }
}

find_analyte_names <- function(data) {
  analytes <- colnames(data[])
  analytes <- analytes[!(analytes %in% non_analyte_columns)]
  analytes
}

remove_non_analyte_columns <- function(data) {
  for (data_type in names(data)) {
    df <- data[[data_type]]
    df <- df[, !(colnames(df) %in% non_analyte_columns)]
    data[[data_type]] <- df
  }
  data
}

parse_xponent_locations <- function(xponent_locations) {
  # Convert strings like this 77(1,E10) to E10
  regex <- "(\\d+?)\\((\\d+),(\\w\\d+)\\)"
  locations <- gsub(regex, "\\3", xponent_locations)
  locations
}

#' Extract the experiment date from xPONENT raw output
#'
#' @description
#' This method extracts the real experiment date - BatchStartTime,
#' which corresponds to the time when the experiment was conducted.
#'
#' The Date in the top of the xPONENT file refers to the moment when
#' the CSV xPONENT file was exported from the system
#'
#' In case the file was parsed with an `exact_parse` parameter, it looks for
#' a parameter in a BatchMetadata list. Otherwise it tries to read it from the raw header.
#'
#' In case this method fails, it fails back to read the Date from the file
#'
#' @param xponent_output The xPONENT output list to be processed.
#' @param verbose Logical, whether to print messages (default: TRUE)
#'
#' @return A character string representing the datetime of the experiment
#' @keywords internal
extract_xponent_experiment_date <- function(xponent_output, verbose = TRUE) {
  # 1. Try from Header$BatchMetadata
  batch_time_str <- tryCatch(
    {
      time_str <- xponent_output$Header$BatchMetadata$BatchStartTime
      if (is.null(time_str)) {
        stop("BatchStartTime not found in BatchMetadata.")
      }
      if (verbose) {
        message("BatchStartTime successfully extracted from the metadata")
      }
      time_str
    },
    error = function(e) {
      if (verbose) {
        message("Failed to extract from BatchMetadata: ", e$message)
      }
      NULL
    }
  )

  # 2. Try from raw Header string
  if (is.null(batch_time_str)) {
    batch_time_str <- tryCatch(
      {
        header_raw <- xponent_output$Header[[1]]
        match <- regmatches(
          header_raw,
          regexpr("(?<=BatchStartTime\",\\\")[^\"]+", header_raw, perl = TRUE)
        )
        if (length(match) == 0) {
          stop("BatchStartTime not found in raw header.")
        }
        if (verbose) {
          message("BatchStartTime successfully extracted from the header.")
        }
        match
      },
      error = function(e) {
        if (verbose) {
          message("Failed to extract from raw header: ", e$message)
        }
        NULL
      }
    )
  }

  # 3. Fallback to ProgramMetadata Date + Time
  if (is.null(batch_time_str)) {
    batch_time_str <- tryCatch(
      {
        date_str <- xponent_output$ProgramMetadata[["Date"]]
        time_str <- xponent_output$ProgramMetadata[["Time"]]
        if (is.null(date_str) ||
          is.null(time_str)) {
          stop("Date/Time not found in ProgramMetadata.")
        }
        fallback <- paste(date_str, time_str)
        if (verbose) {
          message("Fallback datetime successfully extracted from ProgramMetadata.")
        }
        fallback
      },
      error = function(e) {
        if (verbose) {
          message("Failed to extract fallback datetime: ", e$message)
        }
        NA_character_
      }
    )
  }

  return(batch_time_str)
}

#' Handle differences in datetimes
#'
#' @description
#' Handle differences in the datetime format between xPONENT and INTELLIFLEX
#' and output POSIXct datetime object containing the correct datetime with the default timezone.
#'
#' @import lubridate
#'
#' @param datetime_str The datetime string to parse
#' @param file_format The format of the file. Select from: xPONENT, INTELLIFLEX
#'
#' @return POSIXct datetime object
#'
#' @keywords internal
#'
handle_datetime <- function(datetime_str, file_format = "xPONENT") {
  if (file_format == "xPONENT") {
    possible_orders <- c(
      "Ymd HM", "mdY IM p", "mdY HM", "mdY IMS p",
      "mdY HMS", "Ymd IM p", "Ymd IMS p", "Ymd HMS",
      "dmY IM p", "dmY HM", "dmY IMS p", "dmY HMS"
    )
  } else if (file_format == "INTELLIFLEX") {
    possible_orders <- c(
      "Ymd IMS p", "Ymd HMS", "Ymd IM p", "Ymd HM",
      "mdY IMS p", "mdY HMS", "mdY IM p", "mdY HM",
      "dmY IMS p", "dmY HMS", "dmY IM p", "dmY HM"
    )
  } else {
    stop("Invalid file format: ", file_format)
  }

  first_attempt <- lubridate::parse_date_time2(datetime_str, orders = possible_orders[1], tz = "")
  if (!is.na(first_attempt)) {
    return(first_attempt)
  } else {
    message("Could not parse datetime string using default datetime format. Trying other possibilies.")
    for (order in possible_orders[-1]) {
      datetime <- lubridate::parse_date_time2(datetime_str, orders = order, tz = "")
      if (!is.na(datetime)) {
        message("Successfully parsed datetime string using order: ", order)
        return(datetime)
      }
    }
    stop("Could not parse datetime string: ", datetime_str)
  }
}

postprocess_intelliflex <- function(intelliflex_output, verbose = TRUE) {
  data <- intelliflex_output$Results
  names(data) <- intelliflex_to_xponent_mapping[names(data)]
  data <- filter_list(data, VALID_DATA_TYPES)
  check_data(data)

  datetime_str <- intelliflex_output$SystemMetadata[["PLATE.START"]]
  plate_datetime <- handle_datetime(datetime_str, "INTELLIFLEX")

  analyte_names <- find_analyte_names(data$Median)
  data <- remove_non_analyte_columns(data)

  list(
    batch_name = intelliflex_output$SystemMetadata[["PLATE.NAME"]],
    sample_locations = intelliflex_output$SampleMetadata[["WELL.LOCATION"]],
    sample_names = intelliflex_output$SampleMetadata[["SAMPLE.ID"]],
    plate_datetime = plate_datetime,
    analyte_names = analyte_names,
    data = data,
    batch_info = intelliflex_output$SampleMetadata
  )
}

postprocess_xponent <- function(xponent_output, verbose = TRUE) {
  data <- xponent_output$Results
  data <- filter_list(data, VALID_DATA_TYPES)
  check_data(data)

  xponent_locations <- data$Median[[location_column_name]]
  sample_locations <- parse_xponent_locations(xponent_locations)
  sample_names <- data$Median[[sample_column_name]]
  analyte_names <- find_analyte_names(data$Median)
  data <- remove_non_analyte_columns(data)

  # parse the date of an experiment
  datetime_str <- extract_xponent_experiment_date(xponent_output, verbose = verbose)
  plate_datetime <- handle_datetime(datetime_str, "xPONENT")

  list(
    batch_name = xponent_output$ProgramMetadata[["Batch"]],
    plate_datetime = plate_datetime,
    sample_locations = sample_locations,
    sample_names = sample_names,
    analyte_names = analyte_names,
    data = data,
    batch_info = xponent_output$Header
  )
}


valid_formats <- c("xPONENT", "INTELLIFLEX")

#' @title
#' Read Luminex Data
#'
#' @description
#' Reads a Luminex plate file and returns a \link{Plate} object containing the extracted data.
#' Optionally, a layout file can be provided to specify the arrangement of samples on the plate.
#'
#' @details
#'
#' The function supports two Luminex data formats:
#' - **xPONENT**: Used by older Luminex machines.
#' - **INTELLIFLEX**: Used by newer Luminex devices.
#'
#' @section Workflow:
#' 1. Validate input parameters, ensuring the specified format is supported.
#' 2. Read the plate file using the appropriate parser:
#'    - xPONENT files are read using [read_xponent_format()].
#'    - INTELLIFLEX files are read using [read_intelliflex_format()].
#' 3. Post-process the extracted data:
#'    - Validate required data columns (`Median`, `Count`).
#'    - Extract sample locations and analyte names.
#'    - Parse the date and time of the experiment.
#'
#' @section File Structure:
#' - **Plate File (`plate_filepath`)**: A CSV file containing Luminex fluorescence intensity data.
#' - **Layout File (`layout_filepath`)** (optional): An Excel or CSV file containing the plate layout.
#'   - The layout file should contain a table with **8 rows and 12 columns**, where each cell corresponds to a well location.
#'   - The values in the table represent the sample names for each well.
#'
#' @section Sample types detection:
#'
#' The [`read_luminex_data()`] method automatically detects the sample types based on the sample names, unless provided the `sample_types` parameter.
#' The sample types are detected used the [`translate_sample_names_to_sample_types()`] method.
#' In the documentation of this method, which can be accessed with command `?translate_sample_names_to_sample_types`, you can find the detailed description of the sample types detection.
#'
#' ## Duplicates in sample names
#' In some cases, we want to analyse the sample with the same name twice on one plate. The package allows for such situations, but we assume that the user knows what they are doing.
#'
#' When importing sample names (either from the layout file or the plate file), the function will check for duplicates. If any are found, it will issue a warning like:
#'
#' **Duplicate sample names detected: A, B. Renaming to make them unique.**
#'
#' Then it will add simple numeric suffixes (e.g. “.1”, “.2”) to the repeated sample names so that every name is unique while keeping the original text easy to recognize.
#'
#' @param plate_filepath (`character(1)`) Path to the Luminex plate file.
#' @param layout_filepath (`character(1)`, optional) Path to the Luminex layout file.
#' @param format (`character(1)`, default = `'xPONENT'`)
#'   - The format of the Luminex data file.
#'   - Supported formats: `'xPONENT'`, `'INTELLIFLEX'`.
#' @param plate_file_separator (`character(1)`, default = `','`)
#'   - The delimiter used in the plate file (CSV format). Used only for the xPONENT format.
#' @param plate_file_encoding (`character(1)`, default = `'UTF-8'`)
#'   - The encoding used for reading the plate file. Used only for the xPONENT format.
#' @param use_layout_sample_names (`logical(1)`, default = `TRUE`)
#'   - Whether to use sample names from the layout file.
#' @param use_layout_types (`logical(1)`, default = `TRUE`)
#'   - Whether to use sample types from the layout file (requires a layout file).
#' @param use_layout_dilutions (`logical(1)`, default = `TRUE`)
#'   - Whether to use dilution values from the layout file (requires a layout file).
#' @param default_data_type (`character(1)`, default = `'Median'`)
#'   - The default data type used if none is explicitly provided.
#' @param sample_types (`character()`, optional) A vector of sample types to override extracted values.
#' @param dilutions (`numeric()`, optional) A vector of dilutions to override extracted values.
#' @param verbose (`logical(1)`, default = `TRUE`)
#'   - Whether to print additional information and warnings.
#' @param ... Additional arguments. Ignored in this method. Here included for better integration with the pipeline
#'
#' @return A \link{Plate} object containing the parsed Luminex data.
#'
#' @examples
#' # Read a Luminex plate file with an associated layout file
#' plate_file <- system.file("extdata", "CovidOISExPONTENT.csv", package = "SerolyzeR")
#' layout_file <- system.file("extdata", "CovidOISExPONTENT_layout.csv", package = "SerolyzeR")
#' plate <- read_luminex_data(plate_file, layout_file)
#'
#' # Read a Luminex plate file without a layout file
#' plate_file <- system.file("extdata", "CovidOISExPONTENT_CO.csv", package = "SerolyzeR")
#' plate <- read_luminex_data(plate_file, verbose = FALSE)
#'
#' @export
read_luminex_data <- function(plate_filepath,
                              layout_filepath = NULL,
                              format = "xPONENT",
                              plate_file_separator = ",",
                              plate_file_encoding = "UTF-8",
                              use_layout_sample_names = TRUE,
                              use_layout_types = TRUE,
                              use_layout_dilutions = TRUE,
                              default_data_type = "Median",
                              sample_types = NULL,
                              dilutions = NULL,
                              verbose = TRUE,
                              ...) {
  if (!(format %in% valid_formats)) {
    stop("Invalid format: ", format, ". Select from: ", paste(valid_formats, collapse = ", "))
  }

  verbose_cat("Reading Luminex data from: ", plate_filepath, "\nusing format ", format, "\n", verbose = verbose)
  tryCatch(
    {
      parser_output <- switch(format,
        "xPONENT" = {
          output <- read_xponent_format(
            plate_filepath,
            verbose = verbose,
            separator = plate_file_separator,
            encoding = plate_file_encoding
          )
          postprocess_xponent(output, verbose = verbose)
        },
        "INTELLIFLEX" = {
          output <- read_intelliflex_format(plate_filepath, verbose = verbose)
          postprocess_intelliflex(output, verbose = verbose)
        }
      )
    },
    error = function(e) {
      error_messsage <- paste("Error reading Luminex plate file from: ", plate_filepath, " using the ", format, " format.\n")

      stop(
        "Error reading Luminex plate file from: ", plate_filepath, " using the ", format, " format.\n",
        ifelse(format == "xPONENT", paste0("Check if the separator and encoding are correct. Currently using separator: '", plate_file_separator, "' and the '", plate_file_encoding, "' encoding.\n"), ""),
        "\n", e$message
      )
    }
  )


  plate_builder <- PlateBuilder$new(
    batch_name = parser_output$batch_name,
    sample_names = parser_output$sample_names,
    analyte_names = parser_output$analyte_names,
    verbose = verbose
  )

  plate_builder$set_plate_name(plate_filepath) # set a new plate name based on the file name
  plate_builder$set_plate_datetime(parser_output$plate_datetime)

  plate_builder$set_sample_locations(parser_output$sample_locations)
  layout_matrix <- NULL
  if (!is.null(layout_filepath)) {
    layout_matrix <- read_layout_data(layout_filepath)
    plate_builder$set_layout(layout_matrix)
  }
  if (is.null(layout_filepath) && (use_layout_types || use_layout_dilutions || use_layout_sample_names)) {
    use_layout_types <- FALSE
    use_layout_sample_names <- FALSE
    use_layout_dilutions <- FALSE
    verbose_cat(
      "(",
      color_codes$red_start,
      "WARNING",
      color_codes$red_end,
      ")",
      "\nLayout file not provided. Setting `use_layout_sample_names`,
      `use_layout_types` and `use_layout_dilutions` to FALSE.\n",
      verbose = verbose
    )
  }

  # Setting of samples names has to happen before setting sample types
  plate_builder$set_sample_names(use_layout_sample_names)
  plate_builder$set_sample_types(use_layout_types, sample_types)

  plate_builder$set_batch_info(parser_output$batch_info)
  plate_builder$set_default_data_type(default_data_type)
  plate_builder$set_data(parser_output$data)

  plate_builder$set_dilutions(use_layout_dilutions, dilutions)

  plate <- plate_builder$build(validate = TRUE, reorder = TRUE)

  verbose_cat(color_codes$green_start, "\nNew plate object has been created with name: ",
    plate$plate_name, "!\n", color_codes$green_end, "\n",
    verbose = verbose
  )

  plate
}