Ваш код еще не предназначен для машиночитания.Машины намного лучше читают «длинные» данные и выполняют операции группировки и объединения.
Когда вы ищете x %in% y, вы выполняете много сравнений.Затем выполнение строковых операций также замедляет работу (разбиение строки должно найти, где разбить строку).Я бы предложил преобразовать все ваши данные в длинный формат и оставить его в длинном формате, пока вам не понадобится широкий формат для просмотра человеком.Но я даю вам вывод в вашем формате, потому что вопрос требует его.
Большая часть кода ниже преобразует ваши данные в длинный формат данных.Я добавил дополнительные шаги в коде, чтобы попытаться разобрать, как выглядят данные, поступающие в вычисления.
library(dplyr)
library(tidyr)
library(stringr)
df = data.frame(animals.1 = c("cat; dog; bird", "dog; bird", "bird", "dog"), animals.2 = c("cat; dog; bird","dog; bird; seal", "bird", ""),year= c("2001","2005","2010","2018"), stringsAsFactors = F)
# Convert the animal.1 column to long data
animals_1_long <- df %>%
rowwise() %>%
mutate(
animals_1 = str_split(animals.1,"; ")
) %>%
select(animals_1,year) %>%
unnest()
# # A tibble: 7 x 2
# year animals_1
# <chr> <chr>
# 1 2001 cat
# 2 2001 dog
# 3 2001 bird
# 4 2005 dog
# 5 2005 bird
# 6 2010 bird
# 7 2018 dog
# Similarly convert the animal.2 column to long data
animals_2_long <- df %>%
rowwise() %>%
mutate(
animals_2 = str_split(animals.2,"; ")
) %>%
select(animals_2,year) %>%
unnest()
# Since we want to match for the last 5 years, create a match index for year-4 to year.
animals_2_long_extend_5yrs <- animals_2_long %>%
rename(index_year = year) %>%
rowwise() %>%
mutate(match_year = list(as.character((as.numeric(index_year)-4):as.numeric(index_year)))) %>%
unnest()
# # A tibble: 40 x 3
# index_year animals_2 match_year
# <chr> <chr> <chr>
# 1 2001 cat 1997
# 2 2001 cat 1998
# 3 2001 cat 1999
# 4 2001 cat 2000
# 5 2001 cat 2001
# 6 2001 dog 1997
# 7 2001 dog 1998
# 8 2001 dog 1999
# 9 2001 dog 2000
# 10 2001 dog 2001
На данный момент данные animal_1 представлены в длинном формате с одним животным / годом на строку.Данные animal_2 представлены в длинном формате с одним животным / match_year / index_year на строку.Это позволяет второму набору данных охватить все последние 5 лет в одном объединении, но затем суммировать его до года, который нас изначально интересует.
Объединение двух длинных наборов данных оставляет только те строки, в которых год совпадаетmatch_year и имя животного совпадают.Затем тривиально суммировать количество строк, оставшихся в index_year.
# Join the long data and the long data with the extended match index
animal_check <- animals_1_long %>%
rename(match_year = year) %>%
left_join(animals_2_long_extend_5yrs) %>%
filter(animals_1 == animals_2) %>%
# group by the index year and summarize the count
group_by(index_year) %>%
summarise(count = n()) %>%
rename(year = index_year)
# # A tibble: 3 x 2
# year count
# <chr> <int>
# 1 2001 3
# 2 2005 4
# 3 2010 1
На этом этапе вычисление выполнено.Осталось только добавить счет к данным с животными.
# Join the yearly result back to the original dataframe
df <- df %>%
left_join(animal_check)
df
# animals.1 animals.2 year count
# 1 cat; dog; bird cat; dog; bird 2001 3
# 2 dog; bird dog; bird; seal 2005 4
# 3 bird bird 2010 1
# 4 dog 2018 NA
Обновление:
# Data for benchmark:
df = data.frame(animals.1 = c("cat; dog; bird", "dog; bird", "bird", "dog"),
animals.2 = c("cat; dog; bird","dog; bird; seal", "bird", ""),
stringsAsFactors = F)
df <- replicate(10000,{df}, simplify=F) %>% do.call(rbind, .)
df$year <- as.character(seq(2000,2000 + nrow(df) - 1))
# microbenchmark results
min lq mean median uq max neval
5.785196 5.950748 6.642028 6.981055 7.001854 7.491287 5