Использование case_when и between с таблицей пороговых значений соответствия - PullRequest
Новая
       27

Использование case_when и between с таблицей пороговых значений соответствия

2 голосов
/ 04 августа 2020

Доброе утро,

У меня есть 2 фрейма данных: (25000,66) и таблица (10,2), содержащая 10 групп и последний идентификатор каждой группы.

В большой набор данных У меня есть одна переменная с именем id. Это просто id = row_number()

id
1
2
3
4
5
...
25000

EDIT : много ответов, спасибо за все ваши идеи. Прочитав, я понял, что забыл важный шаг в описании данных, и извинился.

Я использую syntheti c сэмплирование на исходном bigdataset для создания новых точек. Итак, после выборки столбец id выглядит так: 

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

Вот почему я использовал предложение between с last_id, чтобы переназначить идентификатор их группе.

Таблица пороговых значений : 

last_id   group_name
50        grp1
1500      grp2
8900      grp3
...
25000     grp10

Я хотел бы добавить новый столбец в большой набор данных, чтобы иметь идентификатор и имя группы, только при условии, что идентификатор попадает в диапазон, указанный группой в таблице пороговых значений .

А пока я написал это: 

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

Но это не работает, я получаю эту ошибку:

Ошибка в FUN (слева, справа ): compareison (5) возможно только для списка типов и atomi c

Более того, этот код выглядит ужасно, должен быть другой способ использования apply или другой функции dplyr?

Спасибо вам за чтение.

Ответы [ 5 ]

4 голосов
/ 04 августа 2020

Два варианта с -package:

1) используйте функцию скользящего соединения 

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

, которая дает: 

> 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) использовать функцию неэквивалентного соединения 

# create a 'first_id'
dt2[, first_id := shift(last_id, fill = 0)]
# perform the non-equi join
dt1[dt2, on = .(id > first_id, id <= last_id), group := group_name]

Этот метод обновит dt1 вместо создания новый data.table и поэтому более эффективен для памяти: 

> 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

Варианты с использованием основы R:

Чистая основа R с findInterval (который сопоставим с cut -методом из @ Otto Kässi ): 

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

Или с базовыми R merge и 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)

Использованные данные: 

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)
3 голосов
/ 04 августа 2020

Вот подход, который использует dplyr::mutate() для создания диапазонов индексной переменной, а также sqldf() и BETWEEN команду для объединения данных. 

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")]

... и вывод: 

> # 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

Другой альтернативой с sqldf() является завершение слияния с помощью предложения WHERE вместо LEFT JOIN: 

joinedData <- sqldf("select df.*, grptbl.groupID 
                    from df, grptbl
                    WHERE df.id BETWEEN grptbl.minIndex AND grptbl.maxIndex")
3 голосов
/ 04 августа 2020

cut в базовом R может сделать это относительно легко: 

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

Вывод: 

> 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

Обратите внимание, что вам нужно дополнить свои пороги с помощью min(bigdataset$id); таким образом у вас будет 11 контрольных точек для 10 классов.

1 голос
/ 04 августа 2020

Вот решение tidyverse. Поскольку вы присоединяетесь к максимальному значению для каждой группы, вы можете указать .direction = 'up', чтобы заполнить все отсутствующие значения. 

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"
))
1 голос
/ 04 августа 2020

Вместо этого вы можете выполнить соединение, а затем использовать «последнее наблюдение, перенесенное вперед» (na.locf из пакета zoo) в качестве обходного пути для заполнения недостающих значений: 

# some sample data
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

Технически, при установке fromLast = TRUE это фактически соответствует NOCB (следующее наблюдение, перенесенное назад).

...