Ceci est une extension de ceci question posée auparavant.
Dans une base de données contenant des valeurs d'entreprise et de catégorie, je souhaite calculer ceci: Si une entreprise entre dans une nouvelle catégorie dans laquelle elle n’a pas été précédemment engagée pendant années précédentes (sans compter la même année), cette entrée est étiquetée comme "NEW", sinon il sera étiqueté comme "OLD".
Dans l'ensemble de données suivant:
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
Le résultat souhaité serait: p >
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"))
Merci d'avance.
3 Réponses :
Voici quelques options.
1) Utilisation de l'auto-jointure non-equi avec mult
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) Utilisation de l'auto-jointure non-equi avec by=.EACHI:
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
3) strong> Utilisation d'une jointure roulante qui devrait être la plus rapide
df[, q := year - 0.1]
df[, Newness3 :=
df[df, on=.(category, year=q), roll=3L, fifelse(is.na(x.year), "NEW", "OLD")]
]
sortie:
df[, yrsago := year - 3L]
df[, Newness2 :=
c("OLD", "NEW")[1L + df[df, on=.(category, year>=yrsago, year<year), by=.EACHI, .N==0L]$V1]
]
données:
XXX
Le joint roulant est en effet le plus rapide. Quoi qu'il en soit, je pourrais l'itérer par groupes (entreprises)?
Ouais, ajoutez simplement un groupe dans l'argumentation
Merci. C'est fou vite!
Utilisation de 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
Ce n'est pas une réponse, mais simplement la publication du benchmark temporel des solutions proposées, appliqué sur une partie de la base de données de brevets sur laquelle je travaille:
> 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~
Merci à tous pour votre aide .
Merci de me le faire savoir. Modifié le dataframe.
la ligne 5 doit-elle être OLD au lieu de NEW?
@ chinsoon12 Ce serait sous l'ancien exemple. Avec le df mis à jour, l'entreprise n'a pas été impliquée dans la catégorie B au cours des trois dernières années (1981, 1982, 1983) et est donc NOUVEAU. Vos codes fonctionnent très bien cependant.