如何通过创建虚拟变量作为折叠方法来按组汇总数据
How to summarize data by-group, by creating dummy variables as the collapsing method
我正在尝试按组汇总数据集，以便为每个组的值是否出现在数据的 未分组 最频繁值中设置虚拟列。
例如，让我们从 nycflights13.
获取 flights 数据
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 个 dest 值，然后与所有月份的前 5 个值相交。
步骤 1
我从按月简单汇总开始：
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
现在只需获取 my_flights_top_5_by_month$dest 的 unique():
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 的每个组合是否对 my_flights_top_dest_across_months 中的每个 dest 值都有缺陷？
期望输出
## 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)
这是否符合您的要求？据我所知，它与您的输出匹配，但行数更多，因为它包括所有运营商的所有月份； carrier“OO”只有 5 个月内的航班，您的版本在摘要中只显示这 5 个月。
使用提供的数据（336k 行），这需要与您的函数相似的时间，但处理更大的数据时速度更快。当我 运行 这些数据在设置 my_flights_raw <- my_flights_raw %>% tidyr::uncount(100) 后大 100 倍时，使其达到 33M 行，下面的代码大约快 40%。
考虑到您要处理的群组数量众多，我预计在这种情况下 data.table 会以更好的性能真正发挥作用。
library(tidyverse)
my_flights_raw %>%
count(carrier, month, dest) %>%
complete(carrier, month, dest) %>%
filter(dest %in% my_flights_top_dest_across_months) %>%
mutate(n = if_else(!is.na(n), TRUE, FALSE)) %>%
pivot_wider(names_from = dest, values_from = n)
很有可能在这里使用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
但让我逐步描述这里发生的事情。
在第一步中，我们将数据嵌套到一个名为 data.
的内部 tibble 中
步骤 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方向是1月至10月最理想的五个方向之一。
同时，只有七月、九月和十月是正确的。
捍卫自己的解决方案
虽然我还没有 运行 任何性能测试，但我想指出，如果我 return 不正确的结果，即使是最快的解决方案也没有用。
现在稍微辩护一下自己的解法。我知道我知道，听起来很不谦虚
首先，我通过三个简单明了的步骤获得了我需要的一切，只需一个简单的突变。
其次，在整个过程中，我不需要任何中间表。
第三，我保留了数据的原始形式，仅补充了 carrierToToDest 变量，这意味着飞往前 5 个方向之一的航班，这将极大地方便后续过滤和进一步处理此数据。
所以让我提醒您需要做什么，然后重新assemble下面我们需要的所有代码。
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
主要区别在于 数据与假设 相比是正确的，尽管它具有值 NA.
而不是 FALSE
当然，没有什么能阻止您在末尾添加 mutate_if(is.logical, ~ifelse(is.na(.x), FALSE, .x))，这会将每个出现的 NA 替换为 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 倍。
性能测试
原谅我还没有做性能测试。也许很快。但是，对于所有想要进行比较的人，请考虑两个非常重要的事实。首先，我保留了数据框的原始形式。其次，我在计算中确定了最受欢迎的方向。请将其包含在您可能的性能测试中。
最后的道歉
当然，我想我可能有地方错了。也许我误解了问题的作者？英语不是我的母语，所以我可能在阅读这些假设时犯了错误。但是，我不知道错误在哪里，也不知道为什么我们的结果不同。
更新
我用以下
改进了我的 data.table 解决方案
thomas_data.table2 <- function() {
library(data.table)
dcast(
data.table(dest = my_flights_top_dest_across_months)[
unique(setDT(my_flights_raw)),
on = .(dest)
],
carrier + month ~ dest
)[
,
.(carrier, month, .SD[, my_flights_top_dest_across_months, with = FALSE] > 0)
]
}
基准如下所示
这是基准测试脚本：
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.table1 <- 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]
}
thomas_data.table2 <- function() {
library(data.table)
dcast(
data.table(dest = my_flights_top_dest_across_months)[
unique(setDT(my_flights_raw)),
on = .(dest)
],
carrier + month ~ dest
)[
,
.(carrier, month, .SD[, my_flights_top_dest_across_months, with = FALSE] > 0)
]
}
# output_op_slow <- op_slow()
# output_op_collapse <- op_collapse()
# output_thomas1 <- thomas_data.table1()
# output_thomas2 <- thomas_data.table2()
# #> 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_thomas1), ignore_attr = TRUE)
# #> v No differences
bm <- bench::mark(
op_slow = op_slow(),
op_collapse = op_collapse(),
thomas_dt1 = thomas_data.table1(),
thomas_dt2 = thomas_data.table2(),
check = FALSE,
iterations = 100L
)
ggplot2::autoplot(bm)
上一个答案
给定 my_flights_top_5_by_month 和 my_flights_raw，我们可以尝试以下 data.table 方法
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]
这给出了
carrier month ATL ORD BOS MCO FLL LAX SFO CLT
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
---
181: YV 8 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
182: YV 9 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
183: YV 10 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
184: YV 11 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
185: YV 12 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
我自己做了一个存根，使用了 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 混合匹配解决方案要慢。
我还在 Thomas 的回答中考虑了单个 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)
我正在尝试按组汇总数据集，以便为每个组的值是否出现在数据的 未分组 最频繁值中设置虚拟列。
例如，让我们从 nycflights13.
flights 数据
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 个 dest 值，然后与所有月份的前 5 个值相交。
步骤 1
我从按月简单汇总开始：
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
现在只需获取 my_flights_top_5_by_month$dest 的 unique():
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 的每个组合是否对 my_flights_top_dest_across_months 中的每个 dest 值都有缺陷？
期望输出
## 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)
这是否符合您的要求？据我所知，它与您的输出匹配，但行数更多，因为它包括所有运营商的所有月份； carrier“OO”只有 5 个月内的航班，您的版本在摘要中只显示这 5 个月。
使用提供的数据（336k 行），这需要与您的函数相似的时间，但处理更大的数据时速度更快。当我 运行 这些数据在设置 my_flights_raw <- my_flights_raw %>% tidyr::uncount(100) 后大 100 倍时，使其达到 33M 行，下面的代码大约快 40%。
考虑到您要处理的群组数量众多，我预计在这种情况下 data.table 会以更好的性能真正发挥作用。
library(tidyverse)
my_flights_raw %>%
count(carrier, month, dest) %>%
complete(carrier, month, dest) %>%
filter(dest %in% my_flights_top_dest_across_months) %>%
mutate(n = if_else(!is.na(n), TRUE, FALSE)) %>%
pivot_wider(names_from = dest, values_from = n)
很有可能在这里使用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
但让我逐步描述这里发生的事情。
在第一步中，我们将数据嵌套到一个名为 data.
tibble 中
步骤 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方向是1月至10月最理想的五个方向之一。
同时，只有七月、九月和十月是正确的。
捍卫自己的解决方案
虽然我还没有 运行 任何性能测试，但我想指出，如果我 return 不正确的结果，即使是最快的解决方案也没有用。
现在稍微辩护一下自己的解法。我知道我知道，听起来很不谦虚
首先，我通过三个简单明了的步骤获得了我需要的一切，只需一个简单的突变。
其次，在整个过程中，我不需要任何中间表。
第三，我保留了数据的原始形式，仅补充了 carrierToToDest 变量，这意味着飞往前 5 个方向之一的航班，这将极大地方便后续过滤和进一步处理此数据。
所以让我提醒您需要做什么，然后重新assemble下面我们需要的所有代码。
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
主要区别在于 数据与假设 相比是正确的，尽管它具有值 NA.
FALSE
当然，没有什么能阻止您在末尾添加 mutate_if(is.logical, ~ifelse(is.na(.x), FALSE, .x))，这会将每个出现的 NA 替换为 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 倍。
性能测试
原谅我还没有做性能测试。也许很快。但是，对于所有想要进行比较的人，请考虑两个非常重要的事实。首先，我保留了数据框的原始形式。其次，我在计算中确定了最受欢迎的方向。请将其包含在您可能的性能测试中。
最后的道歉
当然，我想我可能有地方错了。也许我误解了问题的作者？英语不是我的母语，所以我可能在阅读这些假设时犯了错误。但是，我不知道错误在哪里，也不知道为什么我们的结果不同。
更新
我用以下
改进了我的data.table 解决方案
thomas_data.table2 <- function() {
library(data.table)
dcast(
data.table(dest = my_flights_top_dest_across_months)[
unique(setDT(my_flights_raw)),
on = .(dest)
],
carrier + month ~ dest
)[
,
.(carrier, month, .SD[, my_flights_top_dest_across_months, with = FALSE] > 0)
]
}
基准如下所示
这是基准测试脚本：
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.table1 <- 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]
}
thomas_data.table2 <- function() {
library(data.table)
dcast(
data.table(dest = my_flights_top_dest_across_months)[
unique(setDT(my_flights_raw)),
on = .(dest)
],
carrier + month ~ dest
)[
,
.(carrier, month, .SD[, my_flights_top_dest_across_months, with = FALSE] > 0)
]
}
# output_op_slow <- op_slow()
# output_op_collapse <- op_collapse()
# output_thomas1 <- thomas_data.table1()
# output_thomas2 <- thomas_data.table2()
# #> 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_thomas1), ignore_attr = TRUE)
# #> v No differences
bm <- bench::mark(
op_slow = op_slow(),
op_collapse = op_collapse(),
thomas_dt1 = thomas_data.table1(),
thomas_dt2 = thomas_data.table2(),
check = FALSE,
iterations = 100L
)
ggplot2::autoplot(bm)
上一个答案
给定 my_flights_top_5_by_month 和 my_flights_raw，我们可以尝试以下 data.table 方法
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]
这给出了
carrier month ATL ORD BOS MCO FLL LAX SFO CLT
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
---
181: YV 8 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
182: YV 9 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
183: YV 10 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
184: YV 11 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
185: YV 12 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
我自己做了一个存根，使用了 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 混合匹配解决方案要慢。
我还在 Thomas 的回答中考虑了单个 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)