Сохранить указанный c диапазон дат до и после отметки времени - PullRequest
3 голосов
/ 06 января 2020

Имеет результат с кадром данных, подобный следующему:

library(dplyr)
dframefull <- data.frame(id = c(1,1,1,1,1,1,1,1), 
                         name = c("Google", "Google", "Google", "Google", 
                                  "Google", "Google", "Google", "Google"), 
                         date = c("12/8/2014 19:30:57", "26/8/2014 19:30:57", 
                                  "27/8/2014 10:12:01", "27/8/2014 14:10:29", 
                                  "27/8/2014 14:10:32", "27/8/2014 14:10:33", 
                                  "3/9/2014 14:10:32",  "14/9/2014 19:30:57"), 
                         mytext = c("out text", "text", "another", "text", 
                                    "here", "other text", "text more", 
                                    "out text 2"),
                         stringsAsFactors = FALSE) %>% 
  mutate(date = as.POSIXct(date, 
                           format = "%d/%m/%Y %H:%M:%S"))
dframekeep <- data.frame(id = c(1), 
                         name = c("Google"), 
                         date = c("27/8/2014 14:10:32"),
                         stringsAsFactors = FALSE) %>% 
  mutate(date = as.POSIXct(date, format = "%d/%m/%Y %H:%M:%S"))

b <- with(dframefull, 
          aggregate(list(mytext=mytext), 
                    by=list(id=id, 
                            label=factor(I(date > dframekeep$date), labels=c("before", "after")), 
                            name=name), 
                    FUN=paste))

Как можно сохранить 10 дней до и 10 дней после указанной c даты второго кадра данных?

Здесь ожидаемый результат

data.frame(id = c(1,1), label = c("before", "after"), name = c("Google", "Google"), mytext = c("text another text here", "other text text more"))
  id  label   name                 mytext
1  1 before Google text another text here
2  1  after Google   other text text more

Ответы [ 2 ]

3 голосов
/ 06 января 2020

Если у вас есть только одна дата в dframekeep, вы можете отфильтровать строки dframefull следующим образом:

dframefull %>% 
    dplyr::filter(
        abs(difftime(date, dframekeep$date, units = "days")) <= 10
    )

(хотя я не уверен, что это именно то, что вы хотите, учитывая ваши ожидаемый результат)

2 голосов
/ 06 января 2020

Хорошо, вот оно

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:base':
#> 
#>     date

dframefull <- data.frame(id = c(1,1,1,1,1,1,1,1), 
                         name = c("Google", "Google", "Google", "Google", 
                                  "Google", "Google", "Google", "Google"), 
                         date = c("12/8/2014 19:30:57", "26/8/2014 19:30:57", 
                                  "27/8/2014 10:12:01", "27/8/2014 14:10:29", 
                                  "27/8/2014 14:10:32", "27/8/2014 14:10:33", 
                                  "3/9/2014 14:10:32",  "14/9/2014 19:30:57"), 
                         mytext = c("out text", "text", "another", "text", 
                                    "here", "other text", "text more", 
                                    "out text 2"),
                         stringsAsFactors = FALSE) %>% 
  mutate(date = as.POSIXct(date, 
                           format = "%d/%m/%Y %H:%M:%S"))
dframekeep <- data.frame(id = c(1), 
                         name = c("Google"), 
                         date = c("27/8/2014 14:10:32"),
                         stringsAsFactors = FALSE) %>% 
  mutate(date = as.POSIXct(date, format = "%d/%m/%Y %H:%M:%S"))

dframekeep2 <- dframekeep %>%
  mutate(start_date = date - days(10),
         end_date = date + days(10))

dframefull %>% 
  fuzzyjoin::fuzzy_semi_join(dframekeep2,by = c("date" = "start_date",
                                                "date" = "end_date"),match_fun = list(`>`,`<`))
#>   id   name                date     mytext
#> 2  1 Google 2014-08-26 19:30:57       text
#> 3  1 Google 2014-08-27 10:12:01    another
#> 4  1 Google 2014-08-27 14:10:29       text
#> 5  1 Google 2014-08-27 14:10:32       here
#> 6  1 Google 2014-08-27 14:10:33 other text
#> 7  1 Google 2014-09-03 14:10:32  text more

before_df <- dframefull %>% 
  fuzzyjoin::fuzzy_semi_join(dframekeep2,by = c("date" = "start_date","date" = "date"),match_fun = list(`>`,`<=`)) %>%
  mutate(label = "before")

after_df <- dframefull %>% 
  fuzzyjoin::fuzzy_semi_join(dframekeep2,by = c("date" = "end_date","date" = "date"),match_fun = list(`<`,`>=`)) %>%
  mutate(label = "after")

before_df %>% 
  bind_rows(after_df) %>%
  select(-date) %>% 
  as_tibble() %>% 
  select(-id) %>% 
  pivot_wider(names_from = label,values_from = mytext,values_fn =list(mytext = ~ reduce(.,
                                                                                        str_c,
                                                                                        sep = " "))) %>% 
  pivot_longer(before:after,names_to = "label",values_to = "mytext")
#> # A tibble: 2 x 3
#>   name   label  mytext                   
#>   <chr>  <chr>  <chr>                    
#> 1 Google before text another text here   
#> 2 Google after  here other text text more

Создано в 2020-01-06 пакетом представительство (v0.3.0)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...