如何按组汇总数据，通过创建虚拟变量作为折叠方法
Posted
技术标签:
【中文标题】如何按组汇总数据，通过创建虚拟变量作为折叠方法【英文标题】：How to summarize data by-group, by creating dummy variables as the collapsing method 【发布时间】：2021-12-19 02:28:30 【问题描述】：我正在尝试按组汇总数据集，以便为每个组的值是否出现在数据的 未分组 最频繁值中设置虚拟列。
作为一个例子，让我们从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
第三步
现在只需获取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)
【问题讨论】：
【参考方案1】：很有可能在这里使用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 个最常见的 dest 值定义“最受欢迎”，然后与所有月份的前 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月最可取的5个方向之一。
同时，只有 7 月、9 月和 10 月是正确的。
捍卫自己的解决方案
虽然我还没有进行任何性能测试，但我想指出，如果我返回不正确的结果，即使是最快的解决方案也将毫无用处。
现在对您自己的解决方案进行一点辩护。我知道，我知道，这听起来很不礼貌。
首先，我通过一个简单的突变通过三个简单明了的步骤获得了所需的一切。
其次，在整个过程中，我不需要任何中间表。
第三，我保留了数据的原始形式，只补充了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))，这会将每次出现的 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 倍。
性能测试
请原谅我还没有进行性能测试。也许很快。但是，对于所有想进行比较的人，请考虑两个非常重要的事实。首先，我将数据框保留为原始形式。其次，我在计算中确定了最受欢迎的方向。请将此纳入您可能的性能测试中。
最后的道歉
当然，我认为我可能在某个地方错了。也许我误读了问题的作者？英语不是我的母语，所以我在阅读这些假设时可能会犯错误。但是，我不知道错误在哪里，也不知道为什么我们的结果不同。
【讨论】：
谢谢。但是，我很难使用您的方法实现所需的输出。 （请参阅上面我的问题中的 desired output 演示）。您能否展示一下您是如何从您的df 转到我的期望输出 的？
他很乐意为您展示，但请说明出口是否必须如图所示，或者您是否对给定月份哪些航班将到达 topDest 感兴趣。
谢谢。我不确定我明白你的意思。在我原来的帖子中，我指定了所需的输出和我用来实现它的代码（由于性能我不喜欢的代码）。所以我只是想了解如何从您的df 到确切地我的op_slow_output，所以如果我们在您之间运行identical() 或waldo::compare()输出并挖掘op_slow_output，我们将得到TRUE 或No differences。
以下代码使我们更接近所需的输出：df %>% ungroup() %>% mutate(new_col = map(.x = topDest, ~my_flights_top_dest_across_months %in% .x), .keep = "unused") %>% unnest_wider(new_col, names_repair = ~c("year", "month", "carrier", my_flights_top_dest_across_months))。但是，如果您将其输出与op_slow_output 进行比较，您会发现里面的值不匹配。显然我重新定位了列以匹配。尽管如此，表之间的值还是不一致的。
请查看我自己发布的答案。我很乐意将您的数据添加到基准测试中。【参考方案2】：
更新
我使用以下解决方案改进了我的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
【讨论】：
谢谢。但请注意，您的结果与我的有些不同。让我们从我的问题中拿op_slow_output 进行比较。然后将您的输出和子集列带到c("carrier", "month", my_flights_top_dest_across_months)。然后在op_slow_output 和您的输出（子集）之间运行waldo::compare()。数据中有几个不匹配的地方。
@Emman 查看我的更新
谢谢。我现在只得到 132 行的输出，与你的不同：/ 如果你得到 185 行，你介意用reprex() 发布你的代码吗？
@Emman 抱歉，我粘贴了错误的代码。你可以看看我现在的那个。
太棒了！现在它可以工作了。谢谢！【参考方案3】：
这是你想要的吗？据我所知，它与您的输出相匹配，但有更多行，因为它包括所有运营商的所有月份； 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)
【讨论】：
谢谢。我已经在我的真实数据上对其进行了测试，并得到了以下错误：Long vectors are not yet supported. Requested output size must be less than 2147483647。这是响应tidyr::complete() 触发的。这一步有解决方法吗？
我也尝试过this answer 中的completeDT()。我遇到了类似的错误：Cross product of elements provided to CJ() would result in 92034444580 rows which exceeds .Machine$integer.max == 2147483647【参考方案4】：
我自己做了一个存根，使用 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)
【讨论】：
有趣的基准测试，我会看看data.table是否有一些改进。以上是关于如何按组汇总数据，通过创建虚拟变量作为折叠方法的主要内容，如果未能解决你的问题，请参考以下文章