#' @noRd
#' @keywords internal
get_methods <- function(obj) {
unique(purrr::map_chr(class(obj), ~ methods(class= . )))
}
#' @noRd
#' @keywords internal
as_vectors <- function(x) { function(x, ...) UseMethod("as_vectors") }
setGeneric("as_vectors")
#' Construct an event model
#'
#' This function creates an event-based fMRI regression model, represented as a data structure.
#'
#' @importFrom lazyeval f_eval f_rhs f_lhs
#' @param x The model specification, typically a `formula`. The formula should have the following format:
#' response ~ predictor1 + predictor2 + ... + predictorN
#' where `response` is a numeric vector of fMRI signal values, and `predictor1` to `predictorN` are
#' predictor variables. Each predictor variable should be specified as a function of categorical
#' variables (factors) and/or continuous variables. The functions should have the prefix "hrf", and can
#' be defined using the `hrf()` function (see `hrf` documentation for details).
#' @param data A data frame containing the experimental design, with one row per time point and
#' one column per variable used in the model formula. If a categorical variable is used in the formula,
#' it should be a factor in the data frame. The data frame should also contain a column with the fMRI
#' signal values (the response variable).
#' @param block A formula specifying the block structure of the design. This formula should have
#' the format `block_var1 + block_var2 + ...`, where each `block_var` is a categorical variable (factor)
#' used to define blocks of time points. The block structure is used to estimate the baseline fMRI
#' signal level separately for each block.
#' @param sampling_frame A sampling frame defining the temporal and block structure of the design.
#' This should be an object of class `sampling_frame` (see `sampling_frame` documentation for details).
#' @param drop_empty Logical value indicating whether to drop empty factor levels in the model.
#' If `TRUE` (default), any factor levels with no observations will be dropped from the model. If `FALSE`,
#' empty levels will be retained and will receive a coefficient of zero in the model.
#' @param durations A numeric vector specifying the duration (in seconds) of each event in the model.
#' If the model contains block variables, the duration of each block should be specified as well.
#' The length of this vector should be equal to the number of events/blocks in the design.
#' Default value is 0 (no duration).
#' @param ... Additional arguments to be passed to methods. Currently not used.
#'
#' @export
#'
#' @return A list containing the following elements:
#' \item{formula}{The formula used to create the model.}
#' \item{design}{The design matrix for the model, with one row per time point and one column per predictor variable.}
#' \item{block_indices}{A list of indices defining the start and end time points of each block.}
#' \item{baseline}{A vector containing the estimated baseline fMRI signal level for each block.}
#' \item{dur}{A vector containing the duration (in seconds) of each event or block in the design.}
#'
#' @examples
#' # Create a data frame with experimental design
#' event_data <- data.frame(fac=c("a", "B", "A", "B"), onsets=c(1,10,20,80), run=c(1,1,1,1))
#'
#' # Create a sampling frame with 50-second blocks and a TR of 2 seconds
#' sframe <- sampling_frame(blocklens=50, TR=2)
#'
#' # Create an event model using the `onsets` variable as a predictor, with a separate baseline for each run
#' evmodel <- fmri_event_model(response ~ hrf(onsets), data=event_data, block=~run, sampling_frame=sframe)
event_model <- function(x, data, block, sampling_frame, drop_empty=TRUE, durations=0, ...) { UseMethod("event_model") }
#' get_data
#'
#' @param x the dataset
#' @param ... extra args
#' @export
#' @keywords internal
get_data <- function(x, ...) UseMethod("get_data")
#' get_mask
#'
#' get the binary inclusion mask associated with a dataset
#'
#' @param x the dataset
#' @param ... extra args
#' @keywords internal
get_mask <- function(x, ...) UseMethod("get_mask")
#' get_formula
#'
#' @param x the object
#' @param ... extra args
#' @keywords internal
get_formula <- function(x, ...) UseMethod("get_formula")
#' term_matrices
#'
#' @param x the object
#' @param ... extra args
#' @keywords internal
term_matrices <- function(x, ...) UseMethod("term_matrices")
#' extract long names of variable
#'
#' get the extended names of a set of variable levels
#'
#' @param x the object
#' @param ... extra args
#' @export
longnames <- function(x, ...) UseMethod("longnames")
#' extract short shortnames of variable
#'
#' get the short names of a set of variable levels
#'
#' @param x the object
#' @param ... extra args
#' @export
shortnames <- function(x, ...) UseMethod("shortnames")
#' design_env
#'
#' return regression design as a set of matrices stored in an environment
#'
#' @param x the object
#' @param ... extra args
#' @keywords internal
design_env <- function(x, ...) UseMethod("design_env")
#' contrast_weights
#'
#' Calculate contrast weights for a given contrast specification and term.
#'
#' @description
#' This function calculates the contrast weights based on the contrast specification
#' provided by the user. It is a generic function that dispatches to the appropriate
#' method depending on the class of the contrast
#'
#' @param x the object
#' @param ... extra args
#' @export
contrast_weights <- function(x, ...) UseMethod("contrast_weights")
#' parent_terms
#'
#' @param x the object
#' @keywords internal
parent_terms <- function(x) UseMethod("parent_terms")
#' term_names
#' @param x the object to extra term names from
#' @keywords internal
term_names <- function(x) UseMethod("term_names")
#' The experimental cells of a design
#'
#' return the experimental cells that are in a model term as a table
#'
#' @param x the object
#' @param ... extra args
#' @export
cells <- function(x, ...) UseMethod("cells")
#' Conditions
#'
#' return the set of condition labels associated with a model term
#'
#' @param x the model term
#' @param ... extra args
#' @export
conditions <- function(x, ...) UseMethod("conditions")
#' convolve
#'
#' Convolve a term `x` with a hemodynamic response function (HRF) over a `sampling_frame`.
#'
#' @description
#' This function convolves an event sequence `x` with a hemodynamic response function `hrf`
#' over a specified time series grid `sampling_frame`. It is a generic function that dispatches
#' to the appropriate method
#'
#' @param x an event sequence
#' @param hrf a hemodynamic response function
#' @param sampling_frame the time series grid over which to sample the function.
#' @param ... extra args
#' @export
convolve <- function(x, hrf, sampling_frame,...) UseMethod("convolve")
#' is_continuous
#'
#' checks to see if a variable is continuous e.g. numeric/non-categorical
#'
#' @param x the object
#' @export
is_continuous <- function(x) UseMethod("is_continuous")
#' is_categorical
#'
#' checks to see if a variable is cateogircal e.g. factor-based
#'
#' @param x the object
#' @export
is_categorical <- function(x) UseMethod("is_categorical")
#' levels
#'
#' extract the levels of a term
#' @param x the term
#' @export
levels <- function(x) UseMethod("levels")
#' columns
#'
#' return the column labels associated with the elements of a term.
#' @param x the term
#' @keywords internal
columns <- function(x) UseMethod("columns")
#' event_table
#'
#' Extract event_table as a `data.frame`.
#'
#' @description
#' This function extracts the event table from the provided term `x` and returns it
#' as a `data.frame`.
#'
#' @param x the term
#' @return A `data.frame` containing the event table.
#' @export
event_table <- function(x) UseMethod("event_table")
#' event_terms
#'
#' Extract a list of 'event_term's from the model object.
#'
#' @description
#' This function extracts a list of 'event_term's from the provided model object `x`.
#'
#' @param x the model object
#' @return A list containing the 'event_term's.
#' @export
event_terms <- function(x) UseMethod("event_terms")
#' baseline_terms
#'
#' Extract a list of 'baseline_term's from the model object.
#'
#' @description
#' This function extracts a list of 'baseline_term's from the provided model object `x`.
#'
#' @param x the model object
#' @return A list containing the 'baseline_term's.
#' @export
baseline_terms <- function(x) UseMethod("baseline_terms")
#' term_indices
#'
#' Get the term indices for the associated design matrix.
#'
#' @description
#' This function retrieves the term indices for the associated design matrix
#' from the provided model or term object `x`.
#'
#' @param x the model/term object
#' @param ... additional arguments
#' @return A vector of term indices.
#' @export
term_indices <- function(x,...) UseMethod("term_indices")
#' run
#'
#' Run a command.
#'
#' @description
#' This function runs a command `x` with the provided extra arguments.
#'
#' @param x the command to run
#' @param ... extra args
#' @export
run <- function(x,...) UseMethod("run")
#' design_matrix
#'
#' construct a design matrix from the term
#'
#' @param x the term
#' @param ... additional arguments
#' @export
design_matrix <- function(x, ...) UseMethod("design_matrix")
#' elements
#'
#' return the ordered elements of a term/variable
#'
#' @param x the term
#' @param ... additional arguments
#' @export
elements <- function(x, ...) UseMethod("elements")
#' evaluate a function over a sampling grid
#'
#' given an object to be evaluated and an input sample "grid", evaluate the object.
#'
#' @param x the object to evaluate
#' @param grid the sampling grid
#' @param ... extra args
#'
#' @export
evaluate <- function(x, grid, ...) UseMethod("evaluate")
#' return the "global" onsets of an object.
#'
#' global onsets are defined as cumulative time over runs, i.e. it does not reset to zero for each run.
#'
#' @export
#' @param x the object
#' @param onsets the relative onset times of the events
#' @param ... extra args
global_onsets <- function(x, onsets,...) UseMethod("global_onsets")
#' return number of basis functions associated with hrf.
#'
#' @export
#' @param x the object
nbasis <- function(x) UseMethod("nbasis")
#' return a set of data chunks
#'
#' @param x the dataset
#' @param nchunks the number of data chunks
#' @param ... extra args
#' @return an \code{iterator} returning on data chunk per iteration
#' @export
data_chunks <- function(x, nchunks, ...) UseMethod("data_chunks")
#' get event onsets of a variable
#'
#' return an `onset` vector
#'
#' @param x the object
#' @export
onsets <- function(x) UseMethod("onsets")
#' get event durations of a variable
#'
#' return a `durations` vector
#'
#' @param x the object
#' @export
durations <- function(x) UseMethod("durations")
#' get amplitude vector
#'
#' get the intensity or amplitudes associated with each event
#'
#' @param x the object
#' @export
amplitudes <- function(x) UseMethod("amplitudes")
#' extract samples
#'
#' get the sampling times for a regressor or sampling frame
#'
#' @param x the object
#' @param ... extra args
#' @export
samples <- function(x, ...) UseMethod("samples")
#' split_by_block
#'
#' split variables by block id
#'
#' @param x the object
#' @param ... extra args
#' @export
split_by_block <- function(x, ...) UseMethod("split_by_block")
#' get the block indices
#'
#' get the block number associated with each image/scan
#'
#' @param x the object
#' @export
blockids <- function(x) UseMethod("blockids")
#' get block lengths
#'
#' get the number of scans/images in each block
#'
#' @param x the object
#' @param ... extra args
#' @export
blocklens <- function(x, ...) UseMethod("blocklens")
#' Fcontrasts
#'
#' generate a set of Fcontrasts for a model term
#'
#' @param x the term
#' @param ... extra args
#' @export
Fcontrasts <- function(x, ...) UseMethod("Fcontrasts")
#' estcon
#'
#' @param x the object
#' @param fit the model fit
#' @param ... extra args
#' @export
estcon <- function(x, fit, ...) UseMethod("estcon")
#' construct
#'
#' construct a term given a an hrf spec and model specification
#'
#' @param x the object
#' @param model_spec the model specification
#' @param ... extra args
#' @export
construct <- function(x, model_spec,...) UseMethod("construct")
#' standard_error
#'
#' extract standard errors from fitted model
#'
#' @param x the object
#' @param ... extra arguments
standard_error <- function(x, ...) UseMethod("standard_error")
#' stats
#'
#' extract statistics from fitted model
#'
#' @param x the object
#' @param ... extra arguments
#' @export
stats <- function(x, ...) UseMethod("stats")
#' p_values
#'
#' extract p-values from fitted model
#'
#' @param x the object
#' @param ... extra arguments
p_values <- function(x, ...) UseMethod("p_values")
#' longnames
#'
#' @param x the object
#' @param ... extra args
#' @export
longnames <- function(x, ...) UseMethod("longnames")
#' generate an AFNI linear model command from a configuration file
#'
#' @param x the config file
#' @param ... extra args
#' @export
gen_afni_lm <- function(x, ...) UseMethod("gen_afni_lm")
#' generate a set of AFNI stimuli for '3dDeconvolve'
#'
#' @param x the term
#' @param ... extra args
#' @keywords internal
build_afni_stims <- function(x, ...) UseMethod("build_afni_stims")
#' split an onset vector into a list
#'
#' @param x the object associated with the onset vector
#' @param ... extra args
#' @export
split_onsets <- function(x, ...) UseMethod("split_onsets")
#' estimate trialwise beta coefficients for a dataset
#'
#' @param x the dataset
#' @param ... extra args
#' @export
#' @family estimate_betas
estimate_betas <- function(x, ...) UseMethod("estimate_betas")
#' estimate a linear model sequentially for each "chunk" (a matrix of time-series) of data
#'
#' @param x the dataset
#' @param ... extra args
chunkwise_lm <- function(x, ...) UseMethod("chunkwise_lm")
#' Shift a time series object
#'
#' This is a generic function to shift time series objects. The goal is to
#' provide a simple way to apply time shifts to various time series objects,
#' such as regressors and time series data.
#'
#' @param x An object representing a time series or a time-based data structure.
#' @param shift_amount A numeric value indicating the amount of time to shift the object by.
#' Positive values will shift the object to the right, while negative values will shift it to the left.
#'
#' @return An object of the same class as the input, shifted by the specified amount.
#'
#' @examples
#' \dontrun{
#' # Shift a regressor object
#' shifted_regressor <- shift(my_regressor, 5)
#'
#' # Shift a time series object
#' shifted_time_series <- shift(my_time_series, -2)
#' }
#'
#' @export
shift <- function(x, ...) {
UseMethod("shift")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.