I have a vector of fish weight. I have written a function to check on the weight of the fish in the vector. If the weight is above 20, then update y (i.e., fish count) and z (i.e., fish total lbs). Below is the code:
function(x, y, z) {
for (fish in 1:x) {
if (x >= 20) {
y <- y + 1
z <- z + 1
return (y, z)
}
}
}
When I call the function with
funcy_fish(BF_caught, BF_kept_ct, BF_kept_lbs)
I get multiple error messages but no optimal return; I want the variables to be updated with the fish count kept and the total lbs of fish kept. The error messages:
funcy_fish(BF_caught, BF_kept_ct, BF_kept_lbs)
[1] 1
Warning messages:
1: In 1:x : numerical expression has 4 elements: only the first used
2: In if (x >= 20) { :
the condition has length > 1 and only the first element will be used
Please advise.
UPDATE
I have updated the function, and got the right output. But now, the variables I passed to the function are not updated:
> # function to determine which fish from caught var to keep
> funcy_fish <- function(x, y, z) {
+ y <- y + (sum(x > 20))
+ z <- z + (x %>% sum())
+ return (c(y, z))
+ # return (z)
+ }
> funcy_fish(BF_caught, BF_kept_ct, BF_kept_lbs)
[1] 4.0000 190.8728
The output is right, but BF_kept_ct and BF_kept_lbs are not updated in the global scope.
Return a named list from the function -
funcy_fish <- function(x, y, z) {
y <- y + (sum(x > 20))
z <- z + (x %>% sum())
return(list(BF_kept_ct = y, BF_kept_lbs = z))
}
res <- funcy_fish(BF_caught, BF_kept_ct, BF_kept_lbs)
If you want to update original BF_kept_ct and BF_kept_lbs variable use list2env.
list2env(res, .GlobalEnv)
Related
I'm writing a function that contains some conditions. The returning value of the function will depend on such a condition in a way that the returning value might not even exist within the function based on the condition. In that case, I'd expect the function to throw an error. However, this only works as long as the supposed-to-return value does not also exist in the global environment. If it does, the value from the global environment is returned, which I find confusing.
What am I missing here? What am I doing wrong?
Example:
xyz <- function(x = NULL, y = NULL)
{
if (x+y > 10) {z <- x + y}
return(z)
}
If I now run test <- xyz(20, 30) I get the correct result (test = 50).
If I run test <- xyz(2, 3) I also correctly get an error:
Error in xyz(2, 3) : object 'z' not found
However, now I'm creating a z value in the global environment.
z <- 3.14
When I'm now running my function test <- xyz(2, 3) I get 3.14 as the result.
I was expecting that the function will only return the value of z if it exists inside the function. How can I do that?
Thanks
If a free variable (one referred to but not defined) in a function is accessed then it looks in the environment where the function was defined and then in the parent environment of that and so on.
Use get("z", inherits = FALSE) to look for z only in the current environment or check whether it exists exists("z", inherits = FALSE) in the current environment only.
Another possibility is to always give z a value:
z <- if (length(x) && length(y) && x + y > 10) x + y
In that case z will have the value NULL if the condition is false because the default else leg is NULL. Returning NULL invisibly would be about as close as you can get to not returning a value.
xyz2 <- function(x = NULL, y = NULL) {
z <- if (length(x) && length(y) && x + y > 10) x + y
# other processing can go here
if (is.null(z)) invisible(z) else z
}
xyz2(1, 2)
xyz2(5, 9)
## [1] 14
Why not just throw an informative error, based on the condition rather than z?
xyz <- function(x = NULL, y = NULL)
{
if ( x + y <= 10 ) {
stop("The sum of x and y must be greater than 10.")
}
return(x + y)
}
xyz(20, 30)
# [1] 50
xyz(2, 3)
# Error in xyz(2, 3) : The sum of x and y must be greater than 10.
I like duckmayr's idea, but here's how you can implement while still using z:
xyz <- function(x = NULL, y = NULL) {
z = x + y
if (z <= 10 ) {
stop("The sum of x and y must be greater than 10.")
}
return(z)
}
Assume I have a function which uses a loop over integer i. Now something goes wrong and I assume the error happens when i=5. Now I can step through every single step (what I did up to now).
But now I read about the condition and text argument of browser and debug:
text a text string that can be retrieved when the browser is
entered.
condition a condition that can be retrieved when the browser
is entered.
Is it possible to use the arguments in a way it works as I want?
Here is an example. The debugger / browser should only start after i=5 is reached:
fun <- function(x, y, n) {
result <- 0
for (i in 1:n) {
# browser(condition = (i == 5)) # does not work
result <- result + i * ( x + y)
}
return(result)
}
x <- 2
y <- 3
n <- 10
# debug(fun, condition = (i == 5)) # does not work
debug(fun)
r <- fun(x, y, n)
print(r)
The solution
if (i == 5) { # inside loop of fun()
browser()
}
is working, but I thougt there might be something better (No extra code inside the function)
You can use the argument expr in browser():
fun <- function(x, y, n) {
result <- 0
for (i in 1:n) {
browser(expr = {i == 5})
result <- result + i * ( x + y)
}
return(result)
}
It will then only open the environment where browser() was called from if the expression evaluates to TRUE.
If you want to use debug():
debug(fun, condition = i == 5)
and then call the function:
fun <- function(x, y, n) {
result <- 0
for (i in 1:n) {
result <- result + i * ( x + y)
}
return(result)
}
fun(x, y, n)
Use advanced features of trace().
First, identify the line of your function to debug, following the help page instructions for the argument at =, leading to at = list(c(3, 4))
> as.list(body(fun))
[[1]]
`{`
[[2]]
result <- 0
[[3]]
for (i in 1:n) {
result <- result + i * (x + y)
}
[[4]]
return(result)
> as.list(body(fun)[[3]])
[[1]]
`for`
[[2]]
i
[[3]]
1:n
[[4]]
{
result <- result + i * (x + y)
}
Next, specify a conditional break point by providing as the tracer= argument an unevaluated expression that invokes the browser when a specific condition is met, tracer = quote(if (i == 3) browser())
So
> trace(fun, tracer = quote(if (i == 3) browser()), at=list(c(3, 4)), print=FALSE)
[1] "fun"
> r <- fun(x, y, n)
Called from: eval(expr, p)
Browse[1]>
debug: {
result <- result + i * (x + y)
}
Browse[2]> i
[1] 3
Browse[2]> result
[1] 15
Browse[2]>
I'm trying to adjust the names of an argument inside a function. I want to create a procedure that takes the body of a function, looks for x, changes every x into x0, and then restores the function to what it was before. To provide an example:
f = function(x, y) -x^2 + x + -y^2 + y
# Take old names
form_old = names(formals(f))
# Make new names
form_new = paste0(form_old, 0)
# Give f new formals
formals(f) = setNames(vector("list", length(form_new)), form_new)
# Copy function body
bod = as.list(body(f))
for (i in 1:length(form_new)) {
bod = gsub(form_old[i], form_new[i], bod)
}
# return from list to call ?
body(f) = as.call(list(bod))
f(1, 1) # produces an error
So far, this code will change all variable names from x to x0 and from y to y0. However, the final output of bod is a character vector and not a call. How can I now change this back to a call?
Thanks in advance!
Surely there is a better way to do what you are trying to do that doesn't require modifying functions. That being said, you definetly don't want to be replacing variables by regular expressions, that could have all sorts of problems. Generally, trying to manipulate code as strings is going to lead to problems, for example, a function like tricky <- function(x, y) { tst <- "x + y"; -xx*x + yy*y }, where there are strings and variable names overlap, will lead to the wrong results.
Here is a function that takes a recursive approach (Recall) to traverse the expression tree (recursion could be avoided using a 'stack' type structure, but it seems more difficult to me).
## Function to replace variables in function body
## expr is `body(f)`, keyvals is a lookup table for replacements
rep_vars <- function(expr, keyvals) {
if (!length(expr)) return()
for (i in seq_along(expr)) {
if (is.call(expr[[i]])) expr[[i]][-1L] <- Recall(expr[[i]][-1L], keyvals)
if (is.name(expr[[i]]) && deparse(expr[[i]]) %in% names(keyvals))
expr[[i]] <- as.name(keyvals[[deparse(expr[[i]])]])
}
return( expr )
}
## Test it
f <- function(x, y) -x^2 + x + -y^2 + y
newvals <- c('x'='x0', 'y'='y0') # named lookup vector
newbod <- rep_vars(body(f), newvals)
newbod
# -x0^2 + x0 + -y0^2 + y0
## Rename the formals, and update the body
formals(f) <- pairlist(x0=bquote(), y0=bquote())
body(f) <- newbod
## The new 'f'
f
# function (x0, y0)
# -x0^2 + x0 + -y0^2 + y0
f(2, 2)
# [1] -4
With a more difficult function, where you want to avoid modifying strings or the other variables named yy and xx for example,
tricky <- function(x, y) { tst <- "x + y"; -xx*x + yy*y }
formals(tricky) <- pairlist(x0=bquote(), y0=bquote())
body(tricky) <- rep_vars(body(tricky), newvals)
tricky
# function (x0, y0)
# {
# tst <- "x + y"
# -xx * x0 + yy * y0
# }
#
There are a few ways to go here. Following your code, I would go with something like this:
f = function(x, y) -x^2 + x + -y^2 + y
# Take old names
form_old = names(formals(f))
# Make new names
form_new = paste0(form_old, 0)
deparse(body(f)) -> bod
for (i in 1:length(form_new)) {
bod = gsub(form_old[i], form_new[i], bod, fixed = TRUE)
}
formals(f) = setNames(vector("list", length(form_new)), form_new)
body(f) <- parse(text = bod)
f(1, 1)
I am very new to R. I am trying to create a function where the user is able to input expressions into arguments. These inputs are then used in plot3d through the rgl package. The function I have so far is :
flight_sim <- function(xval, yval, zval)
{
# Evaluate arguments and convert them into expressions
eval(parse(text = zval))
z <- data.frame(zval)
eval(parse(text = xval))
x <- data.frame(xval)
eval(parse(text = yval))
y <- data.frame(yval)
flight_path <- as.data.frame(cbind(x,y,z))
}
I have a readline() and switch() command :
cat('Select the flight path you wish to plot from the list below :
1. Helix
2. Conical
3. Spherical
4. Define your own flight path...')
userplot <- readline('Enter number here : ') # Allow user to enter choice from above
switch(userplot,"1"=flight_sim( sin(z), 1-cos(z), seq(0,20, pi/32) ),
"2"=flight_sim( z*cos(6*z), z*sin(6*z), seq(0,10, pi/64) ),
"3"=flight_sim( sin(z)*cos(20*z), sin(z)*sin(20*z), seq(0,pi,pi/399)),
"4"=custom())
Where custom() just prompts the user via readline() to enter x, y and z values, which is then followed by eval() and parse() and it works fine.
The problem I've been having is that x and y need to be functions of z, and this causes an error :
Error in parse(text = xval) : object 'z' not found
I thought by making the flight_sim function evaluate the zval argument first that it would fix it, however as I'm new to R I'm just getting more and more lost.
I hope what I have explained here makes some sense. I appreciate any help that can be provided.
Nothing is being passed as text in your example so using parse() doesn't seem necessary. If you want to delay evaulation, the best way would be to use substitute to grab the parameters as promises and then evaluate them in the context of your fliht_sim function. Here's what that would look like
flight_sim <- function(xval, yval, zval) {
z <- eval(substitute(zval))
x <- eval(substitute(xval))
y <- eval(substitute(yval))
data.frame(x,y,z)
}
userplot="2"
x <- switch(userplot,"1"=flight_sim( sin(z), 1-cos(z), seq(0,20, pi/32) ),
"2"=flight_sim( z*cos(6*z), z*sin(6*z), seq(0,10, pi/64) ),
"3"=flight_sim( sin(z)*cos(20*z), sin(z)*sin(20*z), seq(0,pi,pi/399)),
"4"=custom())
head(x)
# x y z
# 1 0.00000000 0.00000000 0.00000000
# 2 0.04697370 0.01424932 0.04908739
# 3 0.08162934 0.05454298 0.09817477
# 4 0.09342212 0.11383519 0.14726216
# 5 0.07513972 0.18140332 0.19634954
# 6 0.02405703 0.24425508 0.24543693
If I'm interpreting your question correctly, it seems like you'd need to redefine your function. To the best of my knowledge, you can't define an argument in the function definition as a function of another argument. You'd need to do that inside the body of the function. So you'd want something like this:
flight_sim <- function(userplot) {
if (userplot == "1") {
z <- seq(0, 20, pi / 32)
x <- sin(z)
y <- 1 - cos(z)
} else if (userplot == "2") {
z <- seq(0, 10, pi / 64)
x <- z * cos(6 * z)
y <- z * sin(6 * z)
} else if (userplot == "3") {
z <- seq(0, pi, pi / 399)
x <- sin(z) * cos(20 * z)
y <- sin(z) * sin(20 * z)
} else if (userplot == "4") {
x <- readline("Please enter a function for the x-value: ")
y <- readline("Please enter a function for the y-value: ")
z <- readline("Please enter a function for the z-value: ")
eval(parse(text = z)) # have to evaluate z first since x and y are functions of z
eval(parse(text = x))
eval(parse(text = y))
} else {
valid_response <- FALSE
while (!valid_response) {
userplot <- readline("Please enter a valid response (1-4): ")
if (userplot %in% 1:4) {
valid_response <- TRUE
flight_sim(userplot)
}
}
}
dat <- data.frame(x, y, z)
return(dat)
}
cat('Select the flight path you wish to plot from the list below :
1. Helix
2. Conical
3. Spherical
4. Define your own flight path...')
userplot <- readline('Enter number here : ') # Allow user to enter choice from above
dat <- flight_sim(userplot)
head(dat)
x y z
1 0.000000000000000000 0.000000000000000000 0.000000000000000000
2 0.046973698885313400 0.014249315773629733 0.049087385212340517
3 0.081629338302900922 0.054542980081485989 0.098174770424681035
4 0.093422122547587999 0.113835185692147969 0.147262155637021552
5 0.075139716235543288 0.181403322008714424 0.196349540849362070
6 0.024057025623845932 0.244255080177979672 0.245436926061702587
In the code above, I've also included one last else statement to catch inappropriate responses from your users. If they enter a choice that could break your code, it will now catch that and ask them to reenter their response.
I can't seem to make apply function access/modify a variable that is declared outside... what gives?
x = data.frame(age=c(11,12,13), weight=c(100,105,110))
x
testme <- function(df) {
i <- 0
apply(df, 1, function(x) {
age <- x[1]
weight <- x[2]
cat(sprintf("age=%d, weight=%d\n", age, weight))
i <- i+1 #this could not access the i variable in outer scope
z <- z+1 #this could not access the global variable
})
cat(sprintf("i=%d\n", i))
i
}
z <- 0
y <- testme(x)
cat(sprintf("y=%d, z=%d\n", y, z))
Results:
age=11, weight=100
age=12, weight=105
age=13, weight=110
i=0
y=0, z=0
Using the <<- operator you can write to variables in outer scopes:
x = data.frame(age=c(11,12,13), weight=c(100,105,110))
x
testme <- function(df) {
i <- 0
apply(df, 1, function(x) {
age <- x[1]
weight <- x[2]
cat(sprintf("age=%d, weight=%d\n", age, weight))
i <<- i+1 #this could not access the i variable in outer scope
z <<- z+1 #this could not access the global variable
})
cat(sprintf("i=%d\n", i))
i
}
z <- 0
y <- testme(x)
cat(sprintf("y=%d, z=%d\n", y, z))
The result here:
age=11, weight=100
age=12, weight=105
age=13, weight=110
i=3
y=3, z=3
Note that the usage of <<- is dangerous, as you break up scoping. Do this only if really necessary and if you do, document that behavior clearly (at least in bigger scripts)
try the following inside your apply. Experiment with the value of n. I believe that for i it should be one less than for z.
assign("i", i+1, envir=parent.frame(n=2))
assign("z", z+1, envir=parent.frame(n=3))
testme <- function(df) {
i <- 0
apply(df, 1, function(x) {
age <- x[1]
weight <- x[2]
cat(sprintf("age=%d, weight=%d\n", age, weight))
## ADDED THESE LINES
assign("i", i+1, envir=parent.frame(2))
assign("z", z+1, envir=parent.frame(3))
})
cat(sprintf("i=%d\n", i))
i
}
OUTPUT
> z <- 0
> y <- testme(x)
age=11, weight=100
age=12, weight=105
age=13, weight=110
i=3
> cat(sprintf("y=%d, z=%d\n", y, z))
y=3, z=3