## *11. Advanced Programming Topics ## 11.1. Methods fac<-ordered(1:3) class(fac) print.ordered function (x, quote = FALSE) { if (length(x) <= 0) cat("ordered(0)\n") else NextMethod("print") cat("Levels: ", paste(levels(x), collapse = " < "), "\n") invisible(x) } ## 11.2 Extracting Arguments to Functions extract.arg <- function (a) { s <- substitute(a) as.character(s) } extract.arg(a=xy) deparse.args <- function (a) { s <- substitute (a) if(mode(s) == "call"){ # the first element of a 'call' is the function called # so we don't deparse that, just the arguments. print(paste("The function is: ", s[1],"()", collapse="")) lapply (s[-1], function (x) paste (deparse(x), collapse = "\n")) } else stop ("argument is not a function call") } deparse.args(list(x+y, foo(bar))) ## 11.3 Parsing and Evaluation of Expressions expression(mean(x+y)) my.exp <- expression(mean(x+y)) x <- 101:110 y <- 21:30 my.exp <- expression(mean(x+y)) my.txt <- expression("mean(x+y)") eval(my.exp) eval(my.txt) parse(text="mean(x+y)") expression(mean(x + y)) my.exp2 <- parse(text="mean(x+y)") eval(my.exp2) make.new.df <- function(old.df = austpop, colnames = c("NSW", "ACT")) { attach(old.df) on.exit(detach(old.df)) argtxt <- paste(colnames, collapse = ",") exprtxt <- paste("data.frame(", argtxt, ")", sep = "") expr <- parse(text = exprtxt) df <- eval(expr) names(df) <- colnames df } make.new.df() make.new.df <- function(old.df = austpop, colnames = c("NSW", "ACT")) { attach(old.df) on.exit(detach(old.df)) argtxt <- paste(colnames, collapse = ",") listexpr <- parse(text=paste("list(", argtxt, ")", sep = "")) df <- do.call("data.frame", eval(listexpr)) names(df) <- colnames df } ## 11.4 Plotting a mathematical expression plotcurve <- function(equation = "y = sqrt(1/(1+x^2))", ...){ leftright <- strsplit(equation, split = "=")[[1]] left <- leftright[1] # The part to the left of the "=" right <- leftright[2] # The part to the right of the "=" expr <- parse(text=right) xname <- all.vars(expr) if(length(xname) > 1) stop(paste("There are multiple variables, i.e.", paste(xname, collapse=" & "), "on the right of the equation")) if(length(list(...))==0)assign(xname, 1:10) else { nam <- names(list(...)) if(nam!=xname)stop("Clash of variable names") assign("x", list(...)[[1]]) assign(xname, x) } y <- eval(expr) yexpr <- parse(text=left)[[1]] xexpr <- parse(text=xname)[[1]] plot(x, y, ylab = yexpr, xlab = xexpr, type="n") lines(spline(x,y)) mainexpr <- parse(text=paste(left, "==", right)) title(main = mainexpr) } plotcurve() plotcurve("ang=asin(sqrt(p))", p=(1:49)/50) ## 11.5 Searching R functions for a specified token. mygrep <- function(str) { ## Assign the names of all objects in current R ## working directory to the string vector tempobj ## tempobj <- ls(envir=sys.frame(-1)) objstring <- character(0) for(i in tempobj) { myfunc <- get(i) if(is.function(myfunc)) if(length(grep(str, deparse(myfunc)))) objstring <- c(objstring, i) } return(objstring) } mygrep("for") # Find all functions that include a for loop