R/define-function.R

In rcausim: Generate Causally-Simulated Data

#' Define a function in the list of functions
#'
#' @param func Functions, an object class generated by
#' \code{\link{function_from_edge}} or \code{\link{function_from_user}}
#' functions.
#' @param which Which, a character of length 1 indicating a vertex name for
#' which function is defined. The vertex name must be defined in 'Functions'.
#' @param what What, a function to be defined. It must use all and only
#' the specified arguments for the vertex in 'Functions', if not previously
#' defined.
#'
#' @return A list of either functions or character vectors of arguments for
#' function. It can be continuously defined or redefined by a user using
#' \code{define} function. If all elements of the list are functions, then it
#' can be an input for generating the simulated data.
#'
#' @keywords edge-specified-function-definition
#'
#' @export
#'
#' @importFrom magrittr %>%
#'
#' @examples
#'
#' data(edges)
#' functions <- function_from_edge(edges)
#' function_B <- function(n){ rnorm(n, 90, 5) }
#' functions <- define(functions, 'B', function_B)

define=function(func,which,what){
  # Check if 'func' is 'Functions'
  if(!inherits(func,"Functions")){
    stop(
      paste0(
        '\n'
        ,'The argument \'func\' is not of class \'Functions\'. Please use\n'
        ,'function_from_edge() or function_from_user() to create valid input\n'
        ,'for this function.'
      )
    )
  }

  # Check if 'which' is a single character
  if(!all(is.character(which),length(which)==1)){
    stop(
      paste0(
        '\n'
        ,'The argument \'which\' must be a character of length 1. Please\n'
        ,'ensure that \'which\' is specified correctly.'
      )
    )
  }

  # Check if 'what' is a function
  if(!is.function(what)){
    stop(
      paste0(
        '\n'
        ,'The argument \'what\' must be a function. Please ensure that\n'
        ,'\'what\' is specified correctly.'
      )
    )
  }

  # Check if 'which' is specified
  if(is.null(func[[which]])){
    stop(
      paste0(
        '\n'
        ,'The specified function does not exist. Please check the function\n'
        ,'name and ensure it is correctly spelled. Available functions\n'
        ,'include:\n'
        ,func %>%
          names() %>%
          paste0(collapse=', ')
      )
    )
  }

  # Check if arguments in 'what' function match the specified arguments
  if(!is.function(func[[which]])){
    arg=
      what %>%
      formals() %>%
      names() %>%
      unique()

    arg_in_which_func=
      func[[which]] %>%
      unique()

    if(!all(c(arg%in%arg_in_which_func,arg_in_which_func%in%arg))){
      stop(
        paste0(
          '\n'
          ,'If not previously defined, your function must use all and only '
          ,'these specified arguments:\n'
          ,arg_in_which_func %>%
            paste0(collapse=', ')
        )
      )
    }
  }

  # Assign what function to which vertex in the class
  func[[which]]=what

  # Return the class
  func
}