1.depth <- function(fname, funcargs, ...){ 2 f <- try(match.fun(fname), silent = T) 3 if (is.function(f)){ 4 args = list(...) 5 fcnArgs <- names(formals(f)) 6 fcnArgs <- unlist(fcnArgs, use.names=FALSE) 7 keep <- intersect(names(args), fcnArgs) 8 unused <- setdiff(names(args), fcnArgs) 9 args <- args[keep] 10 11 args <- c(args, funcargs) 12 res <- do.call(fname, args=args) 13 14 if(length(unused)>0) 15 warning("Unused by '", fname, "' arguments: ", paste(unused, collapse = ', ')) 16 17 #res <- f(x, data, ...) 18 19 return(res) 20 } else { 21 warning("There is no depth function ", fname) 22 } 23} 24 25depth. <- function(x, data, notion = c("zonoid", "halfspace", "Mahalanobis", "projection", "spatial", "spatialLocal", "simplicial", "simplicialVolume", "ddplot", "potential"), ...){ 26 27 if(is.null(notion)) 28 stop("Parameter 'notion' must be set") 29 t <- notion 30 try(t <- match.arg(notion), silent = T) 31 32 fname = paste0("depth.", t) 33 funcargs = list(x = x, data = data) 34 35 return(.depth(fname, funcargs, ...)) 36} 37 38depth.space. <- function(data, cardinalities, notion = c("zonoid", "halfspace", "Mahalanobis", "projection", "spatial", "spatialLocal", "simplicial", "simplicialVolume", "ddplot", "potential"), ...){ 39 40 if(is.null(notion)) 41 stop("Parameter 'notion' must be set") 42 t <- notion 43 try(t <- match.arg(notion), silent = T) 44 45 # try to find a depth 46 fname = paste0("depth.space.", t) 47 funcargs = list(cardinalities = cardinalities, data = data) 48 return(.depth(fname, funcargs, ...)) 49} 50 51 52 53 54# d = depth(data$train, data$train, exact = T) 55