Purrr 在 R 中查找符合条件的组中的最后一行，然后从该行中提取一个值

Question

所以我认为我在这个问题上想多了，我已经设法创建了一个功能代码，但是它非常慢，我认为如果我正确使用 Purrr，我会看到这个功能的巨大改进。

我有如下数据集

library(tidyverse)
library(purrr)
library(lubridate)

Row_ID <- c(1,2,3,4,5,6,7)
Tag <- c("A","A","A","A","A","B","B")
From_Location <-c("Farm1",
  "Farm2",
  "Farm3",
  "Farm4",
  "Farm3",
  "Farm2",
  "Farm3")
Date <- c("2020-01-06", "2019-08-17", "2019-02-05", "2019-01-01", "2018-04-02", "2020-09-01", "2019-12-23")

Foo <- tibble(Row_ID, Tag, From_Location, Date) %>% 
        mutate(Date = anydate(Date))


# A tibble: 8 x 4
  Row_ID Tag   From_Location Date      
   <dbl> <chr> <chr>         <chr>     
1      1 A     Farm1         2020-01-06
2      2 A     Farm2         2019-08-17
3      3 A     Farm3         2019-02-05
4      4 A     Farm4         2019-01-01
5      5 A     Farm3         2018-04-02
6      6 B     Farm2         2020-09-01
7      7 B     Farm3         2019-12-23

我想为每一行确定标签在特定农场上的最后日期。 IE。该组中的最后一次 From_Location == "Farm3" 然后返回该列的“日期”。在我的特定用例中，下面一行中总会有一个“Farm3”，因为我意识到我的方法由于 max() 在下面没有行时没有输入而中断。

我想出的方法是创建一个我可以映射的函数，它给了我最大的日期。它有效，但我认为有一种更好的方法可以正确使用 Purrr

FoI = "Farm3"

Last_Date <- function(ID, Row){
  
  dat <- Foo %>% 
    filter(Row_ID >= Row & Tag == ID & From_Location == FoI) %>% 
    .$Date %>% 
    max () %>% 
    as.character()
  
  return(dat)
  
}

Last_Date("A", "4")


Foo_CP <- Foo %>% 
    mutate(Movement_Off_IP = purrr::pmap(list(Tag, Row_ID), .f =Last_Date),
           Movement_Off_IP = ymd(Movement_Off_IP)) 

# A tibble: 7 x 5
  Row_ID Tag   From_Location Date       Movement_Off_IP
   <dbl> <chr> <chr>         <date>     <date>         
1      1 A     Farm1         2020-01-06 2019-02-05     
2      2 A     Farm2         2019-08-17 2019-02-05     
3      3 A     Farm3         2019-02-05 2019-02-05     
4      4 A     Farm4         2019-01-01 2018-04-02     
5      5 A     Farm3         2018-04-02 2018-04-02     
6      6 B     Farm2         2020-09-01 2019-12-23     
7      7 B     Farm3         2019-12-23 2019-12-23   

Answer 1

这是一种替代方法，我认为它会比 purrr 方法更快，因为我们没有按行处理数据。

library(dplyr)
FoI = "Farm3"

Foo %>%
  group_by(Tag) %>%
  mutate(Movement_Off_IP = if_else(From_Location == FoI, Date, as.Date(NA))) %>%
  tidyr::fill(Movement_Off_IP, .direction = 'up')

#  Row_ID Tag   From_Location Date       Movement_Off_IP
#   <dbl> <chr> <chr>         <date>     <date>         
#1      1 A     Farm1         2020-01-06 2019-02-05     
#2      2 A     Farm2         2019-08-17 2019-02-05     
#3      3 A     Farm3         2019-02-05 2019-02-05     
#4      4 A     Farm4         2019-01-01 2018-04-02     
#5      5 A     Farm3         2018-04-02 2018-04-02     
#6      6 B     Farm2         2020-09-01 2019-12-23     
#7      7 B     Farm3         2019-12-23 2019-12-23     

这里的逻辑是我们复制Date if From_Location = FoI or else NA。我们使用tidyr::fill 将NA 值替换为以前的日期。

Answer 2

在data.table 中使用滚动连接。

滚动连接是专门为这种情况构建的更精确的工具。对于大型数据集，这可能会更快。

library(data.table)
setDT(Foo)

#take a subset (just the farm 3 rows)
Foo_farm3 <- Foo[From_Location=="Farm3",list(Date,Tag)] 

#copy the Date column as a new column to be rolled forward:
Foo_farm3[,Movement_Off_IP:=Date]

#do the rolling join:
#(note in a multi-column join, the roll column is the final one specified)
Foo_farm3[Foo, on=c("Tag","Date"),roll=TRUE]

#>          Date Tag Movement_Off_IP Row_ID From_Location
#> 1: 2020-01-06   A      2019-02-05      1         Farm1
#> 2: 2019-08-17   A      2019-02-05      2         Farm2
#> 3: 2019-02-05   A      2019-02-05      3         Farm3
#> 4: 2019-01-01   A      2018-04-02      4         Farm4
#> 5: 2018-04-02   A      2018-04-02      5         Farm3
#> 6: 2020-09-01   B      2019-12-23      6         Farm2
#> 7: 2019-12-23   B      2019-12-23      7         Farm3

或者，更简洁地使用管道：

Foo[From_Location=="Farm3",list(Date,Tag,Movement_Off_IP=Date)] %>%
  .[Foo, on=c("Tag","Date"),roll=TRUE]