问题
This is an extension of this question asked before.
In a database containing firm and category values, I want to calculate this: If a firm enters into a new category that it has not been previously engaged in Three(3) previous years (not including the same year), then that entry is labeld as "NEW", otherwise it will be labeld as "OLD".
In the following dataset:
df <- data.table(year=c(1979,1979,1980,1980,1981,1981,1982,1983,1983,1984,1984),
category = c("A","A","B","C","A","D","F","F","C","A","B"))
The desired outcome would be:
year category Newness
1: 1979 A NEW
2: 1979 A NEW
3: 1980 B NEW
4: 1980 C NEW
5: 1981 A NEW
6: 1981 D NEW
7: 1982 F NEW
8: 1983 F OLD
9: 1983 C OLD
10: 1984 A OLD
11: 1984 B NEW
Many thanks in advance.
回答1:
Here are some options.
1) Using non-equi self join with mult
df[, yrsago := year - 3L]
df[, Newness :=
c("OLD", "NEW")[1L + df[df, on=.(category, year>=yrsago, year<year), mult="first", is.na(x.category)]]
]
2) Using non-equi self join with by=.EACHI:
df[, yrsago := year - 3L]
df[, Newness2 :=
c("OLD", "NEW")[1L + df[df, on=.(category, year>=yrsago, year<year), by=.EACHI, .N==0L]$V1]
]
3) Using a rolling join which should be the fastest
df[, q := year - 0.1]
df[, Newness3 :=
df[df, on=.(category, year=q), roll=3L, fifelse(is.na(x.year), "NEW", "OLD")]
]
output:
year category yrsago Newness Newness2 q Newness3
1: 1979 A 1976 NEW NEW 1978.9 NEW
2: 1979 A 1976 NEW NEW 1978.9 NEW
3: 1980 B 1977 NEW NEW 1979.9 NEW
4: 1980 C 1977 NEW NEW 1979.9 NEW
5: 1981 A 1978 OLD OLD 1980.9 OLD
6: 1981 D 1978 NEW NEW 1980.9 NEW
7: 1982 F 1979 NEW NEW 1981.9 NEW
8: 1983 F 1980 OLD OLD 1982.9 OLD
9: 1983 C 1980 OLD OLD 1982.9 OLD
10: 1984 A 1981 OLD OLD 1983.9 OLD
11: 1984 B 1981 NEW NEW 1983.9 NEW
data:
df <- data.table(year=c(1979,1979,1980,1980,1981,1981,1982,1983,1983,1984,1984),
category = c("A","A","B","C","A","D","F","F","C","A","B"))
回答2:
Using mapply :
df$Newness <- c('NEW', 'OLD')[mapply(function(x, y) any(y == df$category
[df$year < x & df$year >= (x - 3)]), df$year, df$category) + 1]
df
# year category Newness
# 1: 1979 A NEW
# 2: 1979 A NEW
# 3: 1980 B NEW
# 4: 1980 C NEW
# 5: 1980 A OLD
# 6: 1981 D NEW
# 7: 1981 F NEW
# 8: 1982 F OLD
# 9: 1982 C OLD
#10: 1982 A OLD
#11: 1982 B OLD
回答3:
This is not an answer, but just posting the time benchmark for the solutions offered, applied on a portion of the patent database I'm working on:
> df[, yrsago := year - 3L]
> df[, q := year - 0.1]
> tbench <- bench::mark(time_unit="s",
+ sol_1 = df[, Newness := c('NEW', 'OLD')[mapply(function(x, y) any(y == df$category[df$year < x & df$year >= (x - 3)]), df$year, df$category) + 1]],
+ sol_2 =
+ df[, Newness := c("OLD", "NEW")[1L + df[df, on=.(category, year>=yrsago, year<year), mult="first",
+ is.na(x.category)]]],
+ sol_3 = df[, Newness2 := c("OLD", "NEW")[1L + df[df, on=.(category, year>=yrsago, year<year),
+ by=.EACHI, .N==0L]$V1]],
+
+ sol_4 =
+ df[, Newness3 := df[df, on=.(category, year=q), roll=3L, fifelse(is.na(x.year), "NEW", "OLD")]],
+
+ min_time = 1
+ )
>
> tbench
# A tibble: 4 x 13
expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time result memory time gc
<bch:expr> <dbl> <dbl> <dbl> <bch:byt> <dbl> <int> <dbl> <dbl> <list> <list> <list> <list>
1 sol_1 0.144 0.192 5.53 321MB 1.11 5 1 0.905 <data.table~ <Rprofmem[~ <bch:t~ <tibbl~
2 sol_2 0.00611 0.00629 159. 406KB 1.09 146 1 0.921 <data.table~ <Rprofmem[~ <bch:t~ <tibbl~
3 sol_3 0.00632 0.00647 154. 406KB 1.07 144 1 0.936 <data.table~ <Rprofmem[~ <bch:t~ <tibbl~
4 sol_4 0.00405 0.00416 238. 393KB 0 238 0 1.00 <data.table~ <Rprofmem[~ <bch:t~ <tibbl~
Thanks all for your help.
来源：https://stackoverflow.com/questions/62926480/comparing-values-of-a-certain-row-with-a-certain-number-of-previous-rows-in-data