R/edge_from_function-function.R

In rcausim: Generate Causally-Simulated Data

#' Identify edges given functions
#'
#' @param func Functions, an object class generated by
#' \code{\link{function_from_edge}} or \code{\link{function_from_user}}
#' functions.
#'
#' @return A data frame which include the columns 'from' and 'to in this order.
#'
#' @keywords function-specified-edge-listing
#'
#' @export
#'
#' @importFrom magrittr %>%
#'
#' @examples
#'
#' data(functions)
#' edge_from_function(functions)

edge_from_function=function(func){
  # 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.'
      )
    )
  }

  # List arguments in each function
  arg=c()

  func_is_function=
    func %>%
    sapply(\(x)inherits(x,"function"))

  if(sum(func_is_function)>0){
    arg_in_function=
      func[func_is_function] %>%
      lapply(formals) %>%
      lapply(names)

    arg=
      arg %>%
      c(arg_in_function)
  }

  func_is_character=
    func %>%
    sapply(\(x)inherits(x,"character"))

  if(sum(func_is_character)>0){
    arg_in_character=
      func[func_is_character]

    arg=
      arg %>%
      c(arg_in_character)
  }

  # Filter arguments of functions from non-terminal vertices
  v_nonterm_arg=
    arg[sapply(arg,\(x)length(x[x!='n'])>0)]

  # Create an edge from each argument to the non-terminal vertex
  e=lapply(
      X=names(v_nonterm_arg)
      ,Y=v_nonterm_arg
      ,\(X,Y)data.frame(from=Y[[X]],to=X)
    )

  e=do.call(rbind,e)

  # Return edges
  e
}