## *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