Inheriting in Items
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
What if we want to extend the behavior of one item with
another? Or, to put it another way, what if we want one item to be
able to grab the functionality of another?
It turns out we can (almost) get this behavior without modifying the item constructor at all. Here’s how you do the grabbing:
> grab = function(src, obj=parent.frame()) {
> for (name in ls(src)) {
> (function(name) {
> if (!exists(name, obj, inh=F)) {
> delayedAssign(name, src[[name]], assign.env=obj)
> }
> })(name)
> }
> }
Now let’s use that:
> A = item(
> x =,
> y =,
>
> sum = x + y
> )
> B = item(
> x =,
> y =,
>
> init = grab(A(x, y))
> )
> b = B(2, 3)
> as.list(b)
$sum
[1] 2
$x
[1] 3
$y
NULL
What is going on here?? This one is really tricky; it took me 1/2 hour or so to figure it out.
So, clearly, the problem starts with the fact that init
is evaluated too late. We could easily fix the problem like this:
> b = B(2, 3)
> force(b$init)
NULL
> as.list(b)
$sum
[1] 5
$x
[1] 2
$y
[1] 3
$init
NULL
But what’s with the argument values appearing with the wrong names? Here’s
the C function that implements as.list.environment:
1 SEXP attribute_hidden do_env2list(SEXP call, SEXP op, SEXP args, SEXP rho)
2 {
3 SEXP env, ans, names;
4 int k, all;
5
6 checkArity(op, args);
7
8 env = CAR(args);
9 if (ISNULL(env))
10 error(_("use of NULL environment is defunct"));
11 if( !isEnvironment(env) ) {
12 SEXP xdata;
13 if( IS_S4_OBJECT(env) && TYPEOF(env) == S4SXP &&
14 (xdata = R_getS4DataSlot(env, ENVSXP)) != R_NilValue)
15 env = xdata;
16 else
17 error(_("argument must be an environment"));
18 }
19
20 all = asLogical(CADR(args));
21 if (all == NA_LOGICAL) all = 0;
22
23 if (env == R_BaseEnv || env == R_BaseNamespace)
24 k = BuiltinSize(all, 0);
25 else if (HASHTAB(env) != R_NilValue)
26 k = HashTableSize(HASHTAB(env), all);
27 else
28 k = FrameSize(FRAME(env), all);
29
30 PROTECT(names = allocVector(STRSXP, k));
31 PROTECT(ans = allocVector(VECSXP, k));
32
33 k = 0;
34 if (env == R_BaseEnv || env == R_BaseNamespace)
35 BuiltinValues(all, 0, ans, &k);
36 else if (HASHTAB(env) != R_NilValue)
37 HashTableValues(HASHTAB(env), all, ans, &k);
38 else
39 FrameValues(FRAME(env), all, ans, &k);
40
41 k = 0;
42 if (env == R_BaseEnv || env == R_BaseNamespace)
43 BuiltinNames(all, 0, names, &k);
44 else if (HASHTAB(env) != R_NilValue)
45 HashTableNames(HASHTAB(env), all, names, &k);
46 else
47 FrameNames(FRAME(env), all, names, &k);
48
49 setAttrib(ans, R_NamesSymbol, names);
50 UNPROTECT(2);
51 return(ans);
52 }
53
Notice that it grabs the values first, and the names second. So when it goes to grab the values, they are 2, 3, and a promise to evaluate grab(A(x, y)). But wait… while it’s getting those values, won’t the promise be evaluated, and change the structure R is working on?
Yes… and that could be a problem, but it isn’t:
1 static void FrameValues(SEXP frame, int all, SEXP values, int *indx)
2 {
3 while (frame != R_NilValue) {
4 if ((all || CHAR(PRINTNAME(TAG(frame)))[0] != '.') &&
5 CAR(frame) != R_UnboundValue) {
6 SEXP value = CAR(frame);
7 if (TYPEOF(value) == PROMSXP) {
8 PROTECT(value);
9 value = eval(value, R_GlobalEnv);
10 UNPROTECT(1);
11 }
12 SET_VECTOR_ELT(values, *indx, duplicate(value));
13 (*indx)++;
14 }
15 frame = CDR(frame);
16 }
17 }
18
Values are stored in a pair list, which is like a linked list in that
modifications to the front of the list don’t affect someone already iterating
further down. So grab() sticks sum at the beginning,
where it won’t show up in the values. And the result of grab() is
the NULL that you see in the 3rd value.
Then it goes to get the names. But it’s only allocated space for 3 names,
because it already checked the size. So the first 3 names are sum,
x, and y. And that’s what you see. From looking at
how FrameNames works, it looks like this should cause a buffer
overrun, but that doesn’t show up.
We could have an item automatically check for the existence
of init at instantiation time and run it if it exists, but I prefer
a more general solution:
> item = function(…) {
> foo = function() {
> E = environment()
>
> for (i in seq_along(args)) {
> name = args.names[[i]]
> if (substr(name, 1, 1) == ‘.’) {
> force(E[[name]])
> }
> }
>
> E
> }
>
> args = process.args(as.list(substitute(list(…)))[–1L])
> args.names = names(args)
> formals(foo) = args
>
> foo
> }
That is, we force all arguments starting with a ‘.’.
Then we can modify process.args to give unnamed arguments
a name with a ‘.’:
> process.args = function(args) {
> arg.names = names(args)
> if (is.null(arg.names)) {
> arg.names = replicate(length(args), NULL)
> }
>
> for (i in seq_along(args)) {
> if (is.null(arg.names[[i]]) || arg.names[[i]] == ”) {
> arg.names[[i]] = paste(‘.’, as.character(i), sep=”)
> }
> }
>
> names(args) = arg.names
>
> args
> }
Now we can write:
> B = item(
> x =,
> y =,
>
> grab(A(x, y))
> )
> b = B(2, 3)
> as.list(b)
$sum
[1] 5
$name
[1] “.3”
$i
[1] 3
$E
$x
[1] 2
$y
[1] 3
Oh yeah we have some extra junk in there. We could hide it with ‘.’ names, or we could hide everything by nesting:
> item = function(…) {
> foo = function() {
> (function() {
> E = parent.frame()
>
> for (i in seq_along(args)) {
> name = args.names[[i]]
> if (substr(name, 1, 1) == ‘.’) {
> force(E[[name]])
> }
> }
> })()
>
> environment()
> }
>
> args = process.args(as.list(substitute(list(…)))[–1L])
> args.names = names(args)
> formals(foo) = args
>
> foo
> }
> B = item(
> x =,
> y =,
>
> grab(A(x, y))
> )
> b = B(2, 3)
> as.list(b)
$sum
[1] 5
$x
[1] 2
$y
[1] 3
Perfect.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.