Conditionally working with variables in data.table - r

This is a small challenge within a big project, so I'm going to try to keep this simple.
I'm attempting to conditionally add columns to a data.table, and then process them on a conditional basis.
x <- T
y <- data.table(a = 1:10, b = c(rep(1,5), rep(2,5)))
y[ # filter some rows
a != 1
][ # conditionally add two calculated columns
,
if(x){
`:=` (
c = a*b,
d = 1/b
)
}
][ # process columns and group
,
list(
a = sum(a),
b = sum(b),
if(x) c = sum(c) # only add c if it's created above
),
by = if(x) list(b, d) else list(b) # only group by d if it's created above
]
Here is the output (error references the second set []):
Error in eval(expr, envir, enclos) : object 'd' not found
In addition: Warning message:
In deconstruct_and_eval(m, envir, enclos) :
Caught and removed `{` wrapped around := in j. := and `:=`(...) are
defined for use in j, once only and in particular ways. See help(":=").
Of course, the error is a symptom of the warning. How can I get this done?
As #Michal pointed out, putting the if() statement outside the data.table call is an option:
if(x) {
y[
...
]
} else {
y[
...
]
}
I'm hoping there's a way to get this done without repeating the code in its entirety, to simplify everything.

I can't think of a way of doing it inside the j-expression, because of how := gets evaluated in there (it really only works if it's at the root of the expression tree), but you could put it in the i-expression as a workaround:
x = FALSE
y[a != 1][x, `:=`(c = a * b, d = 1/b)][]
# a b
#1: 2 1
#2: 3 1
#3: 4 1
#4: 5 1
#5: 6 2
#6: 7 2
#7: 8 2
#8: 9 2
#9: 10 2
x = TRUE
y[a != 1][x, `:=`(c = a * b, d = 1/b)][]
# a b c d
#1: 2 1 2 1.0
#2: 3 1 3 1.0
#3: 4 1 4 1.0
#4: 5 1 5 1.0
#5: 6 2 12 0.5
#6: 7 2 14 0.5
#7: 8 2 16 0.5
#8: 9 2 18 0.5
#9: 10 2 20 0.5
Since c(1) is the same as c(1, NULL), it can be used to return complete vectors when you're not sure how many elements will compose them.
To conditionally include columns in j
y[
,
c(
list(
a = sum(a),
b = sum(b)
),
if(x) list(c = sum(c))
)
]
And to conditionally include columns in by
y[
,
...,
by = c("b", if(x) "d")
]
by won't accept a vector of lists, but it will accept a vector of column names.

Related

Referencing columns in .SDcols using for loop

So what I'm trying to achieve is this : Say I have a data table dt having (say) 4 columns. I want to get unique length of every combination of 2 columns.
DT <- data.table(a = 1:10, b = c(1,1,1,2,2,3,4,4,5,5), c = letters[1:10], d = c(3,3,5,2,4,2,5,1,1,5))
> DT
a b c d
1: 1 1 a 3
2: 2 1 b 3
3: 3 1 c 5
4: 4 2 d 2
5: 5 2 e 4
6: 6 3 f 2
7: 7 4 g 5
8: 8 4 h 1
9: 9 5 i 1
10: 10 5 j 5
I tried the following code :
cols <- colnames(DT)
for(i in 1:(length(cols)-1)) {
for (j in i+1:length(cols)) {
print(unique(DT[,.SD, .SDcols = c(cols[i],cols[j])]))
}
}
Here, basically 'i' goes from first column to second last whereas 'j' is the combining column with 'i'. So the combinations I get are : ab, ac, ad, bc, bd, cd.
But it gives me the following error
Error in [.data.table(DT, , .SD, .SDcols = c(cols[i], cols[j])) :
.SDcols missing at the following indices: [2]
If someone can explain why this is and a way around it, I'll be really grateful. Thanks.
This is due to operators precedence, : is evaluated before +:
1+1:length(cols)
[1] 2 3 4 5
> (1+1):length(cols)
[1] 2 3 4
Correct loop is :
for(i in 1:(length(cols)-1)) {
for (j in (i+1):length(cols)) {
print(unique(DT[,.SD, .SDcols = c(cols[i],cols[j])]))
}
}

R: data.table left outer join function not updating

Based on this previous post I build leftOuterJoin which is a function to update a data.table X according to an other data.table Y. The function is defined as follows:
leftOuterJoin <- function(X, Y, onCol) {
.colsY <- names(Y)
X[Y, (.colsY) := mget(paste0("i.", .colsY)), on = onCol]
}
The function works 99% of the time as intended, e.g.:
X <- data.table(id = 1:5, L = letters[1:5])
id L
1: 1 a
2: 2 b
3: 3 c
4: 4 d
5: 5 e
Y <- data.table(id = 3:5, L = c(NA, "g", "h"), N = c(10, NA, 12))
id L N
1: 3 <NA> 10
2: 4 g NA
3: 5 h 12
leftOuterJoin(X, Y, "id")
X
id L N
1: 1 a NA
2: 2 b NA
3: 3 <NA> 10
4: 4 g NA
5: 5 h 12
However, for some reason that is unknown to me, it just stops working with some data tables (I have no reproductible example at hand). There is no error, but the data table is not updated. When I use the debug function, everything seems to be working fine, X is updated, but the real data.table isn't. Now, if I just do it outside the function it works. Maybe it is related to the scope of the function? I am really struggling with this problem.
Spec: R v3.5.1 and data.table v1.11.4.
EDIT
Based on the comments I figured out that the problem is related to the data.table pointer. You can reproduce the problem with this code:
> save(X, file = "X.RData")
> load("X.RData")
> leftOuterJoin(X, Y, "id")
> X
id L
1: 1 a
2: 2 b
3: 3 <NA>
4: 4 g
5: 5 h
Notice that X is updated but not the way we want it. However, if we use setDT() it works properly:
> load("X.RData")
> setDT(X)
> leftOuterJoin(X, Y, "id")
> X
id L N
1: 1 a NA
2: 2 b NA
3: 3 <NA> 10
4: 4 g NA
5: 5 h 12
Is there a way to set up leftOuterJoin() such that it will not be necessary to run setDT() every time some data is loaded?

ifelse function group in group in R

I have data set
ID <- c(1,1,2,2,2,2,3,3,3,3,3,4,4,4)
Eval <- c("A","A","B","B","A","A","A","A","B","B","A","A","A","B")
med <- c("c","d","k","k","h","h","c","d","h","h","h","c","h","k")
df <- data.frame(ID,Eval,med)
> df
ID Eval med
1 1 A c
2 1 A d
3 2 B k
4 2 B k
5 2 A h
6 2 A h
7 3 A c
8 3 A d
9 3 B h
10 3 B h
11 3 A h
12 4 A c
13 4 A h
14 4 B k
I try to create variable x and y, group by ID and Eval. For each ID, if Eval = A, and med = "h" or "k", I set x = 1, other wise x = 0, if Eval = B and med = "h" or "k", I set y = 1, other wise y = 0. I use the way I don't like it, I got answer but it seem like not that great
df <- data.table(df)
setDT(df)[, count := uniqueN(med) , by = .(ID,Eval)]
setDT(df)[Eval == "A", x:= ifelse(count == 1 & med %in% c("k","h"),1,0), by=ID]
setDT(df)[Eval == "B", y:= ifelse(count == 1 & med %in% c("k","h"),1,0), by=ID]
ID Eval med count x y
1: 1 A c 2 0 NA
2: 1 A d 2 0 NA
3: 2 B k 1 NA 1
4: 2 B k 1 NA 1
5: 2 A h 1 1 NA
6: 2 A h 1 1 NA
7: 3 A c 3 0 NA
8: 3 A d 3 0 NA
9: 3 B h 1 NA 1
10: 3 B h 1 NA 1
11: 3 A h 3 0 NA
12: 4 A c 2 0 NA
13: 4 A h 2 0 NA
14: 4 B k 1 NA 1
Then I need to collapse the row to get unique ID, I don't know how to collapse rows, any idea?
The output
ID x y
1 0 0
2 1 1
3 0 1
4 0 1
We create the 'x' and 'y' variables grouped by 'ID' without the NA elements directly coercing the logical vector to binary (as.integer)
df[, x := as.integer(Eval == "A" & count ==1 & med %in% c("h", "k")) , by = ID]
and similarly for 'y'
df[, y := as.integer(Eval == "B" & count ==1 & med %in% c("h", "k")) , by = ID]
and summarise it, using any after grouping by "ID"
df[, lapply(.SD, function(x) as.integer(any(x))) , ID, .SDcols = x:y]
# ID x y
#1: 1 0 0
#2: 2 1 1
#3: 3 0 1
#4: 4 0 1
If we need a compact approach, instead of assinging (:=), we summarise the output grouped by "ID", "Eval" based on the conditions and then grouped by 'ID', we check if there is any TRUE values in 'x' and 'y' by looping over the columns described in the .SDcols.
setDT(df)[, if(any(uniqueN(med)==1 & med %in% c("h", "k"))) {
.(x= Eval=="A", y= Eval == "B") } else .(x=FALSE, y=FALSE),
by = .(ID, Eval)][, lapply(.SD, any) , by = ID, .SDcols = x:y]
# ID x y
#1: 1 FALSE FALSE
#2: 2 TRUE TRUE
#3: 3 FALSE TRUE
#4: 4 FALSE TRUE
If needed, we can convert to binary similar to the approach showed in the first solution.
The OP's goal...
"I try to create variable x and y, group by ID and Eval. For each ID, if Eval = A, and med = "h" or "k", I set x = 1, other wise x = 0, if Eval = B and med = "h" or "k", I set y = 1, other wise y = 0. [...] Then I need to collapse the row to get unique ID"
can be simplified to...
For each ID and Eval, flag if all med values are h or all med values are k.
setDT(df) # only do this once
df[, all(med=="k") | all(med=="h"), by=.(ID,Eval)][, dcast(.SD, ID ~ Eval, fun=any)]
ID A B
1: 1 FALSE FALSE
2: 2 TRUE TRUE
3: 3 FALSE TRUE
4: 4 FALSE TRUE
To see what dcast is doing, read ?dcast and try running just the first part on its own, df[, all(med=="k") | all(med=="h"), by=.(ID,Eval)].
The change to use x and y instead of A and B is straightforward but ill-advised (since unnecessary renaming can be confusing and lead to extra work when there are new Eval values); and ditto the change for 1/0 instead of TRUE/FALSE (since the values captured are actually boolean).
Here is my dplyr solution since I find it more readable than data.table.
library(dplyr)
df %>%
group_by(ID, Eval) %>%
mutate(
count = length(unique(med)),
x = ifelse(Eval == "A" &
count == 1 & med %in% c("h", "k"), 1, 0),
y = ifelse(Eval == "B" &
count == 1 & med %in% c("h", "k"), 1, 0)
) %>%
group_by(ID) %>%
summarise(x1 = max(unique(x)),
y1 = max(unique(y)))
A one liner solution for collapsing the rows of your result :
df[,lapply(.SD,function(i) {ifelse(1 %in% i,ifelse(!0 %in% i,1,0),0)}),.SDcols=x:y,by=ID]
ID x y
1: 1 0 0
2: 2 1 1
3: 3 0 1
4: 4 0 1

Evaluate expression in R data.table

I have the following data.table:
> dt = data.table(expr = c("a + b", "a - b", "a * b", "a / b"), a = c(1,2,3,4), b = c(5,6,7,8))
> dt
expr a b
1: a + b 1 5
2: a - b 2 6
3: a * b 3 7
4: a / b 4 8
My aim is to get the following data.table:
> dt
expr a b ans
1: a + b 1 5 6
2: a - b 2 6 -4
3: a * b 3 7 21
4: a / b 4 8 0.5
I tried the following:
> dt[, ans := eval(expr)]
Error in eval(expr, envir, enclos) : object 'expr' not found
> dt[, ans := eval(parse(text = expr))]
Error in parse(text = expr) : object 'expr' not found
Any idea how can I calculate the ans column based on the expression in the expr column?
If your actual expressions describe calls to vectorized functions and are repeated many times each, this may be more efficient, since it only parses and evaluates each distinct expression one time:
f <- function(e, .SD) eval(parse(text=e[1]), envir=.SD)
dt[, ans:=f(expr,.SD), by=expr, .SDcols=c("a", "b")]
# expr a b ans
# 1: a + b 1 5 6.0
# 2: a - b 2 6 -4.0
# 3: a * b 3 7 21.0
# 4: a / b 4 8 0.5
Really, there are a bunch of challenges for vectorization in such a setup. eval doesn't expect to run on a vector of expressions nor is it set up to iterate over a vector of environments by default. Here I define a helper function to wrap much of the iteration
calc <- function(e, ...) {
run<-function(x, ...) {
eval(parse(text=x), list(...))
}
do.call("mapply", c(list(run, e), list(...)))
}
dt[, ans:=calc(expr,a=a,b=b)]
which returns
expr a b ans
1: a + b 1 5 6.0
2: a - b 2 6 -4.0
3: a * b 3 7 21.0
4: a / b 4 8 0.5
as desired. Note that you'll need to name the parameters in the call to calc() so it knows which column to map to which variable.

Removing data point outside of a specific quantile

I would like to remove data points above 97.5% and below 2.5%. I created the following parsimonious data set to explain the issue:
y <- data.table(a = rep(c("b","d"), each = 2, times = 3), c=rep(c("e","f"),
each = 3, times = 2), seq(1,6))
I created the following script to accomplish the task:
require(data.table)
y[, trimErr := ifelse(y$V3 < quantile(y$V3, 0.95) & y$V3 > quantile(y$V3, 0.05),y$V3, NA),
by = list(a,c)]
I then got 4 warning messages, I will only provide the first warning:
Warning messages:
1: In `[.data.table`(y, , `:=`(trimErr, ifelse(y$V3 < quantile(y$V3, :
RHS 1 is length 12 (greater than the size (3) of group 1). The last 9 element(s) will be discarded.
can you please explain to me what the warning means and how can i modify my code.
Would you suggest a better code to remove the top and bottom 2.5% of the data. Thanks in advance.
You're grouping by a and c, but passing in a vector that is the length of the entire data.table, instead of just the data for each group.
You don't need the y$ inside the [.data.table call
y[, trimErr:=ifelse(V3 < quantile(V3, 0.95) & V3 > quantile(V3, 0.05),V3, NA),
by=list(a,c)]
y
# a c V3 trimErr
# 1: b e 1 NA
# 2: b e 2 2
# 3: d e 3 NA
# 4: d f 4 NA
# 5: b f 5 5
# 6: b f 6 NA
# 7: d e 1 NA
# 8: d e 2 2
# 9: b e 3 NA
#10: b f 4 NA
#11: d f 5 5
#12: d f 6 NA

Resources