CODEWITHSUNDEEP
rdata.table
Nick
Nick

Reputation: 81

How to adapt the following code so that any arbitrary self-defined function can work inside?

The data and first piece look like this. I am applying function over pairs of columns (a,b,c) etc.

library(data.table)
d = data.table(time = c(1,1,2,2), a = c(1,2,3,4), b =c(4,3,2,1), c = c(1,1,1,1))

pairs = d[, data.table(t(combn(names(.SD), 2))), by = time]
pairs$i = 1:nrow(pairs) ## index column for reshaping in terms of pairs...
pairs = melt(pairs, id.vars = c('time', 'i'), value.name = 'firm')

d = melt(d, id.vars = 'time', variable.name = 'firm')
d = merge(pairs, d)

The piece I would like to adjust is the following (sum function applied here). Basically, this piece applies function to pair of columns (a-b), (a-c), (b-c) within each group (time 1 and 2).

result = dcast(d, time + i ~ .,
  list(pair = \(x) paste(unique(x), collapse = '_'), sum), 
  value.var = list('firm', 'value'))

Let's say I have an arbitrary function

fun1<- function(x,y, na.rm = FALSE) 1 - 0.5*sum(abs(x-y))

I would apply this fun1 instead of sum in the above piece.

Upvotes: 0

Views: 112

Answers (1)

Brian Montgomery
Brian Montgomery

Reputation: 2414

By making fun.aggregate = list we can preserve all the data, and then calculate with it later. This still might not be what you want, but I think it's progress.

result = dcast(d, time + i ~ .,
               list(pair = \(x) paste(unique(x), collapse = '_'), list), 
               value.var = list('firm', 'value'))


fun1 <- function(x,y, na.rm = FALSE) 1 - 0.5*sum(abs(x-y))
result[, new := sapply(value_list, \(x) fun1(x[1], x[2]) + fun1(x[3], x[4]))]
result
   time i firm_pair value_list new
1:    1 1       a_b    1,2,4,3 1.0
2:    1 2       a_c    1,2,1,1 1.5
3:    1 3       b_c    4,3,1,1 1.5
4:    2 4       a_b    3,4,2,1 1.0
5:    2 5       a_c    3,4,1,1 1.5
6:    2 6       b_c    2,1,1,1 1.5

Upvotes: 1

Related Questions