R/generate_fsf_contrast_syntax.R

In PennStateDEPENdLab/dependlab: Useful functions for the UNC Chapel Hill DEPENd Lab (Director: Michael Hallquist)

#' This function generates syntax for FSL Feat .fsf files for the contrasts tab of an fMRI analysis.
#' It accepts a numeric contrast matrix whose rownames correspond to the name of the contrast.
#'
#' This allows you to generate contrast syntax dynamically based on a given subject's data
#' using tools such as lm() and emmeans() to obtain proper contrast vectors in more complex
#' modeling situations. The idea would be to glue the syntax generated by this function together
#' with a more general FSF template file that has EVs and so on.
#'
#' @param cmat A numeric matrix whose rows specify individual contrasts and columns specify coefficients (EVs).
#' @param ftests A list containing F-tests composed of combinations of EVs. For future development.
#' @param include_overall Whether to include the overall information about contrasts (e.g., whether to implement
#'      contrast masking) in the syntax. Defaults to TRUE.
#'
#' @return A character vector containing .fsf syntax for the contrasts portion of a Feat analysis based on \code{cmat}.
#'
#' @examples
#'   cmat <- rbind('overall'=c(1, 0.333, 0.333, 0),
#'                 'c1_gt_c2'=c(0, 1, 0, 0),
#'                 'c2_gt_c3'=c(0, 1, -1, 0),
#'                 'c1_gt_c3'=c(0, 0, -1, 0))
#'
#'   result <- generate_fsf_contrast_syntax(cmat)
#'
#' @author Michael Hallquist
#' @export
generate_fsf_contrast_syntax <- function(cmat, ftests=NULL, include_overall=TRUE) {
  #currently, this only supports contrasts, not F tests
  #ftests is a placeholder
  #cmat is a contrast matrix containing the contrast names in rownames() and coefficients for the EV contrast vector

  nftests <- ifelse(is.null(ftests), 0, length(ftests))

  #don't support separation between original (one per column) and 'real' (one per basis element) EVs
  fsf_syntax <- c(
    "# Number of contrasts",
    paste0("set fmri(ncon_orig) ", 0), #nrow(cmat)),
    paste0("set fmri(ncon_real) ", nrow(cmat)),
    "",
    "# Number of F-tests",
    paste0("set fmri(nftests_orig) ", 0), #nftests),
    paste0("set fmri(nftests_real) ", nftests),
    ""
  )

  if (include_overall) {
    fsf_syntax <- c(fsf_syntax,
      "# Contrast & F-tests mode",
      "# real : control real EVs",
      "# orig : control original EVs",
      "set fmri(con_mode_old) real",
      "set fmri(con_mode) real",
      ""
    )
  }

  for (i in 1:nrow(cmat)) {
    #whether to display images for contrast (only support yes)
    fsf_syntax <- c(fsf_syntax,
      paste("# Display images for contrast_real", i),
      paste0("set fmri(conpic_real.", i, ") 1"), "")

    #contrast name
    fsf_syntax <- c(fsf_syntax,
      paste("# Title for contrast_real", i),
      paste0("set fmri(conname_real.", i, ") \"", rownames(cmat)[i], "\""), "")

    #columns of contrast
    for (j in 1:ncol(cmat)) {
      #contrast value in each row and column
      fsf_syntax <- c(fsf_syntax,
        paste("# Real contrast_real vector", i, "element", j),
        paste0("set fmri(con_real", i, ".", j, ") ", cmat[i,j]), "")
    }

    #contrast masking by F test (not supported/disabled, but including to match FSL expectations)
    #note: re-defining j in terms of number of contrasts, not EVs as in previous loop
    #we are basically looking at contrast x contrast masking (intersection/conjunction)

    for (j in 1:nrow(cmat)) {
      if (i != j) { #can't mask contrast with itself
        fsf_syntax <- c(fsf_syntax,
          paste0("# Mask real contrast/F-test ", i, " with real contrast/F-test ", j, "?"),
          paste0("set fmri(conmask", i, "_", j, ") 0"), "")
      }
    }

  }

  if (include_overall) { #include contrast masking general info
    fsf_syntax <- c(fsf_syntax,
      "# Contrast masking - use >0 instead of thresholding?",
      "set fmri(conmask_zerothresh_yn) 0",
      "",
      "# Do contrast masking at all?",
      "set fmri(conmask1_1) 0",
      ""
    )
  }

  return(fsf_syntax)
}