Скользящий счет разных лет

Question

Это может быть очень легко, но я еще не понял это.

Это часть моего набора данных:

structure(list(Patent = c("4683202", "4683195", "4800159", "4965188", 
"4994368", "5328824", "4879214", "4921794", "4983728", "4994372"
), subclass = c("435/91.2", "435/91.2", "435/91.2", "435/91.2", 
"435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2"
), AppYear = c(1985L, 1986L, 1986L, 1987L, 1987L, 1987L, 1988L, 
1988L, 1990L, 1990L), app = 1:10, class = "data.frame", row.names = c(NA, 
-10L), .Names = c("Patent", "subclass", "AppYear", "app", "lag(AppYear)"
))


> data
# A tibble: 10 x 3
  Patent  subclass AppYear
   <chr>   <chr>      <int>
 1 4683202 435/91.2    1985
 2 4683195 435/91.2    1986
 3 4800159 435/91.2    1986
 4 4965188 435/91.2    1987
 5 4994368 435/91.2    1987
 6 5328824 435/91.2    1987
 7 4879214 435/91.2    1988
 8 4921794 435/91.2    1988
 9 4983728 435/91.2    1990
10 4994372 435/91.2    1990

Во-первых, мне нужно получить «приложение» для скользящего подсчета разных лет. Во-вторых, мне нужно создать задержку для "запаздывания" разных лет (AppYear), которая в случае, если предыдущий год (-ы) совпадает, получит строку с годом-1.

Желаемый выход

# A tibble: 10 x 5
   Patent  subclass AppYear   app `lag(AppYear)`
   <chr>   <chr>      <int> <int>          <int>
 1 4683202 435/91.2    1985     1             NA
 2 4683195 435/91.2    1986     2           1985
 3 4800159 435/91.2    1986     2           1985
 4 4965188 435/91.2    1987     3           1986
 5 4994368 435/91.2    1987     3           1986
 6 5328824 435/91.2    1987     3           1986
 7 4879214 435/91.2    1988     4           1987
 8 4921794 435/91.2    1988     4           1987
 9 4983728 435/91.2    1990     5           1988
10 4994372 435/91.2    1990     5           1988

Редактировать Весь набор данных включает в себя множество подклассов, поэтому мне нужно сначала сгруппировать по subclass. Данные теперь сортируются следующим образом:

data <- data %>% 
  select(Patent, subclass, AppYear) %>% 
  arrange(AppYear,Patent) %>% 
  group_by(subclass) %>% 
  mutate(app = 1:n(), lag(AppYear))

.

structure(list(Patent = c("4683202", "4683195", "4800159", "4965188", 
"4994368", "5328824", "4879214", "4921794", "4983728", "4994372", 
"5066584", "5075216", "5091310", "5093245", "5132215", "5185243", 
"5409818", "5409818", "6107023", "4994370", "5001050", "5023171", 
"5035996", "5035996", "5043272", "5045450", "5055393", "5085983", 
"5106729", "5106729"), subclass = c("435/91.2", "435/91.2", "435/91.2", 
"435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", 
"435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", 
"435/91.2", "435/91.21", "435/91.2", "435/91.2", "435/91.2", 
"435/91.2", "435/91.2", "435/91.2", "435/91.21", "435/91.2", 
"435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.21"), 
    AppYear = c(1985L, 1986L, 1986L, 1987L, 1987L, 1987L, 1988L, 
    1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 
    1988L, 1988L, 1988L, 1989L, 1989L, 1989L, 1989L, 1989L, 1989L, 
    1989L, 1989L, 1989L, 1989L, 1989L), app = c(1L, 2L, 3L, 4L, 
    5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 1L, 
    17L, 18L, 19L, 20L, 21L, 22L, 2L, 23L, 24L, 25L, 26L, 27L, 
    3L), `lag(AppYear)` = c(NA, 1985L, 1986L, 1986L, 1987L, 1987L, 
    1987L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 
    1988L, NA, 1988L, 1988L, 1988L, 1989L, 1989L, 1989L, 1988L, 
    1989L, 1989L, 1989L, 1989L, 1989L, 1989L)), class = "data.frame", row.names = c(NA, 
-30L), .Names = c("Patent", "subclass", "AppYear", "app", "lag(AppYear)"
))

Я пытался получить app, используя множество подходов, таких как cumsum(1:length(AppYear)), но не смог найти успешный ответ.

Answer 1

Обновление:

Решение следующего вопроса о ДФ с несколькими группами subclass.

library(dplyr)

df1 %>% 
  select(Patent, subclass, AppYear) %>% 
  arrange(AppYear, Patent) %>%
  group_by(subclass) %>% 
  group_map(~mutate(.,app=group_indices(.,AppYear),
                    lag_year = rep(lag(unique(.$AppYear)), count_(., "AppYear")$n)), 
            keep = T) %>% 
  bind_rows() %>% 
  arrange(AppYear, Patent) 

#> # A tibble: 30 x 5
#>    Patent  subclass AppYear   app lag_year
#>    <chr>   <chr>      <int> <int>    <int>
#>  1 4683202 435/91.2    1985     1       NA
#>  2 4683195 435/91.2    1986     2     1985
#>  3 4800159 435/91.2    1986     2     1985
#>  4 4965188 435/91.2    1987     3     1986
#>  5 4994368 435/91.2    1987     3     1986
#>  6 5328824 435/91.2    1987     3     1986
#>  7 4879214 435/91.2    1988     4     1987
#>  8 4921794 435/91.2    1988     4     1987
#>  9 4983728 435/91.2    1988     4     1987
#> 10 4994372 435/91.2    1988     4     1987
#> # ... with 20 more rows

NB Я использую данные, предоставленные ФП в разделе Изменить вопроса.

---

---

Оригинальный ответ:

library(dplyr)

df1 %>% 
  arrange(AppYear, Patent) %>%
  mutate(app = group_indices(.,AppYear), 
        lag_year = rep(lag(unique(.$AppYear)), count_(., "AppYear")$n))

#> # A tibble: 10 x 5
#>    Patent  subclass AppYear   app lag_year
#>    <chr>   <chr>      <int> <int>    <int>
#>  1 4683202 435/91.2    1985     1       NA
#>  2 4683195 435/91.2    1986     2     1985
#>  3 4800159 435/91.2    1986     2     1985
#>  4 4965188 435/91.2    1987     3     1986
#>  5 4994368 435/91.2    1987     3     1986
#>  6 5328824 435/91.2    1987     3     1986
#>  7 4879214 435/91.2    1988     4     1987
#>  8 4921794 435/91.2    1988     4     1987
#>  9 4983728 435/91.2    1990     5     1988
#> 10 4994372 435/91.2    1990     5     1988

Данные:

df1 <- structure(list(Patent=c("4683202", "4683195", "4800159", "4965188", 
                      "4994368", "5328824", "4879214", "4921794", "4983728", "4994372"), 
                 subclass=c("435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2",
                      "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2"), 
                 AppYear=c(1985L, 1986L, 1986L, 1987L, 1987L, 1987L, 1988L, 
                      1988L, 1990L, 1990L)), 
                 row.names=c(NA, -10L), 
                 class=c("tbl_df", "tbl", "data.frame"))

Answer 2

Вот версия data.table. Самая сложная часть - это самообъединение, позволяющее справочной таблице выполнить год отставания.

library(data.table)

dt <- as.data.table(df1)

setorder(dt, AppYear, Patent)
dt[, app := rleid(AppYear), by = .(subclass)]

dt[unique(dt[, .(lagging_year = shift(AppYear)
                 ,lagging_app = shift(app) + 1), by = subclass])
   , on = .(subclass 
            ,app = lagging_app )
   , lag_year := lagging_year]

dt

     Patent  subclass AppYear app lag_year
 1: 4683202  435/91.2    1985   1       NA
 2: 4683195  435/91.2    1986   2     1985
 3: 4800159  435/91.2    1986   2     1985
 4: 4965188  435/91.2    1987   3     1986
 5: 4994368  435/91.2    1987   3     1986
 6: 5328824  435/91.2    1987   3     1986
 7: 4879214  435/91.2    1988   4     1987
 8: 4921794  435/91.2    1988   4     1987
 9: 4983728  435/91.2    1988   4     1987
10: 4994372  435/91.2    1988   4     1987
#total of 30 rows.

Вот во многом эквивалент ответа @ M-M. Обратите внимание, что .GRP продолжает считать, поэтому он не на 100% эквивалентен. Первая subclass, то есть 435 / 91.21, имеет app 5 здесь вместо 1 в других решениях.

library(data.table)

dt <- as.data.table(df1)
setorder(dt, AppYear, Patent)
dt[, `:=` (app = .GRP, app_cnt = .N), by = .( AppYear, subclass)]

dt[, lag_year := rep(shift(unique(AppYear)), unique(app_cnt)), by = .(subclass)]
dt[, app_cnt := NULL]

dt

А вот и спектакль:

Unit: milliseconds
              expr    min      lq     mean  median      uq     max neval
         M_M_dplyr 6.5839 6.85235 7.442658 6.94440 7.26040 23.0357   100
      cole_dt_join 6.0260 6.27025 6.616121 6.44040 6.84965  8.3686   100
       cole_dt_rep 3.0404 3.15575 3.435112 3.26355 3.76085  4.7526   100
 cole_dt_rep_rleid 3.4116 3.59275 3.911844 3.68695 4.01000 10.3520   100

Данные и функции:

library(data.table)
library(microbenchmark)
library(dplyr)

df1 <- structure(list(Patent = c("4683202", "4683195", "4800159", "4965188", 
                                "4994368", "5328824", "4879214", "4921794", "4983728", "4994372", 
                                "5066584", "5075216", "5091310", "5093245", "5132215", "5185243", 
                                "5409818", "5409818", "6107023", "4994370", "5001050", "5023171", 
                                "5035996", "5035996", "5043272", "5045450", "5055393", "5085983", 
                                "5106729", "5106729"), subclass = c("435/91.2", "435/91.2", "435/91.2", 
                                                                    "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", 
                                                                    "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.2", 
                                                                    "435/91.2", "435/91.21", "435/91.2", "435/91.2", "435/91.2", 
                                                                    "435/91.2", "435/91.2", "435/91.2", "435/91.21", "435/91.2", 
                                                                    "435/91.2", "435/91.2", "435/91.2", "435/91.2", "435/91.21"), 
                     AppYear = c(1985L, 1986L, 1986L, 1987L, 1987L, 1987L, 1988L, 
                                 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 1988L, 
                                 1988L, 1988L, 1988L, 1989L, 1989L, 1989L, 1989L, 1989L, 1989L, 
                                 1989L, 1989L, 1989L, 1989L, 1989L)
)
                , class = "data.frame"
                , row.names = c(NA, 
                                -30L)
                , .Names = c("Patent", "subclass", "AppYear"))


# dt join method ----------------------------------------------------------

dt <- as.data.table(df1)

setorder(dt, AppYear, Patent)
dt[, app := rleid(AppYear), by = .(subclass)]

dt[unique(dt[, .(lagging_year = shift(AppYear)
                 ,lagging_app = shift(app) + 1), by = subclass])
   , on = .(subclass 
            ,app = lagging_app )
   , lag_year := lagging_year]

dt

# dt rep rleid method -----------------------------------------------------------

dt <- as.data.table(df1)
setorder(dt, AppYear, Patent)
dt[, app := rleid(AppYear), by = .(subclass)]
dt[, app_cnt := .N, by = .( AppYear, subclass)]

dt[, lag_year := rep(shift(unique(AppYear)), unique(app_cnt)), by = .(subclass)]
dt[, app_cnt := NULL]

dt

# dt rep and .GRP ---------------------------------------------------------

dt <- as.data.table(df1)
setorder(dt, AppYear, Patent)

dt[, `:=` (app = .GRP, app_cnt = .N), by = .( AppYear, subclass)]

dt[, lag_year := rep(shift(unique(AppYear)), unique(app_cnt)), by = .(subclass)]
dt[, app_cnt := NULL]

dt


# benchmarks --------------------------------------------------------------

microbenchmark(M_M_dplyr = {
  df1 %>% 
    arrange(AppYear, Patent) %>%
    group_by(subclass) %>% 
    group_map(~mutate(.,app=group_indices(.,AppYear),
                      lag_year = rep(lag(unique(.$AppYear)), count_(., "AppYear")$n)), 
              keep = T) %>% 
    bind_rows() %>% 
    arrange(AppYear, Patent)
}
, cole_dt_join = {
  dt <- as.data.table(df1)

  setorder(dt, AppYear, Patent)
  dt[, app := rleid(AppYear), by = .(subclass)]

  dt[unique(dt[, .(lagging_year = shift(AppYear)
                   ,lagging_app = shift(app) + 1), by = subclass])
     , on = .(subclass 
              ,app = lagging_app )
     , lag_year := lagging_year]
}
,cole_dt_rep = {
  dt <- as.data.table(df1)

  setorder(dt, AppYear, Patent)

  dt[, `:=` (app = .GRP, app_cnt = .N), by = .( AppYear, subclass)]

  dt[, lag_year := rep(shift(unique(AppYear)), unique(app_cnt)), by = .(subclass)]
  dt[, app_cnt := NULL]
}
,cole_dt_rep_rleid = {
  dt <- as.data.table(df1)

  dt[, app := rleid(AppYear), by = .(subclass)]
  dt[, app_cnt := .N, by = .( AppYear, subclass)]

  dt[, lag_year := rep(shift(unique(AppYear)), unique(app_cnt)), by = .(subclass)]
  dt[, app_cnt := NULL]
}
)