在R中使用局部变量的defmacro [英] defmacro that uses local variables in R
本文介绍了在R中使用局部变量的defmacro的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
以下是 http://cran.r-project中的代码.org/doc/Rnews/Rnews_2001-3.pdf :
defmacro <- function(..., expr){
expr <- substitute(expr)
a <- substitute(list(...))[-1]
## process the argument list
nn <- names(a)
if (is.null(nn)) nn <- rep("", length(a))
nn
for(i in seq(length=length(a))) {
if (nn[i] == "") {
nn[i] <- paste(a[[i]])
msg <- paste(a[[i]], "not supplied")
a[[i]] <- substitute(stop(foo),
list(foo = msg))
print(a)
}
}
names(a) = nn
a = as.list(a)
ff = eval(substitute(
function() {
tmp = substitute(body)
# # new environment to eval expr
# private_env = new.env()
# pf = parent.frame()
# for(arg_name in names(a)) {
# private_env[[a]] = pf[[a]]
# }
# eval(tmp, private_env)
eval(tmp, parent.frame())
},
list(body = expr)))
formals(ff) = a
mm = match.call()
mm$expr = NULL
mm[[1]] = as.name("macro")
mm_src = c(deparse(mm), deparse(expr))
attr(ff, "source") = mm_src
ff
}
setna = defmacro(a, b, values, expr = {a$b[a$b %in% values] = NA; a})
dat = data.frame(x = 1:4, y = rep(-9, 4))
setna(dat, y, -9)
dat
作者挑战读者提出一种新的defmacro，它使用局部变量而不是父框架中的eval(这很危险，因为它可能会修改父框架中的对象).
The author challenges readers to come up with an new defmacro that uses local variables instead of eval in the parent frame (which could be dangerous since it could modify objects in the parent frame).
我试图创建一个新环境并从父环境中复制变量，并在那里评估函数主体(代码已注释掉)，但结果是它根本没有评估主体.
I tried to create a new environment and copy variables from the parent environment, and eval the function body there (code commented out), but the result is that it does not eval the body at all.
有人可以帮忙吗?
@bergant建议使用eval(tmp, new.env())，并且确实可以在不嵌套宏的情况下使用它，但是这里存在一个问题:
@bergant suggests that eval(tmp, new.env()) will do, and indeed it works when macros are not nested, but here we have a problem:
#' TODO: doc
#' @export
defmacro <- function(..., expr){
expr <- substitute(expr)
a <- substitute(list(...))[-1]
## process the argument list
nn <- names(a)
if (is.null(nn)) nn <- rep("", length(a))
nn
for(i in seq(length=length(a))) {
if (nn[i] == "") {
nn[i] <- paste(a[[i]])
msg <- paste(a[[i]], "not supplied")
a[[i]] <- substitute(stop(foo),
list(foo = msg))
print(a)
}
}
names(a) = nn
a = as.list(a)
ff = eval(substitute(
function() {
tmp = substitute(body)
eval(tmp, parent.frame())
},
list(body = expr)))
formals(ff) = a
mm = match.call()
mm$expr = NULL
mm[[1]] = as.name("macro")
mm_src = c(deparse(mm), deparse(expr))
attr(ff, "source") = mm_src
ff
}
#' IfLen macro
#'
#' Check whether a object has non-zero length, and
#' eval expression accordingly.
#'
#' @param df An object which can be passed to \code{length}
#' @param body1 If \code{length(df)} is not zero, then this clause is evaluated, otherwise, body2 is evaluated.
#' @param body2 See above.
#'
#' @examples
#' ifLen(c(1, 2), { print('yes!') }, {print("no!")})
#'
#' @author kaiyin
#' @export
ifLen = defmacro(df, body1, body2 = {}, expr = {
if(length(df) != 0) {
body1
} else {
body2
}
})
#' IfLet macro
#'
#' Eval expression x, assign it to a variable, and if that is TRUE, continue
#' to eval expression1, otherwise eval expression2. Inspired by the clojure
#' \code{if-let} macro.
#'
#' @param sym_str a string that will be converted to a symbol to hold value of \code{x}
#' @param x the predicate to be evalueated, and to be assigned to a temporary variable as described in \code{sym_str}
#' @param body1 expression to be evaluated when the temporary variable is TRUE.
#' @param body2 expression to be evaluated when the temporary variable is FALSE.
#'
#' @examples
#' ifLet(..temp.., TRUE, {print(paste("true.", as.character(..temp..)))},
#' {print(paste("false.", as.character(..temp..)))})
#' ifLet("..temp..", TRUE, {print(paste("true.", as.character(..temp..)))},
#' {print(paste("false.", as.character(..temp..)))})
#'
#' @author kaiyin
#' @export
ifLet = defmacro(sym_str, x, body1, body2={}, expr = {
stopifnot(is.character(sym_str))
stopifnot(length(sym_str) == 1)
assign(sym_str, x)
if(eval(as.symbol(sym_str))) {
body1
} else {
body2
}
})
#
#setMethod("ifLet",
# signature(sym = "character", x = "ANY", body1 = "ANY", body2 = "ANY"),
# function(sym, x, body1, body2 = {}) {
# e = new.env()
# sym_str = deparse(substitute(sym))
# ifLet(sym_str, x, body1, body2)
# })
#
##' TODO: doc
##' @export
#setMethod("ifLet",
# signature(sym = "character", x = "ANY", body1 = "ANY", body2 = "ANY"),
# function(sym, x, body1, body2 = {}) {
# stopifnot(length(sym) == 1)
# e = new.env()
# assign(sym, x, envir = e)
# if(e[[sym]]) {
# eval(substitute(body1), e, parent.frame())
# } else {
# eval(substitute(body2), e, parent.frame())
# }
# })
#' IfLetLen macro
#'
#' Similar to ifLet, but conditioned on whether the length of
#' the result of \code{eval(x)} is 0.
#'
#'
#' @param x the predicate to be evalueated, and to be assigned to a temporary var called \code{..temp..}
#' @param body1 expression to be evaluated when \code{..temp..} is TRUE.
#' @param body2 expression to be evaluated when \code{..temp..} is FALSE.
#'
#' @examples
#' ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))},
#' {print(paste("false.", as.character(..temp..)))})
#'
#' @author kaiyin
#' @export
ifLetLen = defmacro(sym_str, x, body1, body2={}, expr = {
stopifnot(is.character(sym_str))
stopifnot(length(sym_str) == 1)
assign(sym_str, x)
ifLen(eval(as.symbol(sym_str)), {
body1
}, {
body2
})
})
如果运行此测试:
ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))},
{print(paste("false.", as.character(..temp..)))})
您将得到一个object not found error.
推荐答案
您可以将环境作为属性添加到defmacro:
You could add the environment as an attribute to the defmacro:
defmacro <- function(..., expr, env = parent.frame()){
expr <- substitute(expr)
a <- substitute(list(...))[-1]
## process the argument list
nn <- names(a)
if (is.null(nn)) nn <- rep("", length(a))
nn
for(i in seq(length=length(a))) {
if (nn[i] == "") {
nn[i] <- paste(a[[i]])
msg <- paste(a[[i]], "not supplied")
a[[i]] <- substitute(stop(foo),
list(foo = msg))
print(a)
}
}
names(a) = nn
a = as.list(a)
ff = eval(substitute(
function() {
tmp = substitute(body)
eval(tmp, env)
},
list(body = expr)))
formals(ff) = a
mm = match.call()
mm$expr = NULL
mm[[1]] = as.name("macro")
mm_src = c(deparse(mm), deparse(expr))
attr(ff, "source") = mm_src
ff
}
在这里我们使用new.env:
ifLen = defmacro(df, body1, body2 = {}, expr = {
if(length(df) != 0) {
body1
} else {
body2
}
}, env = new.env())
但是这里我们不是:
ifLetLen = defmacro(sym_str, x, body1, body2={}, expr = {
stopifnot(is.character(sym_str))
stopifnot(length(sym_str) == 1)
assign(sym_str, x)
ifLen(eval(as.symbol(sym_str)), {
body1
}, {
body2
})
})
ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))},
{print(paste("false.", as.character(..temp..))); xxx <- 69})
# [1] "true. 1" "true. 2" "true. 3"
第一个示例:
setna = defmacro(a, b, values, expr = {a$b[a$b %in% values] = NA; a}, env = new.env())
dat = data.frame(x = 1:4, y = rep(-9, 4))
> setna(dat, y, -9)
# x y
# 1 1 NA
# 2 2 NA
# 3 3 NA
# 4 4 NA
> dat
# x y
# 1 1 -9
# 2 2 -9
# 3 3 -9
# 4 4 -9
所提出的解决方案的问题在于，您必须注意环境(什么功能以及表达式在何处可见).我觉得它作为编程工具不是很透明.
The problem with the proposed solution is that you have to take care about environments (what is visible to what function and where the expressions evaluate). I don't find it very transparent as a programming tool.
注意:它不能解决局部变量的问题(来自原始论文)-只是将所有内容放在单独的环境中(就像典型的R函数一样).
Note: It doesn't solve the problem of local variables (from the original paper) - it just puts everything in separate environment (as typical R functions do anyhow).
这篇关于在R中使用局部变量的defmacro的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
