在 R 中分配类别是否有比使用循环更有效的方法？

Question

I am currently working with a large dataset (two subsamples of sizes 2,008,384x15 and 3,072,435x15 respectively). The data are monthly food and beverage price quotes over a period of ca 200 months. I would greatly appreciate your help with the following question:

In the original data, each observation (price quote of a product) has a category index from 1 to 151. I want to assign broader categories to these, ie grouping the 151 categories under 19 super-categories. Unfortunately, the breaks are not straight-forward, ie one category, say cheese, includes the indices 57,58,59,60 and 143.

I tried using a for-loop for the assignment -- which works -- but it took my computer like 2-3 days to run it (inserted below) Therefore, I'd very much like to ask for a more efficient way to assign these categories.

Thank you very much in advance for your help! All the best!

sample_1993_2002$category_all <- NA
sample_1993_2002 = sample_1993_2002[order(sample_1993_2002$category_idx),]

for (i in 1:nrow(sample_1993_2002)){
  
  if (sample_1993_2002$category_idx[i] %in% c(1, 2, 3, 4, 5, 6, 17, 19, 68,69, 70,71,72,74,75,76,77,78,80,81,82,83,84,85,86, 88, 89,90,91, 92, 93, 94, 95, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 127, 141, 151,148, 146,147)) {sample_1993_2002$category_all[i] <- "fruit_veg_cereal"
  } else if (sample_1993_2002$category_idx[i] %in% c(9,10,11,12,13,14,123)) {sample_1993_2002$category_all[i] <-"bakery"
  } else if (sample_1993_2002$category_idx[i] == 16) {sample_1993_2002$category_all[i] <- "pasta" 
  } else if (sample_1993_2002$category_idx[i] %in% c(20,21,22,23,24,25,26,27,28,29,30,31,129)) {sample_1993_2002$category_all[i] <- "meat_fresh"
  } else if (sample_1993_2002$category_idx[i] %in% c(32,33,34,35,36,37,38,39, 121, 130)) {sample_1993_2002$category_all[i] <- "meat_product"
  } else if (sample_1993_2002$category_idx[i] %in% c(40,41,42,43,44,45,46,47,48)) {sample_1993_2002$category_all[i] <- "fish"
  } else if (sample_1993_2002$category_idx[i] %in% c(49,50,51,52,53,54,56,61,62,63,111,125)) {sample_1993_2002$category_all[i] <- "animal_prod"
  } else if (sample_1993_2002$category_idx[i] %in% c(55,64,65,66,67)) {sample_1993_2002$category_all[i] <-  "oils_butter"
  } else if (sample_1993_2002$category_idx[i] %in% c(57,58,59,60, 143)){sample_1993_2002$category_all[i] <-"cheese" 
  } else if (sample_1993_2002$category_idx[i] %in% c(112,113)) {sample_1993_2002$category_all[i] <- "coffee" 
  } else if (sample_1993_2002$category_idx[i] %in% c(114,115)) {sample_1993_2002$category_all[i] <- "chocolate" 
  } else if (sample_1993_2002$category_idx[i] %in% c(116,117, 119,150)) {sample_1993_2002$category_all[i] <- "spice"
  } else if (sample_1993_2002$category_idx[i] ==124) {sample_1993_2002$category_all[i] <- "jams"
  } else if (sample_1993_2002$category_idx[i] == 134) {sample_1993_2002$category_all[i] <- "beer"
  } else if (sample_1993_2002$category_idx[i] == 135) {sample_1993_2002$category_all[i] <-"rum"
  } else if (sample_1993_2002$category_idx[i]== 136) {sample_1993_2002$category_all[i] <- "brandy"
  } else if (sample_1993_2002$category_idx[i]== 137) {sample_1993_2002$category_all[i] <- "wine"
  } else if (sample_1993_2002$category_idx[i] == 138) {sample_1993_2002$category_all[i] <- "spirit"
  } else {sample_1993_2002$category_all[i] <- "other"}
}

Answer 1

Yes. Don't use a loop. R is vectorised by default, So, as a proof of concept: using random data:

library(tidyverse)

df <- tibble(Category=sample(1:151, size=2e6, replace=TRUE))

df <- df %>% 
       mutate(
         SuperCategory=ifelse(Category %in% c(9,10,11,12,13,14,123), "bakery", NA),
         SuperCategory=ifelse(Category %in% c(16), "pasta", SuperCategory),
         SuperCategory=ifelse(Category %in% c(20,21,22,23,24,25,26,27,28,29,30,31,129), "meat_fresh", SuperCategory),
         SuperCategory=ifelse(Category %in% c(32,33,34,35,36,37,38,39, 121, 130), "meat_product", SuperCategory),
         SuperCategory=ifelse(is.na(SuperCategory), "other", SuperCategory)
      )
df %>% 
  group_by(SuperCategory) %>% 
  summarise(N=n(), .groups="drop")
# A tibble: 5 x 2
  SuperCategory       N
  <chr>           <int>
1 bakery          92606
2 meat_fresh     172751
3 meat_product   132752
4 other         1588537
5 pasta           13354

I haven't implemented all your super category definitions, but you get the picture. This runs very quickly:

library(microbenchmark)

microbenchmark({
df <- df %>% 
       mutate(
         SuperCategory=ifelse(Category %in% c(9,10,11,12,13,14,123), "bakery", NA),
         SuperCategory=ifelse(Category %in% c(16), "pasta", SuperCategory),
         SuperCategory=ifelse(Category %in% c(20,21,22,23,24,25,26,27,28,29,30,31,129), "meat_fresh", SuperCategory),
         SuperCategory=ifelse(Category %in% c(32,33,34,35,36,37,38,39, 121, 130), "meat_product", SuperCategory),
         SuperCategory=ifelse(is.na(SuperCategory), "other", SuperCategory)
      )
 },
 times=10
)

<output deleted>

Unit: seconds
                                                                                                                                                                                                                                                                                                                                                                                                                                                                               
      min       lq     mean   median       uq      max neval
 2.640724 2.655678 2.764513 2.680773 2.901454 3.002492    10

So a mean of 2.7 seconds for 2 million rows. I'm not prepared to run your code to get a direct comparison. :=)

Answer 2

You can also try data.table , very fast for big tables. Here the same Limey's code and data in data.table way:

library(data.table)
set.seed(1234)
dt <- data.frame(Category=sample(1:151, size=2e6, replace=TRUE)

result <-
 data.table(dt)[,':='(SuperCategory = fifelse(Category %in% c(9:14, 125),'bakery',
                                       fifelse(Category %in% c(16),'pasta',
                                         fifelse(Category %in% c(20:31, 129),'meat_fresh',
                                           fifelse(Category %in% c(32:39, 130),'meat_product',
                                             fifelse(is.na(Category),'other','x'))))))]

---

And here the performances for 100 iterations:

library(microbenchmark)
library(dplyr)

microbenchmark(
data.table =  data.table(dt)[,':='(SuperCategory = fifelse(Category %in% c(9:14, 125),'bakery',
                                                  fifelse(Category %in% c(16),'pasta',
                                                  fifelse(Category %in% c(20:31, 129),'meat_fresh',
                                                  fifelse(Category %in% c(32:39, 130),'meat_product',
                                                  fifelse(is.na(Category),'other','x'))))))]

,

tidyverse = dt %>% 
 tibble() %>%
 mutate(
  SuperCategory=ifelse(Category %in% c(9,10,11,12,13,14,123), "bakery", NA),
  SuperCategory=ifelse(Category %in% c(16), "pasta", SuperCategory),
  SuperCategory=ifelse(Category %in% c(20,21,22,23,24,25,26,27,28,29,30,31,129), "meat_fresh", SuperCategory),
  SuperCategory=ifelse(Category %in% c(32,33,34,35,36,37,38,39, 121, 130), "meat_product", SuperCategory),
  SuperCategory=ifelse(is.na(SuperCategory), "other", SuperCategory)
 ))

Unit: milliseconds
       expr       min        lq      mean    median       uq       max neval
 data.table  373.2851  393.7549  437.7108  422.4139  440.835  743.3399   100
  tidyverse 3080.3477 3170.4254 3333.6604 3254.2223 3437.303 4192.6353   100