如何按组查找滚动列中的前 3 个值？答案

【问题标题】：How to find rolling top 3 values in a column by group?如何按组查找滚动列中的前 3 个值？
【发布时间】：2020-12-18 13:09:27
【问题描述】：

一个数据框有 3 列

-----------------------------------------
|    Id    |    Country    |    Date    |
-----------------------------------------

3栏记录人的旅行历史。

需要再创建 3 列来表示此人 (ID)在该行日期之前之前最常前往的前 3 个国家/地区。

（如果 2 个国家出现并列，则以最近旅行的国家为准。）

    mydata <- data.frame(ID = c('A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A2B2', 'A2B2', 'A2B2', 'A2B2', 'A2B2', 'A2B2'), 
                         Country = c('Japan', 'USA', 'USA', 'USA', 'Germany', 'Germany', 'Japan', 'France', 'UK', 'Spain', 'Spain', 'UK', 'UK', 'Brazil'), 
                         Date = as.Date(c('2010/01/02', '2010/04/18', '2011/03/22', '2011/11/23', '2012/05/09', '2012/09/11', '2014/01/06', '2015/12/11', '2010/04/03', '2010/05/11', '2011/05/01', '2012/03/01', '2013/01/03', '2014/01/04')))

    # final data should look like below
    
    #ID    Country  Date          Pref1   Pref2   Pref3
    #A1B1  Japan    2010-01-02    NA      NA      NA
    #A1B1  USA      2010-04-18    Japan   NA      NA
    #A1B1  USA      2011-03-22    USA     Japan   NA
    #A1B1  USA      2011-11-23    USA     Japan   NA
    #A1B1  Germany  2012-05-09    USA     Japan   NA
    #A1B1  Germany  2012-09-11    USA     Germany Japan
    #A1B1  Japan    2014-01-06    USA     Germany Japan
    #A1B1  France   2015-12-11    USA     Japan   Germany
    #A2B2  UK       2010-04-03    NA      NA      NA
    #A2B2  Spain    2010-05-11    UK      NA      NA
    #A2B2  Spain    2011-05-01    Spain   UK      NA
    #A2B2  UK       2012-03-01    Spain   UK      NA
    #A2B2  UK       2013-01-03    UK      Spain   NA
    #A2B2  Brazil   2014-01-04    UK      Spain   NA

问。如何创建最后 3 列以按 ID 滚动前 3 个国家/地区？

【问题讨论】：

你能检查输出以确保它是正确的吗？
国家的顺序似乎不正确。在第 3 行中，美国排名第一，而在第 6 行中，德国排名第二。还是顺序无关紧要？
这是因为我试图根据此人在当前行之前前往的计数来查找前 3 个国家/地区。在第 6 行之前，此人去过美国 3 次，因此美国是第一个国家。
我认为样本数据中有一个错字 - mydata$Date 中的第 5 个元素应该是 "2012-05-09" 而不是 "2011-05-09" 以获得您想要的最终数据。
你是对的。这是一个错字。我已经纠正了。谢谢。

标签： r dataframe dplyr tidyverse rolling-computation

【解决方案1】：

这是一种在每一行为每个ID 获取最后 3 个唯一国家/地区的方法。

library(dplyr)

mydata %>%
  group_by(ID) %>%
  mutate(data = purrr::map(row_number(), ~{
    un_country <- Country[seq_len(.x - 1)]
    if(.x == 1) un_country <- NA
    else  un_country <- names(sort(table(un_country), decreasing = TRUE))[1:3]
    data.frame(t(un_country[1:3]))
  })) %>%
  tidyr::unnest_wider(data)
  
#    ID    Country Date       X1    X2      X3   
#   <chr> <chr>   <date>     <chr> <chr>   <chr>
# 1 A1B1  Japan   2010-01-02 NA    NA      NA   
# 2 A1B1  USA     2010-04-18 Japan NA      NA   
# 3 A1B1  USA     2011-03-22 Japan USA     NA   
# 4 A1B1  USA     2011-11-23 USA   Japan   NA   
# 5 A1B1  Germany 2011-05-09 USA   Japan   NA   
# 6 A1B1  Germany 2012-09-11 USA   Germany Japan
# 7 A1B1  Japan   2014-01-06 USA   Germany Japan
# 8 A1B1  France  2015-12-11 USA   Germany Japan
# 9 A2B2  UK      2010-04-03 NA    NA      NA   
#10 A2B2  Spain   2010-05-11 UK    NA      NA   
#11 A2B2  Spain   2011-05-01 Spain UK      NA   
#12 A2B2  UK      2012-03-01 Spain UK      NA   
#13 A2B2  UK      2013-01-03 Spain UK      NA   
#14 A2B2  Brazil  2014-01-04 UK    Spain   NA

【讨论】：

感谢您的解决方案。这个解决方案找到了这个人最近去过的 3 个独特的国家，这不是我想要做的。我正在尝试通过此人在当前行之前前往的计数来查找前 3 个国家/地区。
更新后的解决方案的结果看起来仍然与预期不同。我喜欢使用地图功能的想法。

【解决方案2】：

我认为这样做。我在此处添加了mydata，因为我认为其中一个日期有错字。

mydata <- data.frame(ID = c('A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A1B1', 'A2B2', 'A2B2', 'A2B2', 'A2B2', 'A2B2', 'A2B2'), 
  Country = c('Japan', 'USA', 'USA', 'USA', 'Germany', 'Germany', 'Japan', 'France', 'UK', 'Spain', 'Spain', 'UK', 'UK', 'Brazil'), 
  Date = as.Date(c('2010/01/02', '2010/04/18', '2011/03/22', '2011/11/23', '2012/05/09', '2012/09/11', '2014/01/06', '2015/12/11', '2010/04/03', '2010/05/11', '2011/05/01', '2012/03/01', '2013/01/03', '2014/01/04')))

library(data.table)
setDT(mydata)
mydata[order(Date), `:=`(num_v = seq_len(.N), last_v = Date), .(ID, Country)]
x <- mydata[
  mydata[, CJ(Country = unique(Country), Date = unique(Date)), ID], 
  on=c('ID', 'Country', 'Date'), roll=Inf]
x[, `:=`(num_v = shift(num_v), last_v = shift(last_v)), .(ID, Country)]
x[is.na(num_v), Country := NA]
y <- x[, 
  .SD[order(-num_v, -last_v)][1:3, .(Pref = paste0('Pref',1:3), Country)],
  .(ID, Date)]
dcast(y, ID+Date~Pref, value.var = 'Country')

#>       ID       Date Pref1   Pref2   Pref3
#>  1: A1B1 2010-01-02  <NA>    <NA>    <NA>
#>  2: A1B1 2010-04-18 Japan    <NA>    <NA>
#>  3: A1B1 2011-03-22   USA   Japan    <NA>
#>  4: A1B1 2011-11-23   USA   Japan    <NA>
#>  5: A1B1 2012-05-09   USA   Japan    <NA>
#>  6: A1B1 2012-09-11   USA Germany   Japan
#>  7: A1B1 2014-01-06   USA Germany   Japan
#>  8: A1B1 2015-12-11   USA   Japan Germany
#>  9: A2B2 2010-04-03  <NA>    <NA>    <NA>
#> 10: A2B2 2010-05-11    UK    <NA>    <NA>
#> 11: A2B2 2011-05-01 Spain      UK    <NA>
#> 12: A2B2 2012-03-01 Spain      UK    <NA>
#> 13: A2B2 2013-01-03    UK   Spain    <NA>
#> 14: A2B2 2014-01-04    UK   Spain    <NA>

如果需要，您可以从原来的mydata 重新加入Country。

【讨论】：

【解决方案3】：

这不是一个超级干净的答案。希望它可以帮助您接近。

library(readr)
df <- readr::read_table(
"ID           Country     Date
A1B1         Japan       2010-01-02
A1B1         USA         2010-04-18
A1B1         USA         2011-03-22
A1B1         USA         2011-11-23
A1B1         Germany     2012-05-09
A1B1         Germany     2012-09-11
A1B1         Japan       2014-01-06
A1B1         France      2015-12-11
A2B2         UK          2010-04-03
A2B2         Spain       2010-05-11
A2B2         Spain       2011-05-01
A2B2         UK          2012-03-01
A3B2         UK          2013-01-03
A3B2         Brazil      2014-01-04")
df 

library(tidyverse)
rankings <- df %>%
  group_by(ID, Country) %>%
  summarise(obs = n(),
            last_dt = max(Date)) %>%
  arrange(ID,-obs, desc(last_dt)) %>%
  mutate(rank = 1:n()) %>% print() %>%
  filter(rank <= 3) %>% 
  pivot_wider(
    names_from = rank,
    values_from = Country,
    names_prefix = "rank_",
    id_cols = ID
  ) %>% print()
#> `summarise()` regrouping output by 'ID' (override with `.groups` argument)
#> # A tibble: 8 x 5
#> # Groups:   ID [3]
#>   ID    Country   obs last_dt     rank
#>   <chr> <chr>   <int> <date>     <int>
#> 1 A1B1  USA         3 2011-11-23     1
#> 2 A1B1  Japan       2 2014-01-06     2
#> 3 A1B1  Germany     2 2012-09-11     3
#> 4 A1B1  France      1 2015-12-11     4
#> 5 A2B2  UK          2 2012-03-01     1
#> 6 A2B2  Spain       2 2011-05-01     2
#> 7 A3B2  Brazil      1 2014-01-04     1
#> 8 A3B2  UK          1 2013-01-03     2
#> # A tibble: 3 x 4
#> # Groups:   ID [3]
#>   ID    rank_1 rank_2 rank_3 
#>   <chr> <chr>  <chr>  <chr>  
#> 1 A1B1  USA    Japan  Germany
#> 2 A2B2  UK     Spain  <NA>   
#> 3 A3B2  Brazil UK     <NA>

df %>% left_join(rankings, by = "ID")
#> # A tibble: 14 x 6
#>    ID    Country Date       rank_1 rank_2 rank_3 
#>    <chr> <chr>   <date>     <chr>  <chr>  <chr>  
#>  1 A1B1  Japan   2010-01-02 USA    Japan  Germany
#>  2 A1B1  USA     2010-04-18 USA    Japan  Germany
#>  3 A1B1  USA     2011-03-22 USA    Japan  Germany
#>  4 A1B1  USA     2011-11-23 USA    Japan  Germany
#>  5 A1B1  Germany 2012-05-09 USA    Japan  Germany
#>  6 A1B1  Germany 2012-09-11 USA    Japan  Germany
#>  7 A1B1  Japan   2014-01-06 USA    Japan  Germany
#>  8 A1B1  France  2015-12-11 USA    Japan  Germany
#>  9 A2B2  UK      2010-04-03 UK     Spain  <NA>   
#> 10 A2B2  Spain   2010-05-11 UK     Spain  <NA>   
#> 11 A2B2  Spain   2011-05-01 UK     Spain  <NA>   
#> 12 A2B2  UK      2012-03-01 UK     Spain  <NA>   
#> 13 A3B2  UK      2013-01-03 Brazil UK     <NA>   
#> 14 A3B2  Brazil  2014-01-04 Brazil UK     <NA>

^{由reprex package (v0.3.0) 于 2020 年 8 月 29 日创建}

【讨论】：

此解决方案缺少滚动部分。我并不是要在这个数据中找到每个 ID 的前 3 个国家，而是滚动的前 3 个国家，这意味着前 3 个国家是动态的。

【解决方案4】：

这是一个凌乱的 Base R 解决方案：

  rlln_rnk_df <- do.call("rbind", lapply(split(mydata, mydata$ID), function(x){
      y <- do.call("rbind", lapply(seq_len(nrow(x)), function(i){
          tmp <- x[x$Date <= x$Date[i],]
          tmp1 <- cbind(head(tmp[order(tmp$Date, decreasing = TRUE),], 1), 
                        rnk = t(names(sort(table(tmp$Country), decreasing = TRUE))))
          tmp1 <- setNames(tmp1, c(names(tmp), paste0("rnk.", 1:(ncol(tmp1) - ncol(tmp)))))
          tmp1[,setdiff(paste0("rnk.", 1:(length(unique(mydata$Country)))), names(tmp1))] <- NA_character_
          tmp1
          }
        )
      )
      z <- y[order(y$Date),]
      cbind(ID = z$ID, Country = z$Country, Date = z$Date,
                 z[match(z$Date, z$Date[2:nrow(z)]), (grep("rnk", names(z), value = TRUE))])
    }
  )
)
df_clean <- data.frame(rlln_rnk_df[, colSums(is.na(rlln_rnk_df)) < nrow(rlln_rnk_df)],
                       row.names = NULL)

【讨论】：

base R 中的解决方案很酷。我尝试过这个。结果看起来与预期不同。
@Bright 它没有进入前 3 名，它为每个国家/地区提供一个。
我运行了你的代码。输出与问题中的预期结果不同。
@Bright 我明白了，结果需要每个 ID 下移一行。