如何通过创建虚拟变量作为折叠方法来按组汇总数据
Emm*_*man 15 performance r dummy-variable
我正在尝试按组汇总数据集，以使用虚拟列来确定每个组的值是否出现在数据的未分组的最常见值中。
作为示例，让我们flights从 中获取数据nycflights13。
library(dplyr, warn.conflicts = FALSE)
library(nycflights13)
my_flights_raw <-
flights %>%
select(carrier, month, dest)
my_flights_raw
#> # A tibble: 336,776 x 3
#> carrier month dest
#> <chr> <int> <chr>
#> 1 UA 1 IAH
#> 2 UA 1 IAH
#> 3 AA 1 MIA
#> 4 B6 1 BQN
#> 5 DL 1 ATL
#> 6 UA 1 ORD
#> 7 B6 1 FLL
#> 8 EV 1 IAD
#> 9 B6 1 MCO
#> 10 AA 1 ORD
#> # ... with 336,766 more rows
我的最终目标：我有兴趣了解每carrier一个month：它是否飞往最受欢迎的目的地。我通过每个月中
最常见的前 5 个值来定义“最受欢迎” ，然后将所有月份的前 5 个值相交。步骤 1
我首先按月进行简单聚合：dest
my_flights_agg <-
my_flights_raw %>%
count(month, dest, name = "n_obs") %>%
arrange(month, desc(n_obs))
my_flights_agg
#> # A tibble: 1,113 x 3
#> month dest n_obs
#> <int> <chr> <int>
#> 1 1 ATL 1396
#> 2 1 ORD 1269
#> 3 1 BOS 1245
#> 4 1 MCO 1175
#> 5 1 FLL 1161
#> 6 1 LAX 1159
#> 7 1 CLT 1058
#> 8 1 MIA 981
#> 9 1 SFO 889
#> 10 1 DCA 865
#> # ... with 1,103 more rows
步骤 2
现在我要削减数据，只保留每月最受欢迎的前 5 名。
my_flights_top_5_by_month <-
my_flights_agg %>%
group_by(month) %>%
slice_max(order_by = n_obs, n = 5)
my_flights_top_5_by_month
#> # A tibble: 60 x 3
#> # Groups: month [12]
#> month dest n_obs
#> <int> <chr> <int>
#> 1 1 ATL 1396
#> 2 1 ORD 1269
#> 3 1 BOS 1245
#> 4 1 MCO 1175
#> 5 1 FLL 1161
#> 6 2 ATL 1267
#> 7 2 ORD 1197
#> 8 2 BOS 1182
#> 9 2 MCO 1110
#> 10 2 FLL 1073
#> # ... with 50 more rows
步骤 3
现在只需unique()获取my_flights_top_5_by_month$dest：
my_flights_top_dest_across_months <- unique(my_flights_top_5_by_month$dest)
## [1] "ATL" "ORD" "BOS" "MCO" "FLL" "LAX" "SFO" "CLT"
这是我的问题：给定my_flights_top_dest_across_months，我如何总结my_flights_raw为不同的carrier& month，这样折叠原则就是carrier&的每个组合是否month对每个dest值都有缺陷my_flights_top_dest_across_months？
期望的输出
## carrier month ATL ORD BOS MCO FLL LAX SFO CLT
## <chr> <int> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
## 1 9E 1 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 2 9E 2 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 3 9E 3 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 4 9E 4 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 5 9E 5 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 6 9E 6 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 7 9E 7 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 8 9E 8 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 9 9E 9 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 10 9E 10 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## # ... with 175 more rows
我目前有以下代码，效率很低。它适用于示例flights数据，但在应用于大型数据集（具有数百万行和组）时会花费很长时间。知道如何更有效地完成上述任务吗？
# too slow :(
op_slow_output <-
my_flights_raw %>%
group_by(carrier, month) %>%
summarise(destinations_vec = list(unique(dest))) %>%
add_column(top_dest = list(my_flights_top_dest_across_month)) %>%
mutate(are_top_dest_included = purrr::map2(.x = destinations_vec, .y = top_dest, .f = ~ .y %in% .x ), .keep = "unused") %>%
mutate(across(are_top_dest_included, ~purrr::map(.x = ., .f = ~setNames(object = .x, nm = my_flights_top_dest_across_month)) )) %>%
tidyr::unnest_wider(are_top_dest_included)
在这里使用库很可能data.table会更快。我不会争论。但我已经掌握了dplyr，并希望使用这个特定库中的功能提供一个非常酷的解决方案。
首先，我们准备两个小辅助函数。我们稍后会看到它们是如何工作的。
library(nycflights13)
library(tidyverse)
ftopDest = function(data, ntop){
data %>%
group_by(dest) %>%
summarise(ndest = n()) %>%
arrange(desc(ndest)) %>%
pull(dest) %>% .[1:ntop]
}
carrierToTopDest = function(data, topDest){
data %>% mutate(carrierToToDest = dest %in% topDest)
}
现在你只需要一个简单的突变！
df = flights %>% nest_by(year, month) %>% #Step 1
mutate(topDest = list(ftopDest(data, 5)), #Step 2
data = list(carrierToTopDest(data, topDest))) #Step 3
但让我一步步描述这里发生的事情。
在第一步中，让我们将数据嵌套到一个tibble名为 的内部data。
步骤 1 后的输出
# A tibble: 12 x 3
# Rowwise: year, month
year month data
<int> <int> <list<tibble[,17]>>
1 2013 1 [27,004 x 17]
2 2013 2 [24,951 x 17]
3 2013 3 [28,834 x 17]
4 2013 4 [28,330 x 17]
5 2013 5 [28,796 x 17]
6 2013 6 [28,243 x 17]
7 2013 7 [29,425 x 17]
8 2013 8 [29,327 x 17]
9 2013 9 [27,574 x 17]
10 2013 10 [28,889 x 17]
11 2013 11 [27,268 x 17]
12 2013 12 [28,135 x 17]
在步骤 2 中，我们添加最受欢迎的航班目的地。
步骤2后的输出
# A tibble: 12 x 4
# Rowwise: year, month
year month data topDest
<int> <int> <list<tibble[,17]>> <list>
1 2013 1 [27,004 x 17] <chr [5]>
2 2013 2 [24,951 x 17] <chr [5]>
3 2013 3 [28,834 x 17] <chr [5]>
4 2013 4 [28,330 x 17] <chr [5]>
5 2013 5 [28,796 x 17] <chr [5]>
6 2013 6 [28,243 x 17] <chr [5]>
7 2013 7 [29,425 x 17] <chr [5]>
8 2013 8 [29,327 x 17] <chr [5]>
9 2013 9 [27,574 x 17] <chr [5]>
10 2013 10 [28,889 x 17] <chr [5]>
11 2013 11 [27,268 x 17] <chr [5]>
12 2013 12 [28,135 x 17] <chr [5]>
在最后一步中，我们将carrierToToDest变量添加到data变量中，该变量确定航班是否飞往给ntop定月份的某个地点。
步骤3后的输出
# A tibble: 12 x 4
# Rowwise: year, month
year month data topDest
<int> <int> <list> <list>
1 2013 1 <tibble [27,004 x 18]> <chr [5]>
2 2013 2 <tibble [24,951 x 18]> <chr [5]>
3 2013 3 <tibble [28,834 x 18]> <chr [5]>
4 2013 4 <tibble [28,330 x 18]> <chr [5]>
5 2013 5 <tibble [28,796 x 18]> <chr [5]>
6 2013 6 <tibble [28,243 x 18]> <chr [5]>
7 2013 7 <tibble [29,425 x 18]> <chr [5]>
8 2013 8 <tibble [29,327 x 18]> <chr [5]>
9 2013 9 <tibble [27,574 x 18]> <chr [5]>
10 2013 10 <tibble [28,889 x 18]> <chr [5]>
11 2013 11 <tibble [27,268 x 18]> <chr [5]>
12 2013 12 <tibble [28,135 x 18]> <chr [5]>
现在我们如何才能看到最受欢迎的地方。我们开工吧：
df %>% mutate(topDest = paste(topDest, collapse = " "))
输出
# A tibble: 12 x 4
# Rowwise: year, month
year month data topDest
<int> <int> <list> <chr>
1 2013 1 <tibble [27,004 x 18]> ATL ORD BOS MCO FLL
2 2013 2 <tibble [24,951 x 18]> ATL ORD BOS MCO FLL
3 2013 3 <tibble [28,834 x 18]> ATL ORD BOS MCO FLL
4 2013 4 <tibble [28,330 x 18]> ATL ORD LAX BOS MCO
5 2013 5 <tibble [28,796 x 18]> ORD ATL LAX BOS SFO
6 2013 6 <tibble [28,243 x 18]> ORD ATL LAX BOS SFO
7 2013 7 <tibble [29,425 x 18]> ORD ATL LAX BOS CLT
8 2013 8 <tibble [29,327 x 18]> ORD ATL LAX BOS SFO
9 2013 9 <tibble [27,574 x 18]> ORD LAX ATL BOS CLT
10 2013 10 <tibble [28,889 x 18]> ORD ATL LAX BOS CLT
11 2013 11 <tibble [27,268 x 18]> ATL ORD LAX BOS CLT
12 2013 12 <tibble [28,135 x 18]> ATL LAX MCO ORD CLT
我们可以看到飞往这些目的地的航班吗？当然，这并不难。
df %>% select(-topDest) %>%
unnest(data) %>%
filter(carrierToToDest) %>%
select(year, month, flight, carrier, dest)
输出
# A tibble: 80,941 x 5
# Groups: year, month [12]
year month flight carrier dest
<int> <int> <int> <chr> <chr>
1 2013 1 461 DL ATL
2 2013 1 1696 UA ORD
3 2013 1 507 B6 FLL
4 2013 1 79 B6 MCO
5 2013 1 301 AA ORD
6 2013 1 1806 B6 BOS
7 2013 1 371 B6 FLL
8 2013 1 4650 MQ ATL
9 2013 1 1743 DL ATL
10 2013 1 3768 MQ ORD
# ... with 80,931 more rows
这是我的食谱。我认为非常简单和透明。如果您能在您的数据上进行尝试并高效地告诉我，我将非常感激。
小更新
我只是注意到我不仅想在year（虽然你没有提到它，但一定是这样）之后进行分组month，而且还想通过carrier变量进行分组。因此，让我们将其添加为另一个分组变量。
df = flights %>% nest_by(year, month, carrier) %>%
mutate(topDest = list(ftopDest(data, 5)),
data = list(carrierToTopDest(data, topDest)))
输出
# A tibble: 185 x 5
# Rowwise: year, month, carrier
year month carrier data topDest
<int> <int> <chr> <list> <list>
1 2013 1 9E <tibble [1,573 x 17]> <chr [5]>
2 2013 1 AA <tibble [2,794 x 17]> <chr [5]>
3 2013 1 AS <tibble [62 x 17]> <chr [5]>
4 2013 1 B6 <tibble [4,427 x 17]> <chr [5]>
5 2013 1 DL <tibble [3,690 x 17]> <chr [5]>
6 2013 1 EV <tibble [4,171 x 17]> <chr [5]>
7 2013 1 F9 <tibble [59 x 17]> <chr [5]>
8 2013 1 FL <tibble [328 x 17]> <chr [5]>
9 2013 1 HA <tibble [31 x 17]> <chr [5]>
10 2013 1 MQ <tibble [2,271 x 17]> <chr [5]>
# ... with 175 more rows
现在让我们来熟悉一下新的前 5 个方向。
df %>% mutate(topDest = paste(topDest, collapse = " "))
输出
# A tibble: 185 x 5
# Rowwise: year, month, carrier
year month carrier data topDest
<int> <int> <chr> <list> <chr>
1 2013 1 9E <tibble [1,573 x 17]> BOS PHL CVG MSP ORD
2 2013 1 AA <tibble [2,794 x 17]> DFW MIA ORD LAX BOS
3 2013 1 AS <tibble [62 x 17]> SEA NA NA NA NA
4 2013 1 B6 <tibble [4,427 x 17]> FLL MCO BOS PBI SJU
5 2013 1 DL <tibble [3,690 x 17]> ATL DTW MCO FLL MIA
6 2013 1 EV <tibble [4,171 x 17]> IAD DTW DCA RDU CVG
7 2013 1 F9 <tibble [59 x 17]> DEN NA NA NA NA
8 2013 1 FL <tibble [328 x 17]> ATL CAK MKE NA NA
9 2013 1 HA <tibble [31 x 17]> HNL NA NA NA NA
10 2013 1 MQ <tibble [2,271 x 17]> RDU CMH ORD BNA ATL
# ... with 175 more rows
总而言之，我想补充一点，该表格对我来说非常清晰。我可以看到最受欢迎的df%>% mutate (topDest = paste (topDest, collapse =" "))路线。我可以过滤飞往最热门目的地的所有航班df%>% select (-topDest)%>% unnest (data)%>% filter (carrierToToDest)%>% select (year, month, flight, carrier, dest)并进行任何其他转换。我认为在 100 多个变量上提供更广泛的相同信息对于任何分析来说都不方便。
但是，如果您确实需要更广泛的形式，请告诉我。我们就这样做吧。
对于任何感兴趣的人来说都是一个重大更新
结果不及预期！
亲爱的同事，当您兴奋地寻找最有效的解决方案时，您陷入了错误的道路，并且错过了获得错误数据的事实！
@Emman 发布了一个明确的任务，如下我有兴趣了解每个月的每个航空公司：是否飞往最受欢迎的目的地。我通过每月前 5 个最常见的目标值来定义“最受欢迎”，然后与所有月份的前 5 个值相交。
按照我的方式解决这个问题，我将在几个月内获得以下最受欢迎的目的地：
df %>% mutate(topDest = paste(topDest, collapse = " ")) %>%
select(topDest)
输出
# A tibble: 12 x 3
# Rowwise: year, month
year month topDest
<int> <int> <chr>
1 2013 1 ATL ORD BOS MCO FLL
2 2013 2 ATL ORD BOS MCO FLL
3 2013 3 ATL ORD BOS MCO FLL
4 2013 4 ATL ORD LAX BOS MCO
5 2013 5 ORD ATL LAX BOS SFO
6 2013 6 ORD ATL LAX BOS SFO
7 2013 7 ORD ATL LAX BOS CLT
8 2013 8 ORD ATL LAX BOS SFO
9 2013 9 ORD LAX ATL BOS CLT
10 2013 10 ORD ATL LAX BOS CLT
11 2013 11 ATL ORD LAX BOS CLT
12 2013 12 ATL LAX MCO ORD CLT
让我们检查一下我是否无意中犯了错误。让我们做一个三个月样本的测试。
flights %>%
filter(month==1) %>%
group_by(dest) %>%
summarise(ndest = n()) %>%
arrange(desc(ndest)) %>%
pull(dest) %>% .[1:5]
#[1] "ATL" "ORD" "BOS" "MCO" "FLL"
flights %>%
filter(month==6) %>%
group_by(dest) %>%
summarise(ndest = n()) %>%
arrange(desc(ndest)) %>%
pull(dest) %>% .[1:5]
#[1] "ORD" "ATL" "LAX" "BOS" "SFO"
flights %>%
filter(month==10) %>%
group_by(dest) %>%
summarise(ndest = n()) %>%
arrange(desc(ndest)) %>%
pull(dest) %>% .[1:5]
#[1] "ORD" "ATL" "LAX" "BOS" "CLT"
好吧，可能很难否认我的结果与结论性测试的结果没有什么不同。
同样很明显的是，无论是一月还是二月，该方向CLT 都不是 5 个最受欢迎的目的地之一！
然而，如果我们将它与@Emman给出的预期结果进行比较，我不得不得出这样的结论：这个预期与最初的假设不一致！
## carrier month ATL ORD BOS MCO FLL LAX SFO CLT
## <chr> <int> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
## 1 9E 1 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 2 9E 2 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 3 9E 3 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 4 9E 4 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 5 9E 5 TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 6 9E 6 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 7 9E 7 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 8 9E 8 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 9 9E 9 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 10 9E 10 FALSE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## # ... with 175 more rows
从问题作者的上述数据可以得出结论，该CLT方向是一月至十月最理想的五个方向之一。同时，只有七月、九月和十月是正确的。
捍卫自己的解决方案
虽然我还没有运行任何性能测试，但我想指出，如果返回不正确的结果，即使是最快的解决方案也毫无用处。
现在对你自己的解决方案进行一点辩护。我知道，我知道，这听起来很不谦虚。
首先，我通过三个简单明了的步骤和一个简单的突变获得了我需要的一切。
其次，在整个过程中，我不需要任何中间表。
第三，我保留了数据的原始形式，只补充了 CarrierToToDest 变量，这意味着飞往前 5 个方向之一的航班，这将极大地方便后续过滤和进一步处理该数据。
因此，让我提醒您需要做什么并重新组装下面我们需要的所有代码。
library(nycflights13)
library(tidyverse)
ftopDest = function(data, ntop){
data %>%
group_by(dest) %>%
summarise(ndest = n()) %>%
arrange(desc(ndest)) %>%
pull(dest) %>% .[1:ntop]
}
carrierToTopDest = function(data, topDest){
data %>% mutate(carrierToToDest = dest %in% topDest)
}
df = flights %>% nest_by(year, month) %>% #Step 1
mutate(topDest = list(ftopDest(data, 5)), #Step 2
data = list(carrierToTopDest(data, topDest))) #Step 3
我还将提醒您如何接收各个月份最受欢迎的目的地。
df %>% mutate(topDest = paste(topDest, collapse = " ")) %>%
select(topDest)
输出
# A tibble: 12 x 3
# Rowwise: year, month
year month topDest
<int> <int> <chr>
1 2013 1 ATL ORD BOS MCO FLL
2 2013 2 ATL ORD BOS MCO FLL
3 2013 3 ATL ORD BOS MCO FLL
4 2013 4 ATL ORD LAX BOS MCO
5 2013 5 ORD ATL LAX BOS SFO
6 2013 6 ORD ATL LAX BOS SFO
7 2013 7 ORD ATL LAX BOS CLT
8 2013 8 ORD ATL LAX BOS SFO
9 2013 9 ORD LAX ATL BOS CLT
10 2013 10 ORD ATL LAX BOS CLT
11 2013 11 ATL ORD LAX BOS CLT
12 2013 12 ATL LAX MCO ORD CLT
carrierToToDest反过来，可以通过这种方式获得原始形式的数据恢复（以及新变量）
df %>% select(-topDest) %>% unnest(data)
输出
# A tibble: 336,776 x 20
# Groups: year, month [12]
year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time arr_delay carrier flight tailnum origin
<int> <int> <int> <int> <int> <dbl> <int> <int> <dbl> <chr> <int> <chr> <chr>
1 2013 1 1 517 515 2 830 819 11 UA 1545 N14228 EWR
2 2013 1 1 533 529 4 850 830 20 UA 1714 N24211 LGA
3 2013 1 1 542 540 2 923 850 33 AA 1141 N619AA JFK
4 2013 1 1 544 545 -1 1004 1022 -18 B6 725 N804JB JFK
5 2013 1 1 554 600 -6 812 837 -25 DL 461 N668DN LGA
6 2013 1 1 554 558 -4 740 728 12 UA 1696 N39463 EWR
7 2013 1 1 555 600 -5 913 854 19 B6 507 N516JB EWR
8 2013 1 1 557 600 -3 709 723 -14 EV 5708 N829AS LGA
9 2013 1 1 557 600 -3 838 846 -8 B6 79 N593JB JFK
10 2013 1 1 558 600 -2 753 745 8 AA 301 N3ALAA LGA
# ... with 336,766 more rows, and 7 more variables: dest <chr>, air_time <dbl>, distance <dbl>, hour <dbl>,
# minute <dbl>, time_hour <dttm>, carrierToToDest <lgl>
数据符合@Emman 的预期
但是，如果我想以类似于 @Emman 期望的形式呈现这些数据，我总是可以这样做。
df %>% select(-topDest) %>%
unnest(data) %>%
filter(carrierToToDest) %>%
group_by(carrier, month, dest) %>%
summarise(v= T, .groups="drop") %>%
pivot_wider(names_from = dest, values_from = v)
输出
# A tibble: 125 x 10
carrier month ATL BOS ORD CLT FLL MCO LAX SFO
<chr> <int> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
1 9E 1 TRUE TRUE TRUE NA NA NA NA NA
2 9E 2 TRUE TRUE TRUE NA NA NA NA NA
3 9E 3 TRUE TRUE TRUE NA NA NA NA NA
4 9E 4 NA TRUE TRUE NA NA NA NA NA
5 9E 5 TRUE TRUE TRUE NA NA NA NA NA
6 9E 6 NA TRUE TRUE NA NA NA NA NA
7 9E 7 NA TRUE TRUE TRUE NA NA NA NA
8 9E 8 NA TRUE TRUE NA NA NA NA NA
9 9E 9 NA TRUE TRUE TRUE NA NA NA NA
10 9E 10 NA TRUE TRUE TRUE NA NA NA NA
# ... with 115 more rows
主要区别在于数据相对于假设是正确的，尽管FALSE它具有值NA。
当然，没有什么可以阻止您mutate_if(is.logical, ~ifelse(is.na(.x), FALSE, .x))在末尾添加，这将替换所有出现的NAwith FALSE。
附加统计数据
我建议的数据组织形式还可以让您轻松提取额外的统计数据和各种有用的信息。例如，如果您想知道哪家航空公司运营飞往最受欢迎目的地的航班最多，您可以执行以下操作：
df %>% select(-topDest) %>%
unnest(data) %>%
group_by(carrier, carrierToToDest) %>%
summarise(n = n(), .groups="drop") %>%
pivot_wider(names_from = carrierToToDest, values_from = n) %>%
mutate(prop = `TRUE`/`FALSE`)%>%
arrange(desc(prop))
输出
# A tibble: 16 x 4
carrier `FALSE` `TRUE` prop
<chr> <int> <int> <dbl>
1 FL 923 2337 2.53
2 VX 2387 2775 1.16
3 US 12866 7670 0.596
4 DL 31978 16132 0.504
5 AA 21793 10936 0.502
6 UA 39719 18946 0.477
7 YV 434 167 0.385
8 B6 43170 11465 0.266
9 MQ 21146 5251 0.248
10 9E 16464 1996 0.121
11 EV 50967 3206 0.0629
12 OO 31 1 0.0323
13 WN 12216 59 0.00483
14 AS 714 NA NA
15 F9 685 NA NA
16 HA 342 NA NA
正如您所看到的，按年度计算，FL飞往最受欢迎目的地的每月航班最多。另一方面，AS， F9并且HA从未进行过此类航班。
但也许您每月都对它感兴趣。没有什么比这更简单的了。只需这样做：
df %>% select(-topDest) %>%
unnest(data) %>%
group_by(month, carrier, carrierToToDest) %>%
summarise(n = n(), .groups="drop") %>%
pivot_wider(names_from = carrierToToDest, values_from = n) %>%
mutate(prop = `TRUE`/`FALSE`) %>%
arrange(desc(prop))
输出
# A tibble: 185 x 5
month carrier `FALSE` `TRUE` prop
<int> <chr> <int> <int> <dbl>
1 5 VX 31 465 15
2 6 VX 30 450 15
3 8 VX 31 458 14.8
4 9 YV 9 33 3.67
5 10 FL 58 178 3.07
6 5 FL 85 240 2.82
7 4 FL 82 229 2.79
8 3 FL 85 231 2.72
9 2 FL 80 216 2.7
10 1 FL 89 239 2.69
# ... with 175 more rows
正如您在此处所看到的，获胜者是VX，在 5 月、6 月和 8 月，该公司飞往前 5 名的航班频率是其他地区的 15 倍。
性能测试
请原谅我还没有进行性能测试。也许很快。然而，对于所有想要进行比较的人来说，请考虑两个非常重要的事实。首先，我保留数据框的原始形式。其次，我在计算中确定了最受欢迎的方向。请将其包含在您可能的性能测试中。
最后的道歉
当然，我认为我可能在某些地方是错的。也许我误解了问题的作者？英语不是我的母语，所以我在阅读这些假设时可能会犯错误。但是，我不知道错误在哪里，也不知道为什么我们的结果不同。
我自己使用collapse包中的函数做了一个存根。
library(magrittr)
library(collapse)
library(data.table)
my_flights_raw %>%
collapse::funique() %>%
collapse::fgroup_by(carrier, month) %>%
collapse::fsummarise(nested_dest = list(dest)) %>%
collapse::ftransform(new_col = lapply(nested_dest, \(x) my_flights_top_dest_across_months %in% x)) %>%
collapse::fcompute(., data.table::transpose(new_col), keep = 1:2) %>%
setNames(c("carrier", "month", my_flights_top_dest_across_months)) %>%
collapse::qTBL()
毫不奇怪，collapse给出了最快的执行时间。但我惊讶地发现 @ThomasIsCoding 的解决方案比我原来的混合匹配解决方案data.table慢。tidyverse
与我原来方法中的各种依赖关系相比，我还考虑了data.table托马斯答案中的单一依赖关系。
library(nycflights13)
library(dplyr, warn.conflicts = FALSE)
# OP original
my_flights_raw <-
flights %>%
select(carrier, month, dest)
my_flights_agg <-
my_flights_raw %>%
count(month, dest, name = "n_obs") %>%
arrange(month, desc(n_obs))
my_flights_top_dest_across_months <-
my_flights_agg %>%
group_by(month) %>%
slice_max(order_by = n_obs, n = 5) %>%
pull(dest) %>%
unique()
my_flights_top_5_by_month <-
my_flights_agg %>%
group_by(month) %>%
slice_max(order_by = n_obs, n = 5)
my_flights_top_dest_across_month <- unique(my_flights_top_5_by_month$dest)
op_slow <- function() {
library(tidyr)
library(tibble)
library(purrr)
my_flights_raw %>%
group_by(carrier, month) %>%
summarise(destinations_vec = list(unique(dest))) %>%
add_column(top_dest = list(my_flights_top_dest_across_month)) %>%
mutate(are_top_dest_included = purrr::map2(.x = destinations_vec, .y = top_dest, .f = ~ .y %in% .x ), .keep = "unused") %>%
mutate(across(are_top_dest_included, ~purrr::map(.x = ., .f = ~setNames(object = .x, nm = my_flights_top_dest_across_month)) )) %>%
tidyr::unnest_wider(are_top_dest_included)
}
# OP collapse
op_collapse <- function() {
library(magrittr)
library(collapse)
library(data.table)
my_flights_raw %>%
collapse::funique() %>%
collapse::fgroup_by(carrier, month) %>%
collapse::fsummarise(nested_dest = list(dest)) %>%
collapse::ftransform(new_col = lapply(nested_dest, \(x) my_flights_top_dest_across_months %in% x)) %>%
collapse::fcompute(., data.table::transpose(new_col), keep = 1:2) %>%
setNames(c("carrier", "month", my_flights_top_dest_across_months)) %>%
collapse::qTBL()
}
# Thomas data.table
thomas_data.table <- function() {
library(data.table)
my_flights_top_dest_across_months <-
data.table(
dest = unique(my_flights_top_5_by_month$dest),
fd = 1
)
dcast(my_flights_top_dest_across_months[
setDT(my_flights_raw),
on = .(dest)
],
carrier + month ~ dest,
fun.aggregate = function(x) sum(x) > 0
)[, c(
"carrier", "month",
my_flights_top_dest_across_months$dest
), with = FALSE]
}
output_op_slow <- op_slow()
output_op_collapse <- op_collapse()
output_thomas <- thomas_data.table()
#> Using 'month' as value column. Use 'value.var' to override
waldo::compare(output_op_slow, output_op_collapse, ignore_attr = TRUE)
#> v No differences
waldo::compare(output_op_slow, as_tibble(output_thomas), ignore_attr = TRUE)
#> v No differences
bm <- bench::mark(op_slow = op_slow(),
op_collapse = op_collapse(),
thomas_dt = thomas_data.table(),
check = FALSE,
iterations = 100)
ggplot2::autoplot(bm)
