Более эффективные методы, чем вложенные для циклов в R - сопоставлении

Question

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

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

Но на больших наборах данных он чертовски медленный.

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

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

dta.test<- NULL
dta.test$Person_id <- c(1,2,3,4,5,6,7,8,9,10, 11)
dta.test$FirstName <- c("John", "James", "John", "Alex", "Alexander", "Jonathan", "John", "Alex", "James", "John", "John")
dta.test$LastName <- c("Smith", "Jones", "Jones", "Jones", "Jones", "Smith", "Jones", "Smith", "Johnson", "Smith", "Smith")
dta.test$DOB <- c("2001-01-01", "2002-01-01", "2003-01-01", "2004-01-01", "2004-01-01", "2001-01-01", "2003-01-01", "2006-01-01", "2006-01-01", "2001-01-01", "2009-01-01")
dta.test$Actual_ID <- c(1, 2, 3, 4, 5, 6, 3, 8, 9, 1, 11)
dta.test <- as.data.frame(dta.test)

for(i in unique(dta.test$FirstName))
  for(j in unique(dta.test$LastName))
    for (k in unique (dta.test$DOB))
{
  {
    {
       dta.test$Person_id[dta.test$FirstName==i & dta.test$LastName==j & dta.test$DOB==k] <- min(dta.test$Person_id[dta.test$FirstName==i & dta.test$LastName==j & dta.test$DOB==k], na.rm=T)
    }
  }
}

Answer 1

Я реализовал базовый подход R вместо dplyr, и он вышел (согласно микробенчмарку) в 7,46 раза быстрее, чем подход CPak для dplyr, и в 139,4 раза быстрее, чем подход для цикла for. Я только что использовал функции match и paste0, чтобы она работала, и она автоматически сохранит наименьший соответствующий идентификатор:

  dta.test[, "Actual_id"] <- match(paste0(dta.test$FirstName, dta.test$LastName, dta.test$DOB), paste0(dta.test$FirstName, dta.test$LastName, dta.test$DOB))

Этот подход также выводит его прямо во фрейм данных, а не в таблицу (из которой вам нужно извлечь новый столбец и добавить к фрейму данных):

   Person_id FirstName LastName        DOB Actual_id
1          1      John    Smith 2001-01-01         1
2          2     James    Jones 2002-01-01         2
3          3      John    Jones 2003-01-01         3
4          4      Alex    Jones 2004-01-01         4
5          5 Alexander    Jones 2004-01-01         5
6          6  Jonathan    Smith 2001-01-01         6
7          7      John    Jones 2003-01-01         3
8          8      Alex    Smith 2006-01-01         8
9          9     James  Johnson 2006-01-01         9
10        10      John    Smith 2001-01-01         1
11        11      John    Smith 2009-01-01        11

В ваших реальных данных я ожидаю, что идентификатор человека не так прост (не просто целое число) и не работает в числовом порядке, например

dta.test$Person_id <- paste0(LETTERS[1:11],1:11)

Вам просто нужен небольшой твик, чтобы он все еще работал, чтобы он извлекал значение из столбца Person_id:

dta.test[, "Actual_id"] <- dta.test[match(paste0(dta.test$FirstName, dta.test$LastName, dta.test$DOB), paste0(dta.test$FirstName, dta.test$LastName, dta.test$DOB)), "Person_id"]

Предоставление:

   Person_id FirstName LastName        DOB Actual_id
1         A1      John    Smith 2001-01-01        A1
2         B2     James    Jones 2002-01-01        B2
3         C3      John    Jones 2003-01-01        C3
4         D4      Alex    Jones 2004-01-01        D4
5         E5 Alexander    Jones 2004-01-01        E5
6         F6  Jonathan    Smith 2001-01-01        F6
7         G7      John    Jones 2003-01-01        C3
8         H8      Alex    Smith 2006-01-01        H8
9         I9     James  Johnson 2006-01-01        I9
10       J10      John    Smith 2001-01-01        A1
11       K11      John    Smith 2009-01-01       K11

Answer 2

Решение для таблиц данных, вероятно, будет самым быстрым для больших данных с большим количеством групп:

library(data.table)
setDT(dta.test, key = c("FirstName", "LastName", "DOB"))
dta.test[, Actual_ID := min(Person_id, na.rm = TRUE), by = .(FirstName, LastName, DOB)]

Answer 3

Вот решение dplyr

library(dplyr)
dta.test %>%
  group_by(FirstName, LastName, DOB) %>%
  mutate(Person_id = min(Person_id))

# A tibble: 11 x 5
# Groups: FirstName, LastName, DOB [9]
   # Person_id FirstName LastName DOB        Actual_ID
       # <dbl> <fct>     <fct>    <fct>          <dbl>
 # 1        1. John      Smith    2001-01-01        1.
 # 2        2. James     Jones    2002-01-01        2.
 # 3        3. John      Jones    2003-01-01        3.
 # 4        4. Alex      Jones    2004-01-01        4.
 # 5        5. Alexander Jones    2004-01-01        5.
 # 6        6. Jonathan  Smith    2001-01-01        6.
 # 7        3. John      Jones    2003-01-01        3.
 # 8        8. Alex      Smith    2006-01-01        8.
 # 9        9. James     Johnson  2006-01-01        9.
# 10        1. John      Smith    2001-01-01        1.
# 11       11. John      Smith    2009-01-01       11.

EDIT - добавлено сравнение производительности

for_loop_approach <- function() {
    for(i in unique(dta.test$FirstName))
      for(j in unique(dta.test$LastName))
        for (k in unique (dta.test$DOB))
    {
      {
        {
           dta.test$Person_id[dta.test$FirstName==i & dta.test$LastName==j & dta.test$DOB==k] <- min(dta.test$Person_id[dta.test$FirstName==i & dta.test$LastName==j & dta.test$DOB==k], na.rm=T)
        }
      }
    }
}

dplyr_approach <- function() {
    require(dplyr)
    dta.test %>%
      group_by(FirstName, LastName, DOB) %>%
      mutate(Person_id = min(Person_id))
}

library(microbenchmark)
microbenchmark(for_loop_approach(), dplyr_approach(), unit="relative", times=100L)

Unit: relative
                expr      min      lq    mean   median       uq      max neval
 for_loop_approach() 20.97948 20.6478 18.8189 17.81437 17.91815 11.76743   100
    dplyr_approach()  1.00000  1.0000  1.0000  1.00000  1.00000  1.00000   100
There were 50 or more warnings (use warnings() to see the first 50)