(The examples here work with the version of insidefunctor tagged as "v1")
Say we want to support something like
> each(x) + each(y)
If we're going to call a function on multiple arguments, each one of which might specify some new behavior, we have to resolve the conflict somehow. For a start, let's say we give each argument a "level" and call one of them the "winner".
> apply.check.functor = function(func, args) {
> if (length(args) == 0) {
> return(func())
> }
> functor.levels = lapply(args, function(x) {
> if (is.inside.functor(x)) {
> level(x)
> }
> else {
> 0
> }
> })
> winner.i = which.max(functor.levels)
> winner.arg = args[[winner.i]]
> if (!is.inside.functor(winner.arg)) {
> do.call(func, args)
> }
> else {
> apply.functor(winner.arg, func, args)
> }
> }
This means we must also modify fmap to pass on
multiple arguments:
> fmap = function(func) {
> params = formals(args(func))
> new.func = function() {
> .args = as.list(environment())
> apply.check.functor(func, .args)
> }
> formals(new.func) = params
> new.func
> }
And now apply.functor.each is going to have to do
the work of reconciling the possibly competing messages:
> apply.functor.each = function(inside, func, args, caller) {
> our.level = level(inside)
> args.boxed = args
> for (i in seq_along(args.boxed)) {
> arg = args.boxed[[i]]
> if (is.inside.functor(arg) && level(arg) >= our.level) {
> if (length(inside$items) != length(arg$items)) {
> stop("Axis mismatch: ", inside, " and ", arg)
> }
> }
> else {
> args.boxed[[i]] = insert.each(inside, arg)
> }
> }
> items = list()
> for (i in seq_along(inside$items)) {
> piece.args = lapply(args.boxed, function(arg) {
> arg$items[[i]]
> })
> res = apply.check.functor(func, piece.args)
> items[[i]] = res
> }
> each(items)
> }
This insert.each is new: it pulls an argument into the
functor by broadcasting it along the axis being iterated over:
> insert.each = function(inside, obj) {
> each(lapply(inside$items, function(.) obj))
> }
We need to define that level method. For now just make all
levels 1 until we think of a good reason to make them otherwise.
> level = function(...) {
> UseMethod("level")
> }
> level.each = function(...) {
> 1
> }
Then retrieve those functions from the last post:
> is.inside.functor = function(...) {
> UseMethod("is.inside.functor")
> }
> is.inside.functor.default = function(...) {
> F
> }
> is.inside.functor.each = function(inside) {
> T
> }
> apply.functor = function(...) {
> UseMethod("apply.functor")
> }
> each = function(arg) {
> inside = list(items = arg)
> class(inside) = "each"
> inside
> }
And see if this gives something reasonable:
> x = list(1, 2, 3)
> y = list(4, 5, 6)
> `%+%` = fmap(`+`)
> each(x) %+% each(y)
$items
$items[[1]]
[1] 5
$items[[2]]
[1] 7
$items[[3]]
[1] 9
attr(,"class")
[1] "each"
> each(x) %+% 1
$items
$items[[1]]
[1] 2
$items[[2]]
[1] 3
$items[[3]]
[1] 4
attr(,"class")
[1] "each"
Now we can almost run that code from the beginning, fmap still has a problem:
> `%:%` = fmap(`:`)
> print(`%:%`)
The problem is
`:` does not have any formal parameters.
seq will fail too because it's parameters are '...'. These can be
solved, but for now define new functions
> seq. = fmap(function(a, b) {
> seq(a, b)
> })
> sum. = fmap(function(x) {
> sum(x)
> })
> sum.(seq.(1, each(x)))
$items
$items[[1]]
[1] 1
$items[[2]]
[1] 3
$items[[3]]
[1] 6
attr(,"class")
[1] "each"
This opens up a real opportunity. Languages like R and Matlab already
support something very similar to each(): for numeric vectors, x +
y means add up the corresponding elements. And "corresponding" means having the
same sequential position.
But just because two vectors have the same length does not mean they correspond. And normally R will not check that for you. But using inside functors we can check.
Since the above functions are still rather incomplete and this is getting to
be a lot of code sitting around in one place, for what follows I am going to
use the package insidefunctor from https://github.com/ellbur/r-inside-functor.
So let's load the package:
> rm(list = ls())
> library(insidefunctor)
In the insidefunctor package, each is slightly more
generalized. Anything can be eached if it supports the methods
unpack(object)pack(object, items)make.axis(object)
The package already defines these functions for vectors and lists. Let's make a new kind of object that remembers the dimension it runs along.
> as.dimension = function(items) {
> dimension = list(items = items, id = next.dimension.id())
> class(dimension) = "dimension"
> dimension
> }
> unpack.dimension = function(dimension) {
> dimension$items
> }
> pack.dimension = function(dimension, items) {
> dimension$items = items
> dimension
> }
> make.axis.dimension = function(dimension) {
> seq = seq_along(dimension$items)
> attr(seq, "id") = dimension$id
> seq
> }
> dimension.id.counter = 0
> next.dimension.id = function() {
> dimension.id.counter <<- dimension.id.counter + 1
> dimension.id.counter
> }
Setting the 'id' attribute of the returned axis ensures that
each will not let you line up two dimensions whose ids differ.
Let's check that code:
> x = as.dimension(c(1, 2, 3))
> y = as.dimension(c(4, 5, 6))
> `%+.%` = fmap(`+`)
> sq. = fmap(function(z) z^2)
> try(collect(each(x) %+.% each(x)), silent = T)
$items
$items[[1]]
[1] 2
$items[[2]]
[1] 4
$items[[3]]
[1] 6
$id
[1] 1
attr(,"class")
[1] "dimension"
> try(collect(each(x) %+.% sq.(each(x))), silent = T)
$items
$items[[1]]
[1] 2
$items[[2]]
[1] 6
$items[[3]]
[1] 12
$id
[1] 1
attr(,"class")
[1] "dimension"
> try(collect(each(x) %+.% each(y)), silent = T)
> geterrmessage()
Error in apply.functor.each(winner.arg, func, args, apply.check.functor) : Axis mismatch: 11list(items = c(1, 2, 3), id = 1)c(1, 2, 3)1:3list() and 11list(items = c(4, 5, 6), id = 2)c(4, 5, 6)1:3list()
Excellent. We can add x to itself or something calculated from
itself, but we can't add x to y because we haven't
told each that those variables lie along the same axis -- maybe
they don't.
If we want them to correspond, we can say so explicitly.
> align = function(dim1, dim2) {
> if (length(dim1$items) != length(dim2$items)) {
> stop("Cannot align; lengths differ")
> }
> dim1$id = dim2$id
> dim1
> }
> y = align(y, x)
> try(collect(each(x) %+.% each(y)))
$items
$items[[1]]
[1] 5
$items[[2]]
[1] 7
$items[[3]]
[1] 9
$id
[1] 1
attr(,"class")
[1] "dimension"
Now at least it can't happen by accident.
No comments:
Post a Comment