-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathwrapAsFunction.R
49 lines (43 loc) · 1.02 KB
/
wrapAsFunction.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
wrapAsFunction =
#
# Wrap code into a function and specify the free variables as parameters.
#
# e = quote( for(i in 1:B) {
# d.star = data[sample(n, n, replace = TRUE), ]
# ans[[i]] = T(d.star)
# })
# wrapAsFunction(e)
#
# wrapAsFunction(quote({ x = a; y = 2}))
# wrapAsFunction(quote({ x = 1; y = 2}))
#
function(code, globalFuns = character(), params = getFreeVars(code, globalFuns),
env = globalenv())
{
f = function() {}
environment(f) = env
if(is(code, "{"))
body(f) = code
else
body(f)[[2]] = code
formals(f) = params
f
}
getFreeVars =
function(code, globalFuns = character())
{
fun = function() { 1 }
if(is(code, "{"))
body(fun) = code
else
body(fun)[[2]] = code
g = findGlobals(fun, FALSE)
# see if any of the functions referenced are also
g$variables = c(g$variables, globalFuns)
if(length(g$variables)) {
fm = rep(alist(x = ), length(g$variables))
names(fm) = g$variables
formals(fun) = fm
}
formals(fun)
}