En utilisant case_when et between avec une table de seuil de correspondance

Question

Bonjour,

J'ai 2 dataframes : (25000,66) et une table de seuil (10,2) contenant 10 groupes et le dernier id de chaque groupe.

Dans le grand ensemble de données, j'ai une variable appelée id. C'est simplement id = numéro_de_ligne()

id
1
2
3
4
5
...
25000

EDIT : Beaucoup de réponses, merci pour toutes vos idées. En lisant, j'ai réalisé que j'avais oublié une étape importante dans la description de mes données et je m'en excuse.

Je suis en train d'utiliser un échantillonnage synthétique sur le grand ensemble de données original pour générer de nouveaux points. Après échantillonnage, la colonne id ressemble à ceci :

id
1
2
2.1
3
3.8
4.74
5.12
6
...
25000

C'est pourquoi j'ai utilisé la clause entre avec dernier_id pour réaffecter les id à leur groupe.

Tableau des seuils :

dernier_id   nom_groupe
50        grp1
1500      grp2
8900      grp3
...
25000     grp10

J'aimerais ajouter une nouvelle colonne au grand ensemble de données afin d'avoir l'id et le nom du groupe, basés uniquement sur la condition que l'id se situe dans la plage spécifiée par le tableau des seuils.

Pour l'instant, j'ai écrit ceci :

df <- df %>%
    dplyr::mutate(group_name = case_when(id < dernier_id[1,1] ~ dernier_id[1,2],
                                                between(id, dernier_id[1,1], dernier_id[2,1]) ~ dernier_id[2,2],
                                                between(id, dernier_id[2,1], dernier_id[3,1]) ~ dernier_id[3,2],
                                                between(id, dernier_id[3,1], dernier_id[4,1]) ~ dernier_id[4,2],
                                                between(id, dernier_id[4,1], dernier_id[5,1]) ~ dernier_id[5,2],
                                                between(id, dernier_id[5,1], dernier_id[6,1]) ~ dernier_id[6,2],
                                                between(id, dernier_id[6,1], dernier_id[7,1]) ~ dernier_id[7,2],
                                                between(id, dernier_id[7,1], dernier_id[8,1]) ~ dernier_id[8,2],
                                                between(id, dernier_id[8,1], dernier_id[9,1]) ~ dernier_id[9,2],
                                                id > dernier_id[9,1] ~ dernier_id[10,2]))
    )

Mais cela ne fonctionne pas, j'obtiens cette erreur :

Erreur dans FUN(left, right) : comparaison (5) uniquement possible pour les types liste et atomique

De plus, ce code semble terrible, il doit y avoir une autre façon d'utiliser apply ou une autre fonction dplyr?

Merci de votre lecture.

Answer 1

Deux options avec le package data.table:

1) utilisez la fonctionnalité rolling join

dt <- dt2[dt1, on = .(last_id = id), roll = -Inf]

ce qui donne:

> dt
      last_id group_name
   1:       1       grp1
   2:       2       grp1
   3:       3       grp1
   4:       4       grp1
   5:       5       grp1
  ---                   
8896:    8896       grp3
8897:    8897       grp3
8898:    8898       grp3
8899:    8899       grp3
8900:    8900       grp3

2) utilisez la fonctionnalité non-equi join

# créez un 'first_id'
dt2[, first_id := shift(last_id, fill = 0)]
# effectuez le non-equi join
dt1[dt2, on = .(id > first_id, id <= last_id), group := group_name]

Cette méthode mettra à jour dt1 au lieu de créer un nouveau data.table et est donc plus efficace en termes de mémoire:

> dt1
        id group
   1:    1  grp1
   2:    2  grp1
   3:    3  grp1
   4:    4  grp1
   5:    5  grp1
  ---           
8896: 8896  grp3
8897: 8897  grp3
8898: 8898  grp3
8899: 8899  grp3
8900: 8900  grp3

---

Options en utilisant R de base:

Base R pure avec findInterval (qui est comparable à la méthode cut de @ Otto Kässi):

df1$group_name <- df2$group_name[findInterval(df1$id, c(0, df2$last_id), left.open = TRUE)]

Ou avec merge de base R et zoo::na.locf:

df <- merge(df1, df2, by.x = "id", by.y = "last_id", all.x = TRUE)
df$group_name <- zoo::na.locf(df$group_name, fromLast = TRUE)

---

Données utilisées:

df1 <- data.frame(id = 1:8900)
df2 <- read.table(text="last_id   group_name
50        grp1
1500      grp2
8900      grp3
", header=TRUE, stringsAsFactors=FALSE)

library(data.table)
dt1 <- as.data.table(df1)
dt2 <- as.data.table(df2)

Answer 2

La fonction cut in base R peut le faire relativement facilement :

bigdataset <- data.frame(seq(1, 25000,1))
names(bigdataset) <- 'id'
thresholds <- data.frame(
                       c(50, 1500, 8900, 10000, 12000, 13000, 14000, 15000, 16000, 25000), 
                       c('grp1','grp2','grp3','grp4', 'grp5','grp6', 'grp7','grp8','grp9','grp10'))
names(thresholds) <- c('last_id','group_name')

cut(bigdataset$id, breaks=breaks=c(min(bigdataset$id),thresholds$last_id + 1), labels=thresholds$group_name[1:10], right=FALSE) -> bigdataset$group_name

Résultat :

> bigdataset
         id group_name
1         1       grp1
2         2       grp1
3         3       grp1
4         4       grp1
5         5       grp1
6         6       grp1
7         7       grp1
8         8       grp1
9         9       grp1
10       10       grp1
11       11       grp1
12       12       grp1
13       13       grp1
14       14       grp1
15       15       grp1
16       16       grp1
17       17       grp1
18       18       grp1
19       19       grp1
20       20       grp1
21       21       grp1
22       22       grp1
23       23       grp1
24       24       grp1
25       25       grp1
26       26       grp1
27       27       grp1
28       28       grp1
29       29       grp1
30       30       grp1
31       31       grp1
32       32       grp1
33       33       grp1
34       34       grp1
35       35       grp1
36       36       grp1
37       37       grp1
38       38       grp1
39       39       grp1
40       40       grp1
41       41       grp1
42       42       grp1
43       43       grp1
44       44       grp1
45       45       grp1
46       46       grp1
47       47       grp1
48       48       grp1
49       49       grp1
50       50       grp2
51       51       grp2
52       52       grp2
53       53       grp2
54       54       grp2
55       55       grp2
56       56       grp2
57       57       grp2
58       58       grp2
59       59       grp2
60       60       grp2

N'oubliez pas d'ajouter des valeurs à vos seuils avec min(bigdataset$id); de cette manière, vous aurez 11 points de coupure pour 10 classes.

Answer 3

Voici une approche qui utilise dplyr::mutate() pour créer des plages de la variable d'index, ainsi que sqldf() et la commande BETWEEN pour joindre les données.

df <- data.frame(matrix(runif(10000,max=100),1000,10))
df$id <- 1:nrow(df)
library(dplyr)
grptbl <- data.frame(maxIndex = c(250,500,750,1000),groupID = c("one","two","three","four"))
grptbl <- mutate(grptbl,minIndex = if_else(is.na(lag(maxIndex)),1,lag(maxIndex)+1))

library(sqldf)
joinedData <- sqldf("select df.*, grptbl.groupID 
                    from df LEFT JOIN grptbl ON (df.id BETWEEN grptbl.minIndex AND grptbl.maxIndex)")
# print first and last rows of each group
joinedData[c(1,250,251,500,501,750,751,1000),c("group_name","X1","X2")]

...et le résultat :

> # print first and last rows of each group
> joinedData[c(1,250,251,500,501,750,751,1000),c("group_name","X1","X2")]
     group_name        X1        X2
1           one 53.807611 15.134119
250         one 53.016958 50.554198
251         two 36.921168  3.984325
500         two  5.974273 33.079079
501       three 75.851652 24.039047
750       three 98.233083 26.500973
751        four 14.788170 10.312172
1000       four 11.106466 41.666359

Une autre alternative avec sqldf() consiste à compléter la fusion via la clause WHERE au lieu de LEFT JOIN :

joinedData <- sqldf("select df.*, grptbl.groupID 
                    from df, grptbl
                    WHERE df.id BETWEEN grptbl.minIndex AND grptbl.maxIndex")

Answer 4

Vous pouvez plutôt effectuer une jointure puis utiliser "la dernière observation reportée" (na.locf du package zoo) comme solution de contournement pour remplir les valeurs manquantes :

# quelques données d'exemple
df <- data.frame(id = 1:50, val = LETTERS[1:10])
threshold <- data.frame(last_id = c(5, 15, 34, 45),
                        group_name = paste0("group_", 1:4))

df %>% 
  dplyr::left_join(threshold, by = c("id" = "last_id")) %>% 
  zoo::na.locf(fromLast = TRUE)

#>    id val group_name
#> 1   1   A    group_1
#> 2   2   B    group_1
#> 3   3   C    group_1
#> 4   4   D    group_1
#> 5   5   E    group_1
#> 6   6   F    group_2
#> 7   7   G    group_2
#> 8   8   H    group_2
#> 9   9   I    group_2
#> 10 10   J    group_2

Techniquement, en définissant fromLast = TRUE, cela correspond en réalité à NOCB (la prochaine observation reportée en arrière).

Answer 5

Voici une solution tidyverse. Étant donné que vous réalisez une jointure sur la valeur maximale de chaque groupe, vous pouvez spécifier .direction = 'up' pour remplir toutes les valeurs manquantes.

library(tidyverse)
df <- left_join(df1, df2, by = c('id' = 'last_id')) %>% 
  fill(group_name, .direction = 'up')

df1:

df1 <- data.frame(id = rep(1:25000))

df2:

structure(list(last_id = c(50, 1500, 8900, 10500, 16900, 25000), group_name = c("grp1", "grp2", "grp3", "grp4", "grp5", "grp6")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))