R/egm.R

In EGM: Evaluating Cardiac Electrophysiology Signals

### Class Definitions ----

#' Electrogram data class from electrophysiology studies
#'
#' @description This class serves as a combinatorial class to describe
#'   cardiovascular electrical signal data in R. It is based off of the formats
#'   available in WFDB, but has been formatted for ease of use within the `R`
#'   ecosystem. An `egm` object contains three components in a list:
#'
#'   * signal data in multiple channels
#'
#'   * header information
#'
#'   * annotation labels at specified time points
#'
#'   These components help to navigate, and visualize data. The `egm` class is
#'   the backbone for working with WFDB objects in R, and provides an interface
#'   for integrating or converting other raw signal data to a WFDB format.
#'
#' @details The individual components of the class are further defined in their
#'   respective children functions [signal_table()], [header_table()],
#'   [annotation_table()]. They are very simple classes that build upon the
#'   `data.table` class that allow for class safety checks when working with
#'   different data types (particularly WFDB).
#'
#'   __IMPORTANT__: The `egm` class can be built from ground-up by the user,
#'   however it is primarily generated for the user using the other read/write
#'   functions, such as [read_lspro()] or [read_wfdb()].
#'
#' @returns An object of class `egm` that is always a list of the above three
#'   components. Oftentimes, the `annotation_table` object may be missing, and
#'   it is replaced with an empty table as a place holder.
#'
#' @param x An `egm` object, typically generated by the [egm()] function, to be
#'   used with support functions (e.g. [is_egm()]
#'
#' @param signal A `signal_table` object generated by the [signal_table()]
#'   function
#'
#' @param header A `header_table` object generated by the [header_table()]
#'   function
#'
#' @param annotation A `annotation_table` object generated by the
#'   [annotation_table()] function
#'
#' @param ... Additional arguments to be passed to the function
#'
#' @name egm
#' @export
egm <- function(signal = signal_table(),
								header = header_table(),
								annotation = annotation_table(),
								...) {

	# Signal data will be in multi-channel format for EPS data, e.g. data.table
	# Header will be  a list

	new_egm(signal,
					header = header,
					annotation = annotation)
}

#' @keywords internal
new_egm <- function(signal = signal_table(),
										header = header_table(),
										annotation = annotation_table(),
										...) {

	# Signal will become a data frame (coerced into a data table)
	structure(
		list(
			signal = signal,
			header = header,
			annotation = annotation
		),
		class = c('egm', 'list')
	)

}

#' @export
format.egm <- function(x, ...) {
	hea <- x$header
	rec <- attributes(hea)$record_line
	ann <- x$annotation # May be empty table

	cat('<Electrical Signal>\n')
	cat('-------------------\n')
	cat('Recording Duration: ', rec$samples / rec$frequency, 'seconds\n' )
	cat('Recording frequency ', rec$frequency, ' hz\n')
	cat('Number of channels: ', rec$number_of_channels, '\n')
	cat('Channel Names: ', paste(hea$label), '\n')
	cat('Annotation: ', attributes(ann)$annotator)

}

#' @export
print.egm <- function(x, ...) {
	format(x)
}

#' @export
#' @rdname egm
is_egm <- function(x) {
	inherits(x, "egm")
}

# Helper functions -------------------------------------------------------------

#' Extract raw signal data from an `egm` object
#'
#' @description Raw signal data may be all that is required, particularly when
#' storing or manipulating data, or for example, feeding it into an analytical
#' pipeline. This means the extraneous elements, such as the *meta* information,
#' may be unnecessary. This function helps to strip away and extract just the
#' signal data itself and channel names.
#'
#' @details The options to return the data vary based on need. The data can be
#' extracted as follows:
#'
#' * `data.frame` containing an equal number of rows to the number of samples, with each column named after the recording channel it was derived from. Data frames, as they are columnar by nature, will also include the sample index position.
#'
#' * `matrix` containing an equal number of rows to the number of samples, with each column named after the recording channel it was derived from
#'
#' * `array` containing individual vectors of signal, each named after the channel they were derived from
#'
#' @param object An `egm` object that contains the signal data to be extracted
#'
#' @param data_format A `character` choice of either *data.frame* (default),
#'   *matrix*, or *array* that tells how the data should be structured.
#'   Further explanation in the details.
#'
#' @param ... Additional arguments to be passed to the function
#'
#' @returns An object as described by the __format__ option
#'
#' @export
extract_signal <- function(object,
													 data_format = c("data.frame", "matrix", "array"),
													 ...) {

	stopifnot("Requires object of `egm` class for evaluation"
						= inherits(object, "egm"))

	# Get string, defaults to `matrix`
	data_format <- data_format[1]

	# Raw signal
	sig <- data.frame(object$signal[, -1])
	sig <- data.frame(object$signal)

	switch(data_format,
				 array = {
				 	# Drop sample names
				 	out <- array(sig[, -1], dimnames = list(names(sig[, -1])))

				 },
				 matrix = {
				 	# Drop sample names
				 	out <- as.matrix(sig[, -1])

				 },
				 data.frame = {
				 	# Keep samples
				 	out <- as.data.frame(sig)
				 })

	# Return
	out

}