| Line 319... |
Line 319... |
| 319 |
if (any(has.typeSvec(x, "factor"), has.typeSvec(x, "ordered")))
|
319 |
if (any(has.typeSvec(x, "factor"), has.typeSvec(x, "ordered")))
|
| 320 |
stop(paste(.Generic, "not meaningful for factors"))
|
320 |
stop(paste(.Generic, "not meaningful for factors"))
|
| 321 |
if (!any(has.typeSvec(x, "numeric"), has.typeSvec(x, "integer")))
|
321 |
if (!any(has.typeSvec(x, "numeric"), has.typeSvec(x, "integer")))
|
| 322 |
stop("Non-numeric argument to mathematical function")
|
322 |
stop("Non-numeric argument to mathematical function")
|
| 323 |
#.Generic
|
323 |
#.Generic
|
| 324 |
other.args <- formals(get(.Generic, mode="function"))[-1]
|
324 |
other.args <- formals(args(get(.Generic, mode="function")))[-1]
|
| 325 |
extra.args <- list(...)
|
325 |
extra.args <- list(...)
|
| 326 |
|
326 |
|
| 327 |
# "union" of list elements, with values in extra.args taking precedence
|
327 |
# "union" of list elements, with values in extra.args taking precedence
|
| 328 |
# to get default values if missing.
|
328 |
# to get default values if missing.
|
| 329 |
# there is some "magic" with Math group functions: they already perform
|
329 |
# there is some "magic" with Math group functions: they already perform
|
| Line 335... |
Line 335... |
| 335 |
# the 2nd arg is tricky, since it can be a vector > 1 then we'd have
|
335 |
# the 2nd arg is tricky, since it can be a vector > 1 then we'd have
|
| 336 |
# to take care of recycling etc. simplify by allowing only scalars
|
336 |
# to take care of recycling etc. simplify by allowing only scalars
|
| 337 |
# as 2nd arg.
|
337 |
# as 2nd arg.
|
| 338 |
if (length(other.args) > 0) {
|
338 |
if (length(other.args) > 0) {
|
| 339 |
argnames <- names(other.args)
|
339 |
argnames <- names(other.args)
|
| - |
|
340 |
|
| 340 |
if (is.call(other.args[[argnames[1]]]))
|
341 |
if (is.call(other.args[[argnames[1]]]))
|
| 341 |
other.args[[argnames[1]]] <- eval(other.args[[argnames[1]]])
|
342 |
other.args[[argnames[1]]] <- eval(other.args[[argnames[1]]])
|
| 342 |
if (length(other.args[[argnames[1]]]) > 1)
|
343 |
if (length(other.args[[argnames[1]]]) > 1)
|
| 343 |
stop(paste("non scalar", argnames[1], "is not supported"))
|
344 |
stop(paste("non scalar", argnames[1], "is not supported"))
|
| 344 |
if (is.null(other.args[[argnames[1]]]))
|
345 |
if (is.null(other.args[[argnames[1]]]))
|
| 345 |
stop(paste("NULL", argnames[1], "is not supported"))
|
346 |
stop(paste("NULL", argnames[1], "is not supported"))
|
| 346 |
}
|
347 |
}
|
| - |
|
348 |
|
| 347 |
ret <- .Call("sdf_do_variable_math", .Generic, x, other.args)
|
349 |
ret <- .Call("sdf_do_variable_math", .Generic, x, other.args)
|
| 348 |
if (is.character(ret)) { file.remove(ret); ret <- NULL }
|
350 |
if (is.character(ret)) { file.remove(ret); ret <- NULL }
|
| 349 |
ret;
|
351 |
ret;
|
| 350 |
}
|
352 |
}
|
| 351 |
|
353 |
|
The R Project SVN
R-packages