I have a code in which I want to be able to specify a certain condition, and then fill-in this condition at a later point in my code, executing it as regular code. A simple example shows it. The following code returns a certain value for d depending on the values sampled for a and b.
a <- as.numeric(sample(1:2,1))
b <- as.numeric(sample(1:2,1))
d <- ifelse(a==1 & b==1,3,0)
But let's say I want to make it more flexible, and allow any condition to be specified, and then simply fill it in within the ifelse. So for example we could have:
a <- as.numeric(sample(1:2,1))
b <- as.numeric(sample(1:2,1))
c <- as.numeric(sample(1:2,1))
And I would like to specify two conditions:
condition_1 <- "a==1"
condition_2 <- "b==1"
or
condition_1 <- "a==1"
condition_2 <- "c==1"
and so on. Then I would like to fill in this conditions into ifelse. This does not work:
d <- ifelse(noquote(condition_1) & noquote(condition_1),3,0)
This also does not work:
d <- ifelse(paste(noquote(condition_1)) & paste(noquote(condition_1)),3,0)
I have tried anything I could think of but with no success. Is there a way to do this? More in general, how can I store parts of code, and then past them into the code at a later point and have it executed like the rest of the code?
Please do not provide workarounds that only work for this specific example. I need to do something analogous in a much more complex code.
"Storing parts of code [for later use]" sounds to me like using functions. You can pass functions as arguments to other functions. So you could do something like:
dFunc1 <- function(aVal, bVal) {
ifelse(a == aVal & b == bVal, 3, 0)
}
set.seed(1234)
a <- as.numeric(sample(1:2,1))
b <- as.numeric(sample(1:2,1))
d <- dFunc1(1, 1)
a
b
d
> a
[1] 2
> b
[1] 2
> d
[1] 0
and then
set.seed(1234)
dFunc2 <- function(aVal, cVal) {
ifelse(a == aVal & c == cVal, 3, 0)
}
c <- as.numeric(sample(1:2,1))
d <- dFunc2(1, 1)
c
d
> c
[1] 2
> d
[1] 0
If your derivations are embedded in another function, that's not a problem.
doItAll <- function(f, ...) {
set.seed(1234)
a <- as.numeric(sample(1:2,1))
b <- as.numeric(sample(1:2,1))
c <- as.numeric(sample(1:2,1))
d <- f(...)
return(list("a"=a, "b"=b, "c"=c, "d"=d))
}
doItAll(dFunc1, aVal=1, bVal=1)
$a
[1] 2
$b
[1] 2
$c
[1] 2
$d
[1] 0
and
doItAll(dFunc2, aVal=1, cVal=1)
$a
[1] 2
$b
[1] 2
$c
[1] 2
$d
[1] 0
The use of the elipsis (...) is key to the ability of passing arbitrary arguments to functions that are called from inside another function.
In the end I decided to solve this with a set of if and else if conditions. It seemed more practical than setting up a function as suggested by Limey.
I am writing a R equivalent to Pythons 'pop' method. I know 99th percentile has one but I'd prefer my own (practice/understanding/consistency etc).
For reference, pop() takes an object and removes the first item from the object whilt also returning it. So
> l <- c(1,3,5)
> x <- pop(l)
> print(l)
> 3, 5
> print(x)
> 1
I am using assign() to replace the input object with one less the first value and returning said first value from the function.
My question is, how do I get the environment of the input object and use this environment within assign()?
I have tried using pryr::where() which returns 'R_GlobalEnv' but I can't use this value in assign(). Instead the only value I can get to work in assign() is 'globalenv()'.
Posted from mobile so let me know if something doesn't work.
You can implement this in base R, though it's not advised. R is a functional language and functions with side effects are not expected by end-users.
pop <- function(vec)
{
vec_name <- deparse(substitute(vec))
assign(vec_name, vec[-1], envir = parent.frame())
vec[1]
}
a <- c(2, 7, 9)
a
#> [1] 2 7 9
pop(a)
#> [1] 2
a
#> [1] 7 9
pop(a)
#> [1] 7
a
#> [1] 9
Created on 2020-08-15 by the reprex package (v0.3.0)
The following answer is based in this R-Help post, function pop with function getEnvOf from this SO post, both adapted to the question's problem.
getEnvOf <- function(what, which=rev(sys.parents())) {
what <- as.character(substitute(what))
for (frame in which)
if (exists(what, frame=frame, inherits=FALSE))
return(sys.frame(frame))
return(NULL)
}
pop <- function(x){
y <- as.character(substitute(x))
e <- getEnvOf(y)
if(length(x) > 0) {
val <- x[[length(x)]]
assign(y, x[-length(x)], envir = parent.env(e))
val
} else {
msg <- paste(sQuote(y), "length is not > 0")
warning(msg)
NULL
}
}
y <- c(1,3,5)
pop(y)
This also works with lists.
z <- list(1, 2, 5)
pop(z)
w <- list(1, c(2, 4, 6), 5)
pop(w)
#[1] 5
pop(w)
#[1] 2 4 6
pop(w)
#[1] 1
pop(w)
#NULL
#Warning message:
#In pop(w) : ‘w’ length is not > 0
You can do it using pryr::promise_info(l)$env, but it's a very un-R-like thing to do. Functions shouldn't have side effects.
For example,
pop <- function(l) {
info <- pryr::promise_info(l)
if (!is.name(info$code))
stop("Argument expression should be a name.")
result <- l[[1]] # work on lists too
assign(as.character(info$code), l[-1], envir = info$env)
result
}
l <- c(1, 3, 5)
pop(l)
#> Registered S3 method overwritten by 'pryr':
#> method from
#> print.bytes Rcpp
#> [1] 1
l
#> [1] 3 5
Created on 2020-08-15 by the reprex package (v0.3.0)
Edited to add: Interestingly, none of the three answers so far works in complicated situations like this one:
f <- function(x) {
cat("The pop(x) result is", pop(x), "\n")
cat("Now x is ", x, "\n")
cat("Now l is ", l, "\n")
}
l <- c(1, 3, 5)
f(l)
#RuiBarradas's answer gives
The pop(x) result is 5
Now x is 1 3 5
Now l is 1 3 5
(He pops the last value rather than the first which is not a big deal, but neither x nor l is modified.)
#AllanCameron's answer gives
The pop(x) result is 1
Now x is 3 5
Now l is 1 3 5
This is arguably correct (x got popped), but I think it would be nice to have l being popped, and that seems tricky.
My answer dies with this message:
Error in pop(x) : Argument expression should be a name.
which seems like a bug: obviously whether it's getting x or l, it really is a name. The problem seems to be in pryr::promise_info, which returns the compiled code that would return the value of x, rather than just the code for x. If I turn off JIT compiling by compiler::enableJIT(0), I get the same result as #AllanCameron. It's not clear to me how to unwind back the right amount to pop l instead of just x.
m <- matrix(1:4, ncol=2)
l <- list(a=1:3, b='c')
d <- data.frame(a=1:3, b=3:1)
I was wondering if it is possible to make a function that takes a base R object (matrix, vector, list or data.frame, ...) as well as a text that specifies the subset of the object.
f1 <- function(object, subset) {
# object'subset'
}
For instance
f1(m, '[1,1]') #to evaluate m[1,1]
f1(l, '[[1]][2:3]') #l[[1]][2:3]
f1(d, '$a') #d$a
would give us (respectively):
[1] 1
[1] 2 3
[1] 1 2 3
I guess the function need somehow to glue the two arguments before evaluating. I guess one could make a kind of interpreter for each bit of the subset text and the (for the matrix example) do something like:
`[`(1,1)
This would possible but I thought there would be an easier more direct way (my 'glue' above).
Well one way to go is to use eval(parse)) methodology, i.e.
f1 <- function(x, text){
eval(parse(text = paste0(x, text)))
}
f1('d', '$a')
#[1] 1 2 3
f1('m', '[1,1]')
#[1] 1
f1('l', '[[1]][2:3]')
#[1] 2 3
f1<-function(object, subset){
return(eval(parse(text=paste0(substitute(object),subset))))
}
> m=matrix(4,2,2)
> l=list(c(1,2,3),c(2,3,4))
> f1(m,'[1,1]')
[1] 4
> f1(l,'[[1]][1:2]')
[1] 1 2
Is it possible for me to create a R function that the output will not show every objects inside but you can call the object(s) inside it using $ or [], like the one below
abc <- function(a=1, b=2, c=3) {...}
#by default, abc() only the value of a will be shown but not b neither c
abc()
[1] 1
abc()$a
[1] 1
abc()["b"]
[1] 2
abc()$c
[1] 3
Thanks.
If you want to return all values but only by default display certain ones, i think you best course of action would be to give the return object a custom class. One strategy is to just a list and give a custom print method for that list.
print.myvalues <- function(x) {
print(x$a)
}
abc <- function(a=1, b=2, c=3) {
ret <- list(a=a, b=b,c=c)
class(ret)<-"myvalues"
ret
}
(x<-abc(10,20,30))
# [1] 10
x
# [1] 10
x$b
# [1] 20
x[["c"]]
# [1] 30
But this might confuse the user when they go to use the number in any way because it's not really just a number
x+5
# Error in x + 5 : non-numeric argument to binary operator
A slightly more complex strategy would be to store the additional values as attributes and overload the $ and [ methods in such a fashion
`$.myvalues` <- function(x, n) {
x[n]
}
`[.myvalues` <- function(x, n) {
if(n=="a") return(`attributes<-`(x,NULL))
attr(x, n)
}
print.myvalues <- function(x) {
attributes(x)<-NULL
print(x)
}
abc <- function(a=1, b=2, c=3) {
ret <- a
attr(ret, "b") <- b
attr(ret, "c") <- c
class(ret)<-"myvalues"
ret
}
and use it like
(x<-abc(10,20,30))
# [1] 10
x
# [1] 10
x$b
# [1] 20
x["c"]
# [1] 30
x+5
# [1] 15
Here we preserve addition, of course nothing in particular happens to the b and c values. We could also overload the + operator if we wanted to carry the addition through the attributes. It all depends on how complex you want to make it.
> abc <- function(a=1, b=2, c=3) { cat(a); invisible(list(a=a,b=b,c=c))}
> abc()
1
> abc()$c
1[1] 3
> abc()$a
1[1] 1
> abc <- function(a=1, b=2, c=3) { print(a); invisible(list(a=a,b=b,c=c))}
> abc()$a
[1] 1
[1] 1
I want to assign multiple variables in a single line in R. Is it possible to do something like this?
values # initialize some vector of values
(a, b) = values[c(2,4)] # assign a and b to values at 2 and 4 indices of 'values'
Typically I want to assign about 5-6 variables in a single line, instead of having multiple lines. Is there an alternative?
I put together an R package zeallot to tackle this very problem. zeallot includes an operator (%<-%) for unpacking, multiple, and destructuring assignment. The LHS of the assignment expression is built using calls to c(). The RHS of the assignment expression may be any expression which returns or is a vector, list, nested list, data frame, character string, date object, or custom objects (assuming there is a destructure implementation).
Here is the initial question reworked using zeallot (latest version, 0.0.5).
library(zeallot)
values <- c(1, 2, 3, 4) # initialize a vector of values
c(a, b) %<-% values[c(2, 4)] # assign `a` and `b`
a
#[1] 2
b
#[1] 4
For more examples and information one can check out the package vignette.
There is a great answer on the Struggling Through Problems Blog
This is taken from there, with very minor modifications.
USING THE FOLLOWING THREE FUNCTIONS
(Plus one for allowing for lists of different sizes)
# Generic form
'%=%' = function(l, r, ...) UseMethod('%=%')
# Binary Operator
'%=%.lbunch' = function(l, r, ...) {
Envir = as.environment(-1)
if (length(r) > length(l))
warning("RHS has more args than LHS. Only first", length(l), "used.")
if (length(l) > length(r)) {
warning("LHS has more args than RHS. RHS will be repeated.")
r <- extendToMatch(r, l)
}
for (II in 1:length(l)) {
do.call('<-', list(l[[II]], r[[II]]), envir=Envir)
}
}
# Used if LHS is larger than RHS
extendToMatch <- function(source, destin) {
s <- length(source)
d <- length(destin)
# Assume that destin is a length when it is a single number and source is not
if(d==1 && s>1 && !is.null(as.numeric(destin)))
d <- destin
dif <- d - s
if (dif > 0) {
source <- rep(source, ceiling(d/s))[1:d]
}
return (source)
}
# Grouping the left hand side
g = function(...) {
List = as.list(substitute(list(...)))[-1L]
class(List) = 'lbunch'
return(List)
}
Then to execute:
Group the left hand side using the new function g()
The right hand side should be a vector or a list
Use the newly-created binary operator %=%
# Example Call; Note the use of g() AND `%=%`
# Right-hand side can be a list or vector
g(a, b, c) %=% list("hello", 123, list("apples, oranges"))
g(d, e, f) %=% 101:103
# Results:
> a
[1] "hello"
> b
[1] 123
> c
[[1]]
[1] "apples, oranges"
> d
[1] 101
> e
[1] 102
> f
[1] 103
Example using lists of different sizes:
Longer Left Hand Side
g(x, y, z) %=% list("first", "second")
# Warning message:
# In `%=%.lbunch`(g(x, y, z), list("first", "second")) :
# LHS has more args than RHS. RHS will be repeated.
> x
[1] "first"
> y
[1] "second"
> z
[1] "first"
Longer Right Hand Side
g(j, k) %=% list("first", "second", "third")
# Warning message:
# In `%=%.lbunch`(g(j, k), list("first", "second", "third")) :
# RHS has more args than LHS. Only first2used.
> j
[1] "first"
> k
[1] "second"
Consider using functionality included in base R.
For instance, create a 1 row dataframe (say V) and initialize your variables in it. Now you can assign to multiple variables at once V[,c("a", "b")] <- values[c(2, 4)], call each one by name (V$a), or use many of them at the same time (values[c(5, 6)] <- V[,c("a", "b")]).
If you get lazy and don't want to go around calling variables from the dataframe, you could attach(V) (though I personally don't ever do it).
# Initialize values
values <- 1:100
# V for variables
V <- data.frame(a=NA, b=NA, c=NA, d=NA, e=NA)
# Assign elements from a vector
V[, c("a", "b", "e")] = values[c(2,4, 8)]
# Also other class
V[, "d"] <- "R"
# Use your variables
V$a
V$b
V$c # OOps, NA
V$d
V$e
here is my idea. Probably the syntax is quite simple:
`%tin%` <- function(x, y) {
mapply(assign, as.character(substitute(x)[-1]), y,
MoreArgs = list(envir = parent.frame()))
invisible()
}
c(a, b) %tin% c(1, 2)
gives like this:
> a
Error: object 'a' not found
> b
Error: object 'b' not found
> c(a, b) %tin% c(1, 2)
> a
[1] 1
> b
[1] 2
this is not well tested though.
A potentially dangerous (in as much as using assign is risky) option would be to Vectorize assign:
assignVec <- Vectorize("assign",c("x","value"))
#.GlobalEnv is probably not what one wants in general; see below.
assignVec(c('a','b'),c(0,4),envir = .GlobalEnv)
a b
0 4
> b
[1] 4
> a
[1] 0
Or I suppose you could vectorize it yourself manually with your own function using mapply that maybe uses a sensible default for the envir argument. For instance, Vectorize will return a function with the same environment properties of assign, which in this case is namespace:base, or you could just set envir = parent.env(environment(assignVec)).
As others explained, there doesn't seem to be anything built in. ...but you could design a vassign function as follows:
vassign <- function(..., values, envir=parent.frame()) {
vars <- as.character(substitute(...()))
values <- rep(values, length.out=length(vars))
for(i in seq_along(vars)) {
assign(vars[[i]], values[[i]], envir)
}
}
# Then test it
vals <- 11:14
vassign(aa,bb,cc,dd, values=vals)
cc # 13
One thing to consider though is how to handle the cases where you e.g. specify 3 variables and 5 values or the other way around. Here I simply repeat (or truncate) the values to be of the same length as the variables. Maybe a warning would be prudent. But it allows the following:
vassign(aa,bb,cc,dd, values=0)
cc # 0
list2env(setNames(as.list(rep(2,5)), letters[1:5]), .GlobalEnv)
Served my purpose, i.e., assigning five 2s into first five letters.
Had a similar problem recently and here was my try using purrr::walk2
purrr::walk2(letters,1:26,assign,envir =parent.frame())
https://stat.ethz.ch/R-manual/R-devel/library/base/html/list2env.html:
list2env(
list(
a=1,
b=2:4,
c=rpois(10,10),
d=gl(3,4,LETTERS[9:11])
),
envir=.GlobalEnv
)
If your only requirement is to have a single line of code, then how about:
> a<-values[2]; b<-values[4]
I'm afraid that elegent solution you are looking for (like c(a, b) = c(2, 4)) unfortunatelly does not exist. But don't give up, I'm not sure! The nearest solution I can think of is this one:
attach(data.frame(a = 2, b = 4))
or if you are bothered with warnings, switch them off:
attach(data.frame(a = 2, b = 4), warn = F)
But I suppose you're not satisfied with this solution, I wouldn't be either...
R> values = c(1,2,3,4)
R> a <- values[2]; b <- values[3]; c <- values[4]
R> a
[1] 2
R> b
[1] 3
R> c
[1] 4
Another version with recursion:
let <- function(..., env = parent.frame()) {
f <- function(x, ..., i = 1) {
if(is.null(substitute(...))){
if(length(x) == 1)
x <- rep(x, i - 1);
stopifnot(length(x) == i - 1)
return(x);
}
val <- f(..., i = i + 1);
assign(deparse(substitute(x)), val[[i]], env = env);
return(val)
}
f(...)
}
example:
> let(a, b, 4:10)
[1] 4 5 6 7 8 9 10
> a
[1] 4
> b
[1] 5
> let(c, d, e, f, c(4, 3, 2, 1))
[1] 4 3 2 1
> c
[1] 4
> f
[1] 1
My version:
let <- function(x, value) {
mapply(
assign,
as.character(substitute(x)[-1]),
value,
MoreArgs = list(envir = parent.frame()))
invisible()
}
example:
> let(c(x, y), 1:2 + 3)
> x
[1] 4
> y
[1]
Combining some of the answers given here + a little bit of salt, how about this solution:
assignVec <- Vectorize("assign", c("x", "value"))
`%<<-%` <- function(x, value) invisible(assignVec(x, value, envir = .GlobalEnv))
c("a", "b") %<<-% c(2, 4)
a
## [1] 2
b
## [1] 4
I used this to add the R section here: http://rosettacode.org/wiki/Sort_three_variables#R
Caveat: It only works for assigning global variables (like <<-). If there is a better, more general solution, pls. tell me in the comments.
For a named list, use
list2env(mylist, environment())
For instance:
mylist <- list(foo = 1, bar = 2)
list2env(mylist, environment())
will add foo = 1, bar = 2 to the current environement, and override any object with those names. This is equivalent to
mylist <- list(foo = 1, bar = 2)
foo <- mylist$foo
bar <- mylist$bar
This works in a function, too:
f <- function(mylist) {
list2env(mylist, environment())
foo * bar
}
mylist <- list(foo = 1, bar = 2)
f(mylist)
However, it is good practice to name the elements you want to include in the current environment, lest you override another object... and so write preferrably
list2env(mylist[c("foo", "bar")], environment())
Finally, if you want different names for the new imported objects, write:
list2env(`names<-`(mylist[c"foo", "bar"]), c("foo2", "bar2")), environment())
which is equivalent to
foo2 <- mylist$foo
bar2 <- mylist$bar