R: disjoint complex number when setting function body - r

While constructing a function I discovered, that complex numbers are disjoint when setting the function body:
funCplx <- function () {}
formals(funCplx) <- alist(t=)
body(funCplx) <- as.call(c(as.name("{"), parse(text = "t*(2+3i)")))
funCplx
funCplx(3)
As you can see, the function returns the correct value, but contains t * (2+(0+3i)). It is disjoint within the c(). The expression c(parse(text = "t*(2+3i)")) returns the disjoint term, whereas parse(text = "t*(2+3i)") returns t*(2+3i).
Why is the expression disjoint in the body?
Edit: I add an argument to the function. I removed it for sparseness, but it gets necessary to get the correct solution.
Edit 2: Most answers assume I know the complex number (here 2+3i). I took this example, because it is minimal.
In my real case, I take many complex numbers from variable matrices and put them together in one function with additional variables (here t) and functions like exp. In my first step I paste different parts and parse this text into the function body.
To point out my question: Is it bad that the complex number is disjoint in the parse function in case of calculation steps? Reworded: Does R need more calculation steps to calculate 5*(2+(0+3i)) than 5*(2+3i)?

Why not:
funCplx <- function () {}
formals(funCplx) <- alist()
body( funCplx) <- as.call(c(as.name("{"), eval(parse(text = "2+3i"))) )
funCplx
funCplx()
Returns:
funCplx
#----console displays---
function ()
{
2+3i
}
With the added request to include extra arguments in what appears when the function is print-ed, you could make it look more "finished" by assigning the fixed value to a name and then using that name in the expression:
funCplx <- function () {}
formals(funCplx) <- alist(t=)
environment(funCplx) <- new.env()
environment(funCplx)$cplx <- (2+3i)
body(funCplx) <- quote(t*cplx)
funCplx
# function (t)
# t * cplx
funCplx(3)
# [1] 6+9i
And testing to see if the earlier flimsy construction error was fixed:
> cplx=42
> funCplx(7)
[1] 14+21i
The earlier method didn't create an environment for funCplx and so its environment was .GlobalEnv. This version will carry 'cplx' around with it.

To create an expression that multiplies an argument by a given complex constant, use this:
funCplx <- function () {}
formals(funCplx) <- alist(t=)
body(funCplx) <- as.call(c(as.name("{"), call("*", as.symbol("t"), 2+3i)))
funCplx
funCplx(3)
Note that this avoids evaluation of 2 + (0+3i) at "run-time", since the constant is "hard-coded" in the function's body:
> body(funCplx)[[2]][[3]]
[1] 2+3i
> is(body(funCplx)[[2]][[3]])
[1] "complex" "vector"

Related

What is the difference between object and .Object in OOP in R?

I'm studying S4 classes and methods and I got confused to know when to use .Object and object (using as an argument to functions on classes). I don't understand if is there any difference between them.
For example, Would be correct:
setGeneric("getTimes",function(object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(object){
return(object#times)
}
)
or:
setGeneric("getTimes",function(.Object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(.Object){
return(.Object#times)
}
)
First, you should avoid the curly braces around {standardGeneric("getTimes")}.
The short answer for your question: there is no difference between the 2 code in your example. You were defining getTimes as a brand new generic function of your own. You can specify its arguments name whatever you like (object, x, xobject, .Object). Then, when you write the methods for the generic function, your methods' arguments name must match with the generic function's arguments name. For example:
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(object) object#times)
If not follow, there will be error (technically, a warning because R automatically/"silently" correct it. However, in my opinion, R should stop and throw an error in this case):
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(x) x#times)
# mismatch between `x` argument name in method and `object` argument name in generic
In the case you want to define methods for existing generic, you should use function method.skeleton.
Example 1:
setGeneric("getTimes", function(xobject) standardGeneric("getTimes")) # generic function is defined
getTimes # type function name without parentheses to get a summary of the generic
method.skeleton("getTimes", "Trajectories", stdout())
# copy this method skeleton to your script/source file and modify to your need
Example 2, show is a predefined generic with object as argument (see ?show) or you can type show without parentheses to check. Therefore, setMethod("show", "Trajectories", function(.Object) .Object) will be error. You can proceed using this approach, however, I think method.skeleton is a pretty useful alternative:
> method.skeleton("show", "Trajectories", stdout())
setMethod("show",
signature(object = "Trajectories"),
function (object)
{
stop("need a definition for the method here")
}
)
Example 3, initialize is a generic function and its argument .Object may be defined (type initialize without parentheses to check). From my understanding, the reason .Object is chosen as argument name in this case to invoke the feeling of a prototype object (you can read more at ?initialize). Similarly to Example 2, use the method.skeleton helper function:
> method.skeleton("initialize", "Trajectories", stdout())
setMethod("initialize",
signature(.Object = "Trajectories"),
function (.Object, ...)
{
stop("need a definition for the method here")
}
)
Note: there is a special case for replacement/assignment function (<-), that is its last argument must be named value. Read more. For example:
setClass("Trajectories", slots = c(times = "numeric"))
setGeneric("getTimes", function(x) standardGeneric("getTimes"))
setMethod("getTimes","Trajectories", function(x) x#times)
setGeneric("getTimes<-", function(xobject, value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, value) {
xobject#times <- value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42
getTimes(m)
R will not output any error or warning if you use other name (new_value in below) when defining the generic and accompanying methods. However, when you use it, R will error:
setGeneric("getTimes<-", function(xobject, new_value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, new_value) {
xobject#times <- new_value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42 # error because the right side of <- is always considered as `value` argument

How to pass a parameter name as an argument to a function

I understand this title may not make any sense. I searched everywhere but couldn't find an answer. What I'm trying to do is make a function that will take a parameter name for another function, a vector, and then keep calling that function with the parameter value equal to every item in the vector.
For simplicity's sake I'm not dealing with a vector below but just a single integer.
tuner <- function(param, a, ...) {
myfunction(param = a, ...)
}
and the code would effectively just run
myfunction(param = a)
I can't get this to work! The code actually runs but the resulting call completely ignores the parameter I put in and just runs
myfunction()
instead. Any solutions?
You can't really treat parameter names as variables that need to be evaluated in R. Onw work around would be to build a list of parameters and then pass that to do.call. For eample
myfunction <- function(x=1, y=5) {
x+y
}
tuner <- function(param, a, ...) {
do.call("myfunction", c(setNames(list(a), param), list(...)))
}
tuner("x", 100)
# [1] 105
tuner("y", 100)
# [1] 101
tuner("y", 100, 2)
# [1] 102
Another way using rlang would be
library(rlang)
tuner <- function(param, a, ...) {
args <- exprs(!!param := a, ...)
eval_tidy(expr(myfunction(!!!args)))
}
which would give the same results.

Create multiple functions/varying arguments in R using a list

I'm trying to create multiple functions with varying arguments.
Just some background: I need to compute functions describing 75 days respectively and multiply them later to create a Maximum-Likelihood function. They all have the same form, they only differ in some arguments. That's why I wanted to this via a loop.
I've tried to put all the equations in a list to have access to them later on.
The list this loop generates has 75 arguments, but they're all the same, as the [i] in the defined function is not taken into account by the loop, meanging that the M_b[i] (a vector with 75 arguments) does not vary.
Does someone know, why this is the case?
simplified equation used
for (i in 1:75){
log_likelihood[[i]] <-
list(function(e_b,mu_b){M_b[i]*log(e_b*mu_b))})
}
I couldn't find an answer to this in different questions. I'm sorry, if there's a similar thread already existing.
you need to force the evaluation of the variable M_b[i], see https://adv-r.hadley.nz/function-factories.html. Below I try and make it work
func = function(i){
i = force(i)
f = function(e_b,mu_b){i*log(e_b*mu_b) }
return(f)
}
# test
func(9)(7,3) == 9*log(7*3)
#some simulated values for M_b
M_b = runif(75)
log_likelihood = vector("list",75)
for (idx in 1:75){
log_likelihood[[idx]] <- func(M_b[idx])
}
# we test it on say e_b=5, mu_b=6
test = sapply(log_likelihood,function(i)i(5,6))
actual = sapply(M_b,function(i)i*log(5*6))
identical(test,actual)
[1] TRUE
This is called lazy evaluation, where R doesn't evaluate an expression when it is not used. As correctly pointed about by #SDS0, the value you get is at i=75. We try it with your original function:
func = function(i){function(e_b,mu_b){i*log(e_b*mu_b) }}
M_b = 1:3
log_likelihood = vector("list",3)
for (idx in 1:3){
log_likelihood[[idx]] = func(M_b[idx])
}
sapply(log_likelihood,function(f)f(5,6))
[1] 10.20359 10.20359 10.20359
#you get 10.20359 which is M_b[3]*log(5*6)
There is one last option, which I just learned of, which is to do lapply which no longer does lazy evaluation:
func = function(i){function(e_b,mu_b){i*log(e_b*mu_b) }}
log_likelihood = lapply(1:3,function(idx)func(M_b[idx]))
sapply(log_likelihood,function(f)f(5,6))
[1] 3.401197 6.802395 10.203592

getting the arguments of a parent function in R, with names

I'm trying to write a function that captures the arguments of the function it is called from. For example,
get_args <- function () as.list( sys.call(sys.parent()) )[-1]
caller <- function (x, y, z) {
get_args()
}
caller(1,2,3)
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
sys.call() unfortunately does not add match parameter names with argument values, and I'd like to write a similar version of get_args that returns output similar to
caller2 <- function (x, y, z) {
as.list( match.call() )[-1]
}
caller2(1,2,3)
$x
[1] 1
$y
[1] 2
$z
[1] 3
replacing "get_args()" with "match.call()" directly is not the solution I'm looking for, since in reality get_args will do some other things before returning its parent functions arguments.
I've tried to use match.call() with sys.parent() in several ways, but I can't get the function to return the arguments of caller; it just returns the arguments of get_args().
Is there any way to make get_args() return output identical to that of caller2 for the above test case? I know that naming the arguments manually is possible using formals(), but is this guaranteed to be equivelant?
If any clarification is needed, leave a comment below. Thanks.
EDIT 1:
the aim of get_args() is to act as a user-friendly way of getting the arguments with which a function was called. Typing as.list( match.call() )[-1] gets old, but because match.call grabs the nearest function call it just gets the arguments of get_args() at the moment.
get_args() will also get default arguments from the parent function, but this easy to implement.
SOLUTION:
thanks Hong Ooi, the key to using match.call seems to be providing both the call and the definition of the function you want to find out about. A slightly modified, anonymous-friendly version of get_args is below for posterity
get_args <- function () {
as.list( match.call(
def = sys.function( -1 ),
call = sys.call(-1)) )[-1]
}
This version finds the function further up the call stack, grabs its definition and call, and matches parameters to its arguments.
get_args <- function()
{
cl <- sys.call(-1)
f <- get(as.character(cl[[1]]), mode="function", sys.frame(-2))
cl <- match.call(definition=f, call=cl)
as.list(cl)[-1]
}
The key here is to set the definition argument to match.call to be get_arg's calling function. This should (hopefully!) work for the general case where get_args can be called from anywhere.

Finding the names of all functions in an R expression

I'm trying to find the names of all the functions used in an arbitrary legal R expression, but I can't find a function that will flag the below example as a function instead of a name.
test <- expression(
this_is_a_function <- function(var1, var2){
this_is_a_function(var1-1, var2)
})
all.vars(test, functions = FALSE)
[1] "this_is_a_function" "var1" "var2"
all.vars(expr, functions = FALSE) seems to return functions declarations (f <- function(){}) in the expression, while filtering out function calls ('+'(1,2), ...).
Is there any function - in the core libraries or elsewhere - that will flag 'this_is_a_function' as a function, not a name? It needs to work on arbitrary expressions, that are syntactically legal but might not evaluate correctly (e.g '+'(1, 'duck'))
I've found similar questions, but they don't seem to contain the solution.
If clarification is needed, leave a comment below. I'm using the parser package to parse the expressions.
Edit: #Hadley
I have expressions with contain entire scripts, which usually consist of a main function containing nested function definitions, with a call to the main function at the end of the script.
Functions are all defined inside the expressions, and I don't mind if I have to include '<-' and '{', since I can easy filter them out myself.
The motivation is to take all my R scripts and gather basic statistics about how my use of functions has changed over time.
Edit: Current Solution
A Regex-based approach grabs the function definitions, combined with the method in James' comment to grab function calls. Usually works, since I never use right-hand assignment.
function_usage <- function(code_string){
# takes a script, extracts function definitions
require(stringr)
code_string <- str_replace(code_string, 'expression\\(', '')
equal_assign <- '.+[ \n]+<-[ \n]+function'
arrow_assign <- '.+[ \n]+=[ \n]+function'
function_names <- sapply(
strsplit(
str_match(code_string, equal_assign), split = '[ \n]+<-'),
function(x) x[1])
function_names <- c(function_names, sapply(
strsplit(
str_match(code_string, arrow_assign), split = '[ \n]+='),
function(x) x[1]))
return(table(function_names))
}
Short answer: is.function checks whether a variable actually holds a function. This does not work on (unevaluated) calls because they are calls. You also need to take care of masking:
mean <- mean (x)
Longer answer:
IMHO there is a big difference between the two occurences of this_is_a_function.
In the first case you'll assign a function to the variable with name this_is_a_function once you evaluate the expression. The difference is the same difference as between 2+2 and 4.
However, just finding <- function () does not guarantee that the result is a function:
f <- function (x) {x + 1} (2)
The second occurrence is syntactically a function call. You can determine from the expression that a variable called this_is_a_function which holds a function needs to exist in order for the call to evaluate properly. BUT: you don't know whether it exists from that statement alone. however, you can check whether such a variable exists, and whether it is a function.
The fact that functions are stored in variables like other types of data, too, means that in the first case you can know that the result of function () will be function and from that conclude that immediately after this expression is evaluated, the variable with name this_is_a_function will hold a function.
However, R is full of names and functions: "->" is the name of the assignment function (a variable holding the assignment function) ...
After evaluating the expression, you can verify this by is.function (this_is_a_function).
However, this is by no means the only expression that returns a function: Think of
f <- function () {g <- function (){}}
> body (f)[[2]][[3]]
function() {
}
> class (body (f)[[2]][[3]])
[1] "call"
> class (eval (body (f)[[2]][[3]]))
[1] "function"
all.vars(expr, functions = FALSE) seems to return functions declarations (f <- function(){}) in the expression, while filtering out function calls ('+'(1,2), ...).
I'd say it is the other way round: in that expression f is the variable (name) which will be asssigned the function (once the call is evaluated). + (1, 2) evaluates to a numeric. Unless you keep it from doing so.
e <- expression (1 + 2)
> e <- expression (1 + 2)
> e [[1]]
1 + 2
> e [[1]][[1]]
`+`
> class (e [[1]][[1]])
[1] "name"
> eval (e [[1]][[1]])
function (e1, e2) .Primitive("+")
> class (eval (e [[1]][[1]]))
[1] "function"
Instead of looking for function definitions, which is going to be effectively impossible to do correctly without actually evaluating the functions, it will be easier to look for function calls.
The following function recursively spiders the expression/call tree returning the names of all objects that are called like a function:
find_calls <- function(x) {
# Base case
if (!is.recursive(x)) return()
recurse <- function(x) {
sort(unique(as.character(unlist(lapply(x, find_calls)))))
}
if (is.call(x)) {
f_name <- as.character(x[[1]])
c(f_name, recurse(x[-1]))
} else {
recurse(x)
}
}
It works as expected for a simple test case:
x <- expression({
f(3, g())
h <- function(x, y) {
i()
j()
k(l())
}
})
find_calls(x)
# [1] "{" "<-" "f" "function" "g" "i" "j"
# [8] "k" "l"
Just to follow up here as I have also been dealing with this problem: I have now created a C-level function to do this using code very similar to the C implementation of all.names and all.vars in base R. It however only works with objects of type "language" i.e. function calls, not type "expression". Demonstration:
ex = quote(sum(x) + mean(y) / z)
all.names(ex)
#> [1] "+" "sum" "x" "/" "mean" "y" "z"
all.vars(ex)
#> [1] "x" "y" "z"
collapse::all_funs(ex)
#> [1] "+" "sum" "/" "mean"
Created on 2022-08-17 by the reprex package (v2.0.1)
This generalizes to arbitrarily complex nested calls.

Resources