Search for specific line in R function body

user_8696224 0
Viewed 73

I wish to "copy and modify" a function at a specific point in its body. Currently, what I have is

nearest_psd <- function(mat) {

  ed <- eigen(mat)
  eigvecs <- ed$vectors
  eigvals <- ed$values
  eigvals[eigvals<0] <- 0
  
  eigvecs %*% diag(eigvals) %*% t(eigvecs)
}

nearest_pd <- nearest_psd
formals(nearest_pd)$pdeps <- 1e-08
body(nearest_pd)[[c(7,3)]] <- quote(pdeps)

, so that nearest_pd is a copy of nearest_psd, except for the line eigvals[eigvals<0] <- pdeps.

However, the line number (7, in this case) is hard-coded, and I would prefer to have a robust way to determine this line number. How can I search for the line that contains the expression eigvals[eigvals<0] <- 0?

r
2 Answers

You can use identical to compare two expressions; that way, you can identify and replace the expression in question:

to_replace = vapply(body(nearest_pd), function (e) identical(e, quote(eigvals[eigvals < 0] <- 0)), logical(1L))
body(nearest_pd)[to_replace] = list(quote(eigvals[eigvals < pdeps] <- pdeps))

However, this is no more readable, nor more robust, than your code: in both cases you’re forced to hard-code the relevant information; in your code, the indices. In mine, the expression. For that reason I wouldn’t recommend using this.

… of course you could instead use an AST walker to replace all occurrences of 0 in the function’s body with pdeps. But is that better? No, since 0 could be used for other purposes. It currently isn’t, but who knows, once the original function changes. And if the original function can’t be assumed to change, why not hard-code the new function entirely? That is, write this:

nearest_pd <- function (mat, pdeps = 1e-08) {
    ed <- eigen(mat)
    eigvecs <- ed$vectors
    eigvals <- ed$values
    eigvals[eigvals < pdeps] <- pdeps
    eigvecs %*% diag(eigvals) %*% t(eigvecs)
}

… no need to use metaprogramming just for the sake of it.

user_19680

The following might do what you want.

nearest_psd <- function(mat) {
  
  ed <- eigen(mat)
  eigvecs <- ed$vectors
  eigvals <- ed$values
  eigvals[eigvals<0] <- 0
  
  eigvecs %*% diag(eigvals) %*% t(eigvecs)
}


nearest_pd <- nearest_psd

formals(nearest_pd)$pdeps <- 1e-08


nearest_psd_body <- body(nearest_psd)


# Find the string we a re looking for and replace it ...
new.code <- gsub("eigvals[eigvals < 0] <- 0",
                 "MY_NEW_CODE",
                 nearest_psd_body, fixed = TRUE)

# Buidling the function body as a string.
new.code <- new.code[-1] # delete first { such that ...
new.code <- paste(new.code, collapse = ";") # we can collapse the remaining here ....
new.code <- paste("{", new.code, "}", sep = "", collapse = "") # and then wrap the remaining in { }

# parse returns an expression.
body(nearest_pd) <- parse(text = new.code)

See At a basic level, what does eval-parse do in R? for an explantion of parse. Or In programming, what is an expression? what an expression is.

user_133976550
Related