Р: Как определить неизвестное количество комбинаций? - PullRequest
Новая
       19

Р: Как определить неизвестное количество комбинаций?

6 голосов
/ 16 апреля 2020

У меня есть данные в следующем формате: 

Data <- data.frame(
  Names = c("Person A", "Person B","Person F", "Person G", "Person F", "Person G", "Person Q", "Person R"),
  Time_Stamp = c("2013-08-01 07:06:00", "2013-08-01 07:06:00", "2013-08-01 07:53:00", "2013-08-01 07:53:00", "2013-08-01 11:01:00", "2013-08-01 11:01:00", "2013-08-01 11:08:00", "2013-08-19 06:57:00")
)

#> Data
#      Names          Time_Stamp
# 1 Person A 2013-08-01 07:06:00
# 2 Person B 2013-08-01 07:06:00
# 3 Person F 2013-08-01 07:53:00
# 4 Person G 2013-08-01 07:53:00
# 5 Person F 2013-08-01 11:01:00
# 6 Person G 2013-08-01 11:01:00
# 7 Person Q 2013-08-01 11:08:00
# 8 Person R 2013-08-19 06:57:00

Я хотел бы создать код, который идентифицирует, когда сочетание (порядок не имеет значения) людей появляется вместе с одной и той же отметкой времени. Так, например, Персона F и Персона G появляются вместе в 8:14 01.08.13, поэтому они являются группой и получают уникальное имя группы. Если они снова появятся вместе, они все равно получат одно и то же имя. Проблема, с которой я столкнулся, состоит в том, что реальные данные составляют почти 100 000 строк, и я не знаю, сколько у меня в нем комбинаций людей, которые отображаются с одной и той же отметкой времени, и в комбинациях может быть более двух человек.

Я бы хотел, чтобы новые данные выглядели так: 

Desired <- data.frame(
  Names = c("Person A", "Person B","Person F", "Person G", "Person F", "Person G", "Person Q", "Person R"),
  Time_Stamp = c("2013-08-01 07:06:00", "2013-08-01 07:06:00", "2013-08-01 07:53:00", "2013-08-01 07:53:00", "2013-08-01 11:01:00", "2013-08-01 11:01:00", "2013-08-01 11:08:00", "2013-08-19 06:57:00"),
  Group = c("Group 1", "Group 1", "Group 2", "Group 2", "Group 2", "Group 2", "No Group", "No Group")
)
#      Names          Time_Stamp    Group
# 1 Person A 2013-08-01 07:06:00  Group 1
# 2 Person B 2013-08-01 07:06:00  Group 1
# 3 Person F 2013-08-01 07:53:00  Group 2
# 4 Person G 2013-08-01 07:53:00  Group 2
# 5 Person F 2013-08-01 11:01:00  Group 2
# 6 Person G 2013-08-01 11:01:00  Group 2
# 7 Person Q 2013-08-01 11:08:00 No Group
# 8 Person R 2013-08-19 06:57:00 No Group

Ответы [ 3 ]

5 голосов
/ 17 апреля 2020

Я полагаю, что следующая функция выполняет то, о чем спрашивает вопрос.

Код работает следующим образом:

  1. Факторы кодируются внутренне как последовательные целые числа, поэтому приводятся к фактору, а затем к целому числу, чтобы получить уникальные целые числа для каждого уникального "Time_Stamp", рассматриваемого как string.
  2. Используйте ave, чтобы разделить этот вектор целых чисел на "Names", оставив только первое, если f охватывает несколько имен.
  3. Наконец, если каждый уровень f имеет только один элемент, верните "No Group" иначе вставьте "Group" до этого уровня.

Эта функция использует только базу R, но может использоваться в инструкции dplyr::mutate. 

group_names <- function(x, col.name, col.date){
  f <- as.integer(as.factor(x[[col.date]]))
  f <- ave(f, x[[col.name]], FUN = function(x){
    if(length(x) > 1) x[1] else x
  })
  f <- ave(f, f, FUN = function(x){
    if(length(x) == 1) "No Group" else paste("Group", x)
  })
  f
}

Data$Group <- group_names(Data, "Names", "Time_Stamp")

Или с dplyr. Оба номера столбцов или имена столбцов работают. 

Data %>% mutate(Group = group_names(., 1, 2))
Data %>% mutate(Group = group_names(., "Names", "Time_Stamp"))
#     Names          Time_Stamp    Group
#1 Person A 2013-08-01 07:06:00  Group 1
#2 Person B 2013-08-01 07:06:00  Group 1
#3 Person F 2013-08-01 07:53:00  Group 2
#4 Person G 2013-08-01 07:53:00  Group 2
#5 Person F 2013-08-01 11:01:00  Group 2
#6 Person G 2013-08-01 11:01:00  Group 2
#7 Person Q 2013-08-01 11:08:00 No Group
#8 Person R 2013-08-19 06:57:00 No Group
4 голосов
/ 17 апреля 2020

Опция, использующая data.table: 

library(data.table)
setDT(Data, key=c("Time_Stamp","Names"))
Data[, g := if (.N > 1L) paste(Names, collapse=""), Time_Stamp]
Data[order(g), g := fifelse(is.na(g), NA_integer_, rleid(g))]

, вывод: 

      Names          Time_Stamp    g
1: Person A 2013-08-01 07:06:00    1
2: Person B 2013-08-01 07:06:00    1
3: Person F 2013-08-01 07:53:00    2
4: Person G 2013-08-01 07:53:00    2
5: Person F 2013-08-01 11:01:00    2
6: Person G 2013-08-01 11:01:00    2
7: Person Q 2013-08-01 11:08:00 <NA>
8: Person R 2013-08-19 06:57:00 <NA>
4 голосов
/ 17 апреля 2020

Вот решение, использующее igraph

library(igraph)
u <- graph_from_data_frame(Data)
grp <- clusters(u)$membership[match(Data$Names,names(clusters(u)$membership))]
Desired <- within(Data, Group <- ave(grp,grp,FUN = function(x) {if (length(x)>1) paste("Group",x) else "No Group"}))

, такое что 

> Desired
     Names          Time_Stamp    Group
1 Person A 2013-08-01 07:06:00  Group 1
2 Person B 2013-08-01 07:06:00  Group 1
3 Person F 2013-08-01 07:53:00  Group 2
4 Person G 2013-08-01 07:53:00  Group 2
5 Person F 2013-08-01 11:01:00  Group 2
6 Person G 2013-08-01 11:01:00  Group 2
7 Person Q 2013-08-01 11:08:00 No Group
8 Person R 2013-08-19 06:57:00 No Group
...