Início / coding / Perguntas / 79493723
Accepted
lovestacksflow
Asked: 2025-03-08 09:09:35 +0800 CST

Comparando os valores de um certo número de linhas anteriores com a linha atual

  • 772

Em um banco de dados contendo valores de classe de empresa e patente, quero calcular as seguintes variáveis:

Abandono tecnológico: Número de classes de patentes tecnológicas anteriormente ativas abandonadas anualmente.

Especificamente, quero criar variáveis ​​que calculem o número de classes de patentes (variável = classe) que a empresa usou nos últimos 3 anos (t-3, t-2 e t-1) (a observação mínima de um ano anterior é aceitável se o histórico inicial da empresa não tiver 3 anos), mas que estão faltando neste ano (t). Gostaria de fazer o mesmo com uma janela de 5 anos também.

Tenho um conjunto de dados contendo milhões de linhas, então uma solução rápida de data.table é muito preferível.

No seguinte conjunto de dados:

df <- data.table(year=c(1979,1979,1980,1980,1981,1981,1982,1983,1983,1984,1984),
                 category = c("A","A","B","C","A","D","F","F","C","A","B"))

O resultado desejado seria (para uma janela de três anos):

    year        class tech_aband_3
 1: 1979        A     0
 2: 1979        A     0
 3: 1980        B     1
 4: 1980        C     1
 5: 1981        A     2
 6: 1981        D     2
 7: 1982        F     4
 8: 1983        F     3
 9: 1983        C     3
10: 1984        A     3
11: 1984        B     3

No final, terei que executar a solução pelo ID da empresa.

Muito obrigado antecipadamente.

3 respostas

  1. Best Answer

    Supondo que todos os anos estejam representados nos dados (caso contrário, você precisará preencher os anos ausentes para que o seguinte funcione), você pode tentar:

    library(data.table)  
  
df[, .(category = list(unique(category))), by = year
   ][, tech_aband_3 := lengths(mapply(\(x, y) setdiff(unlist(x), y), 
                                      transpose(shift(list(category), 1:3, fill = first(category[[1]]))), 
                                      category))
     ][, .(category = unlist(category)), by = .(year, tech_aband_3)
       ][ df, on = .(year, category)
       ]

     year tech_aband_3 category
    <num>        <int>   <char>
 1:  1979            0        A
 2:  1979            0        A
 3:  1980            1        B
 4:  1980            1        C
 5:  1981            2        A
 6:  1981            2        D
 7:  1982            4        F
 8:  1983            3        F
 9:  1983            3        C
10:  1984            3        A
11:  1984            3        B
    • 5

  2. Aqui está um método que funciona com seus dados de exemplo. Não posso dizer o quão rápido ele será com um grande conjunto de dados.

    library(data.table)
library(purrr)
df <- data.table(year=c(1979,1979,1980,1980,1981,1981,1982,1983,1983,1984,1984),
                 category = c("A","A","B","C","A","D","F","F","C","A","B"))

GetCount <- function(CurrYear) {
  Prev <- unique(df[(CurrYear - year) <= 3 & (CurrYear - year) > 0, "category"])
  Current <- unique(df[year == CurrYear, "category"])
  return(nrow(Prev[!Current, on = "category"]))
}

YEARS <- unique(df$year)       
COUNTS <- map_dbl(YEARS, GetCount)
YearsCounts <- data.table(year = YEARS, tech_aband_3 = COUNTS)

FINAL <- YearsCounts[df, on = "year"]
FINAL

         year tech_aband_3 category
    <num>        <num>   <char>
 1:  1979            0        A
 2:  1979            0        A
 3:  1980            1        B
 4:  1980            1        C
 5:  1981            2        A
 6:  1981            2        D
 7:  1982            4        F
 8:  1983            3        F
 9:  1983            3        C
10:  1984            3        A
11:  1984            3        B
    • 3

  3. Aqui está uma comparação incluindo uma abordagem RCCP.

    library(data.table)
library(purrr)

set.seed(1)
dat <- data.table(year=seq(1:3000),category = sample(LETTERS, 3000, replace = TRUE))

calc_tech_abandonment1 <- function(dt, window) {  
  return(dt[, paste0("tech_aband_", window) := {
    past_categories <- unique(dt[year %between% c(.BY$year - window, .BY$year - 1), category])
    current_category <- unique(dt[year == .BY$year, category])
    length(setdiff(past_categories, current_category)) # Calculate the number of abandoned categories
  }, by = year])
}

calc_tech_abandonment2 <- function(dt, window){ 
  GetCount <- function(CurrYear) {
    Prev <- unique(dt[(CurrYear - year) <= window & (CurrYear - year) > 0, "category"])
    Current <- unique(dt[year == CurrYear, "category"])
    return(nrow(Prev[!Current, on = "category"]))
  }  
  YEARS <- unique(dt$year)       
  COUNTS <- map_dbl(YEARS, GetCount)
  YearsCounts <- data.table(year = YEARS, tech_aband_3 = COUNTS)
  return(YearsCounts[dt, on = "year"][, .(year, category, tech_aband_3)])
  
}

calc_tech_abandonment3 <- function(dt) {
  return(dt[, .(category = list(unique(category))), by = year
  ][, tech_aband_3 := lengths(mapply(\(x, y) setdiff(unlist(x), y), 
                                     transpose(shift(list(category), 1:3, fill = first(category[[1]]))), 
                                     category))
  ][, .(category = unlist(category)), by = .(year, tech_aband_3)
  ][ dt, on = .(year, category)][, .(year, category, tech_aband_3)])
}

## RCPP
Rcpp::cppFunction('
IntegerVector calc_tech_abandonment_cpp(DataFrame dt, int window) {
  IntegerVector years = dt["year"];
  CharacterVector categories = dt["category"];
  
  std::unordered_map<int, std::unordered_set<std::string>> year_to_categories;
  for (int i = 0; i < years.size(); i++) {
    year_to_categories[years[i]].insert(std::string(categories[i]));
  }
  
  IntegerVector result(years.size());
  for (int i = 0; i < years.size(); i++) {
    int current_year = years[i];
    std::unordered_set<std::string> past_categories;
    
    for (int j = 1; j <= window; j++) {
      int past_year = current_year - j;
      if (year_to_categories.count(past_year)) {
        past_categories.insert(year_to_categories[past_year].begin(), year_to_categories[past_year].end());
      }
    }
    
    std::unordered_set<std::string> current_categories = year_to_categories[current_year];
    int abandoned_count = 0;
    for (const auto& cat : past_categories) {
      if (current_categories.find(cat) == current_categories.end()) {
        abandoned_count++;
      }
    }
    
    result[i] = abandoned_count;
  }
  
  return result;
}')

calc_tech_abandonment_rcpp <- function(dt, window) {
  return(dt[, paste0("tech_aband_", window) := calc_tech_abandonment_cpp(dt, window)])
}

# Benchmark

bench <- microbenchmark::microbenchmark(
  calc_tech_abandonment1 = calc_tech_abandonment1(dat, window = 3),
  calc_tech_abandonment2 = calc_tech_abandonment2(dat, window = 3), 
  calc_tech_abandonment3 = calc_tech_abandonment3(dat),
  calc_tech_abandonment_rcpp = calc_tech_abandonment_rcpp(dat, 3),
  times = 10
)

    Resultados

    Unit: milliseconds
                       expr       min        lq       mean     median        uq       max neval cld
     calc_tech_abandonment1 4413.0690 4513.0162 4551.91333 4568.17215 4593.8609 4609.8427    10 a  
     calc_tech_abandonment2 6247.0388 6323.6385 6405.84832 6377.23535 6496.3481 6563.5206    10  b 
     calc_tech_abandonment3   57.2013   59.5997   63.21687   61.88805   66.1977   76.8084    10   c
 calc_tech_abandonment_rcpp    2.0205    2.1013    2.33757    2.14720    2.1735    4.2637    10   c
    • -1

relate perguntas