Function argument as value or column name for data.table - r

I want my function to be able to take a value or a column name. How can I do this with data.table?
library(data.table)
df <- data.table(a = c(1:5),
b = c(5:1),
c = c(1, 3, 5, 3, 1))
myfunc <- function(val) {
df[a >= val]
}
# This works:
myfunc(2)
# This does not work:
myfunc("c")
If I define my function as:
myfunc <- function(val) {
df[a >= get(val)]
}
# This doesn't work:
myfunc(2)
# This works:
myfunc("c")
What is the best way to resolve this?
Edit: To be clear, I want to results to be the same as:
# myfunc(2)
df %>%
filter(a >= 2)
# myfunc("c")
df %>%
filter(a >= c)
EDIT:
Thanks all for the responses, I think I like dww's answer the best.
I wish it was as easy as in dplyr, where I can do:
myfunc <- function(val) {
df %>%
filter(a >= {{val}})
}
# Both work:
myfunc(2)
myfunc(c)

If you build and parse the whole expression, then you can evaluate it in its entirety. For example
myfunc <- function(val) {
df[eval(parse(text=paste("a >= ", val)))]
}
Though relying on a function that lets you mix values and variable names in the same parameter might be dangerous. Especially in the case where you actually wanted to match on character values rather than variable names. If you passed in the whole expression you could do
myfunc <- function(expr) {
expr <- substitute(expr)
df[eval(expr)]
}
myfunc(a>=3)
myfunc(a>=c)

The question did not actually define the desired behavior so we assume that df must be a data.table and if a character string is passed then the column of that name should be returned and if a number is passed then those rows whose a column exceed that number should be returned.
Define an S3 generic and methods for character and default.
myfunc <- function(x, data = df) UseMethod("myfunc")
myfunc.character <- function(x, data = df) data[[x]]
myfunc.default <- function(x, data = df) data[a > x]
myfunc(2)
## a b c
## 1: 3 3 5
## 2: 4 2 3
## 3: 5 1 1
myfunc("c")
## [1] 1 3 5 3 1

Related

lappy conditional on variable value

I want to lappy two functions on a data set conditional on the value of a specific variable.
first_function <- function(x) {return (x + 0)}
second_function <- function(x) {return (x + 1)}
df <- data.frame(Letters = c("A","B","B"), Numbers = 1:3)
Someting like:
df <- lapply(df, if(df$Letters=="A") first_function else second_function )
To produce:
df_desired <- data.frame(Letters = c("A","B","B"), Numbers = c(1,3,4))
You can do it with dplyr and purrr. Obviously this is a basic function, but you should be able to build on it for your needs:
library(dplyr)
library(purrr)
calc <- function(y, x){
first_function <- function(x) {return (x + 0)}
second_function <- function(x) {return (x + 1)}
if(y == "A")
return(first_function(x))
return(second_function(x))
}
df <- data.frame(Letters = c("A","B","B"), Numbers = 1:3)
df %>%
mutate(Numbers = map2_dbl(Letters, Numbers, ~calc(.x,.y)))
Letters Numbers
1 A 1
2 B 3
3 B 4
>(df_desired <- data.frame(Letters = c("A","B","B"), Numbers = c(1,3,4)))
Letters Numbers
1 A 1
2 B 3
3 B 4
BENCHMARKING
I am not a data.table expert (feel free to add), so did not incorporate here. But, #R Yoda is correct. Although it reads nicely and future you will find it easier to read and extend the function, the purrr solution is not that fast. I liked the ifelse approach, so added case_when which is easier to scale when dealing with multiple functions. Here are a couple solutions:
library(dplyr)
library(purrr)
library(microbenchmark)
first_function <- function(x) {return (x + 0)}
second_function <- function(x) {return (x + 1)}
calc <- function(y, x){
if(y == "A")
return(first_function(x))
return(second_function(x))
}
df <- data.frame(Letters = rep(c("A","B","B"),1000), Numbers = 1:3)
basic <- function(){
data.frame(df$Letters, apply(df, 1, function(row) {
num <- as.numeric(row['Numbers'])
if (row['Letters'] == 'A') first_function(num) else second_function(num)
}))
}
dplyr_purrr <- function(){
df %>%
mutate(Numbers = map2_dbl(Letters, Numbers, ~calc(.x,.y)))
}
dplyr_case_when <- function(){
df %>%
mutate(Numbers = case_when(
Letters == "A" ~ first_function(Numbers),
TRUE ~ second_function(Numbers)))
}
map_list <- function(){
data.frame(df$Letters, map2_dbl(df2$Letters, df2$Numbers, ~calc(.x, .y)))
}
within_mapply <- function(){
within(df, Numbers <- mapply(Letters, Numbers,
FUN = function(x, y){
switch(x,
"A" = first_function(y),
"B" = second_function(y))
}))
}
within_ifelse <- function(){
within(df, Numbers <- ifelse(Letters == "A",
first_function(Numbers),
second_function(Numbers)))
}
within_case_when <- function(){
within(df, Numbers <- case_when(
Letters == "A" ~ first_function(Numbers),
TRUE ~ second_function(Numbers)))
}
(mbm <- microbenchmark(
basic(),
dplyr_purrr(),
dplyr_case_when(),
map_list(),
within_mapply(),
within_ifelse(),
within_case_when(),
times = 1000
))
Unit: microseconds
expr min lq mean median uq max neval cld
basic() 12816.427 24028.3375 27719.8182 26741.7770 29417.267 277756.650 1000 f
dplyr_purrr() 9682.884 17817.0475 20072.2752 19736.8445 21767.001 48344.265 1000 e
dplyr_case_when() 1098.258 2096.2080 2426.7183 2325.7470 2625.439 9039.601 1000 b
map_list() 8764.319 16873.8670 18962.8540 18586.2790 20599.000 41524.564 1000 d
within_mapply() 6718.368 12397.1440 13806.1752 13671.8120 14942.583 24958.390 1000 c
within_ifelse() 279.796 586.6675 690.1919 653.3345 737.232 8131.292 1000 a
within_case_when() 470.155 955.8990 1170.4641 1070.5655 1219.284 46736.879 1000 a
The simple way to do this with *apply would be to put the whole logic (with the conditional and the two functions) into another function and use apply with MARGIN=1 to pass the data in row by row (lapply will pass in the data by column):
apply(df, 1, function(row) {
num <- as.numeric(row['Numbers'])
if (row['Letters'] == 'A') first_function(num) else second_function(num)
})
[1] 1 3 4
The problem with this approach, at #r2evans points out in the comment below, is that when you use apply with a heterogeneous data.frame (in this case, Letters is type factor while Numbers is type integer) each row passed into the applied function is passed as a vector which can only have a single type, so everything in the row is coerced to the same type (in this case character). This is why it's necessary to use as.numeric(row['Numbers']), to turn Numbers back into type numeric. Depending on your data, this could be a simple fix (as above) or it could make things much more complicated and bug-prone. Either way #akrun's solution is much better, since it preserves each variable's original data type.
lapply has difficulty in this case because it's column-based. However you can try transpose your data by t() and use lapply if you persist. Here I provide two ways which use mapply and ifelse :
df$Letters <- as.character(df$Letters)
# Method 1
within(df, Numbers <- mapply(Letters, Numbers, FUN = function(x, y){
switch(x, "A" = first_function(y),
"B" = second_function(y))
}))
# Method 2
within(df, Numbers <- ifelse(Letters == "A",
first_function(Numbers),
second_function(Numbers)))
Both above got the same outputs :
# Letters Numbers
# 1 A 1
# 2 B 3
# 3 B 4
Here a data.table variant for better performance in case of many data rows (but also showing an implicit conversion problem):
library(data.table)
setDT(df) # fast convertion from data.frame to data.table
df[ Letters == "A", Numbers := first_function(Numbers) ]
df[!(Letters == "A"), Numbers := second_function(Numbers)] # issues a warning, see below
df
# Letters Numbers
# 1: A 1
# 2: B 3
# 3: B 4
The issued warning is:
Warning message: In [.data.table(df, !(Letters == "A"),
:=(Numbers, second_function(Numbers))) : Coerced 'double' RHS to
'integer' to match the column's type; may have truncated precision.
Either change the target column ['Numbers'] to 'double' first (by
creating a new 'double' vector length 3 (nrows of entire table) and
assign that; i.e. 'replace' column), or coerce RHS to 'integer' (e.g.
1L, NA_[real|integer]_, as.*, etc) to make your intent clear and for
speed. Or, set the column type correctly up front when you create the
table and stick to it, please.
The reason is that the data.frame column Numbers is an integer
> str(df)
'data.frame': 3 obs. of 2 variables:
$ Letters: Factor w/ 2 levels "A","B": 1 2 2
$ Numbers: int 1 2 3
but the functions return a double (for whatever reason):
> typeof(first_function(df$Numbers))
[1] "double"

How do I pass mulitple columns to a function within dplyr::summarize

I am trying to pass all columns from a data.frame matching a criteria to a function within the summarize function of dplyr as follows:
df %>% group_by(Version, Type) %>%
summarize(mcll(TrueClass, starts_with("pred")))
Error: argument is of length zero
Is there a way to do this? A working example follows:
Build a simulated data.frame of sample predictions. These are interpreted as the output of a classification algorithm.
library(dplyr)
nrow <- 40
ncol <- 4
set.seed(567879)
getProbs <- function(i) {
p <- runif(i)
return(p / sum(p))
}
df <- data.frame(matrix(NA, nrow, ncol))
for (i in seq(nrow)) df[i, ] <- getProbs(ncol)
names(df) <- paste0("pred.", seq(ncol))
add a column indicating the true class
df$TrueClass <- factor(ceiling(runif(nrow, min = 0, max = ncol)))
add categorical columns for sub-setting
df$Type <- c(rep("a", nrow / 2), rep("b", nrow / 2))
df$Version <- rep(1:4, times = nrow / 4)
now I want to calculate the Multiclass LogLoss for these predictions using the function below:
mcll <- function (act, pred)
{
if (class(act) != "factor") {
stop("act must be a factor")
}
pred[pred == 0] <- 1e-15
pred[pred == 1] <- 1 - 1e-15
dummies <- model.matrix(~act - 1)
if (nrow(dummies) != nrow(pred)) {
return(0)
}
return(-1 * (sum(dummies * log(pred)))/length(act))
}
this is easily done with the entire data set
act <- df$TrueClass
pred <- df %>% select(starts_with("pred"))
mcll(act, pred)
but I want to use dplyr group_by to calculate mcll for each subset of the data
df %>% group_by(Version, Type) %>%
summarize(mcll(TrueClass, starts_with("pred")))
Ideally I could do this without changing the mcll() function, but I am open to doing that if it simplifies the other code.
Thanks!
EDIT: Note that the input to mcll is a vector of true values and a matrix of probabilities with one column for each "pred" column. For each subset of data, mcll should return a scalar. I can get exactly what I want with the code below, but I was hoping for something within the context of dplyr.
mcll_df <- data.frame(matrix(ncol = 3, nrow = 8))
names(mcll_df) <- c("Type", "Version", "mcll")
count = 1
for (ver in unique(df$Version)) {
for (type in unique(df$Type)) {
subdat <- df %>% filter(Type == type & Version == ver)
val <- mcll(subdat$TrueClass, subdat %>% select(starts_with("pred")))
mcll_df[count, ] <- c(Type = type, Version = ver, mcll = val)
count = count + 1
}
}
head(mcll_df)
Type Version mcll
1 a 1 1.42972507510096
2 b 1 1.97189000832723
3 a 2 1.97988830406062
4 b 2 1.21387875938737
5 a 3 1.30629638026735
6 b 3 1.48799237895462
This is easy to do using data.table:
library(data.table)
setDT(df)[, mcll(TrueClass, .SD), by = .(Version, Type), .SDcols = grep("^pred", names(df))]
# Version Type V1
#1: 1 a 1.429725
#2: 2 a 1.979888
#3: 3 a 1.306296
#4: 4 a 1.668330
#5: 1 b 1.971890
#6: 2 b 1.213879
#7: 3 b 1.487992
#8: 4 b 1.171286
I had to change the mcll function a little bit but then it worked. The problem is occurring with the second if statement. You are telling the function to get nrow(pred), but if you are summarizing over multiple columns you are actually only supplying a vector each time (because each column gets analyzed separately). Additionally, I switched the order of the arguments being entered into the function.
mcll <- function (pred, act)
{
if (class(act) != "factor") {
stop("act must be a factor")
}
pred[pred == 0] <- 1e-15
pred[pred == 1] <- 1 - 1e-15
dummies <- model.matrix(~act - 1)
if (nrow(dummies) != length(pred)) { # the main change is here
return(0)
}
return(-1 * (sum(dummies * log(pred)))/length(act))
}
From there we can use the summarise_each function.
df %>% group_by(Version,Type) %>% summarise_each(funs(mcll(., TrueClass)), matches("pred"))
Version Type pred.1 pred.2 pred.3 pred.4
(int) (chr) (dbl) (dbl) (dbl) (dbl)
1 1 a 1.475232 1.972779 1.743491 1.161984
2 1 b 2.030829 1.331629 1.397577 1.484865
3 2 a 1.589256 1.740858 1.898906 2.005511
I checked this against a subset of the data and it looks like it works.
mcll(df$pred.1[which(df$Type=="a" & df$Version==1)],
df$TrueClass[which(df$Type=="a" & df$Version==1)])
[1] 1.475232 #pred.1 mcll when Version equals 1 and Type equals a.

treat string as object name in a loop in R

I want to create a string in a loop and use this string as object in this loop. Here is a simplified example:
for (i in 1:2) {
x <- paste("varname",i, sep="")
x <- value
}
the loop should create varname1, varname2. Then I want to use varname1, varname2 as objects to assign values. I tried paste(), print() etc.
Thanks for help!
You could create the call() to <- and then evaluate it. Here's an example,
value <- 1:5
for (i in 1:2) {
x <- paste("varname",i, sep="")
eval(call("<-", as.name(x), value))
}
which creates the two objects varname1 and varname2
varname1
# [1] 1 2 3 4 5
varname2
# [1] 1 2 3 4 5
But you should really try to avoid assigning to the global environment from with in a method/function. We could use a list along with substitute() and then we have the new variables together in the same place.
f <- function(aa, bb) {
eval(substitute(a <- b, list(a = as.name(aa), b = bb)))
}
Map(f, paste0("varname", 1:2), list(1:3, 3:6))
# $varname1
# [1] 1 2 3
#
# $varname2
# [1] 3 4 5 6
assign("variableName", 5)
would do that.
For example if you have variable names in array of strings you can set them in loop as:
assign(varname[1], 2 + 2)
More and more information
https://stat.ethz.ch/R-manual/R-patched/library/base/html/assign.html
#MahmutAliƖZKURAN has answered your question about how to do this using a loop. A more "R-ish" way to accomplish this might be:
mapply(assign, <vector of variable names>, <vector of values>,
MoreArgs = list(envir = .GlobalEnv))
Or, as in the case you specified above:
mapply(assign, paste0("varname", 1:2), <vector of values>,
MoreArgs = list(envir = .GlobalEnv))
I had the same issue and for some reason my apply's weren't working (lapply, assign directly, or my preferred goto, mclapply)
But this worked
vectorXTS <- mclapply(symbolstring,function(x)
{
df <- symbol_data_set[symbol_data_set$Symbol==x,]
return(xts(as.data.frame(df[,-1:-2]),order.by=as.POSIXct(df$Date)))
})
names(symbolstring) <- symbolstring
names(vectorXTS) <- symbolstring
for(i in symbolstring) assign(symbolstring[i],vectorXTS[i])

Why can't I assign to multiple variables using mapply/assign? [duplicate]

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

Assign multiple new variables on LHS in a single line

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

Resources