Блог

У меня есть несколько больших фреймов данных, к которым мне нужно добавить данные. Структура данных смоделирована ниже:

Заказы

 set.seed(2)
N=1e2

tbl.orders <- tibble(
  ID=1:N,
  nb_products_ordered = sample(1:15, N, replace = TRUE),
  type = sample(c("keyboard", "mouse", "other"), N, replace = TRUE),
  grade= sample(LETTERS[1:5], N, replace=TRUE)
)

# A tibble: 100 x 4
    ID  nb_products_ordered     type       grade
  <int>               <int>     <chr>      <chr>
1     1                   5     other       A    
2     2                  15     keyboard    A    
3     3                   6     other       C    
4     4                   6     keyboard    E    
5     5                   8     other       C    
  

Массовое ценообразование. Цены варьируются в зависимости от количества заказанных продуктов.
В таблице показано минимальное количество продуктов, на которые применяется оптовое ценообразование.
Другие продукты не учитываются, и их цена должна рассматриваться как «NA».

 tbl.prices <- tibble::tribble(
  ~min_products_ordered, ~per_unit_cost, ~type,
  1L, 39.7,    "mouse",
  2L, 23.1,    "mouse",
  3L, 18.6,    "mouse",
  4L,   15,    "mouse",
  5L, 14.3,    "mouse",
  6L,   11,    "mouse",
  9L, 10.9,    "mouse",
  1L,   11, "keyboard",
  9L, 10.9, "keyboard"
)
  

Мое запутанное решение, которое кажется чрезмерно сложным и довольно медленным при работе с моими большими фреймами данных (более 500 Тыс. строк в каждом). Есть ли более простой и быстрый способ? В конечном итоге я хочу, чтобы это было в канале, потому что у меня есть преобразования до и после.

 tbl.orders%>%
group_by(type)%>%
      group_split()%>%
      lapply(., function(x)
      {
        #if included in price list
        if (x$type[1] %in% levels(factor(tbl.prices$type))) {
          df.priceparameters <- tbl.prices %>%
            filter(type == x$type[1])

          x %>% mutate(
            per_unit_cost =
              as.numeric(
                as.character(
              
              cut(
                x[["nb_products_ordered"]],
                breaks = c(df.priceparameters$min_products_ordered, Inf),
                #returns per unit cost
                labels = df.priceparameters$per_unit_cost,
                right = FALSE
              )))
          )
        } else{
          x %>% mutate(per_unit_cost = NA)
        }
      })%>%
      do.call("rbind",.)%>%
  arrange(ID)
  

Результат

 # A tibble: 100 x 5
     ID  nb_products_ordered  type     grade  per_unit_cost
  <int>                <int>  <chr>    <chr>          <dbl>
1     1                   5   other    A                NA  
2     2                  15   keyboard A               10.9
3     3                   6   other    C                NA  
4     4                   6   keyboard E                11  
5     5                   8   other    C                NA  
  

Вот моя попытка, которая также кажется немного запутанной :

Мы пишем функцию для выбора правильного значения цен для каждого ID .

 library(dplyr)

select_row <- function(type, nb_products_ordered, min_products_ordered){
  if(any(type == 'other')) return(TRUE) 
  else{
    tmp <- first(nb_products_ordered) - min_products_ordered 
    inds <- tmp >= 0
    if(any(inds)) return(tmp == min(tmp[inds], na.rm = TRUE))
    else TRUE
  }
}
  

Соедините фрейм данных с помощью type и выберите строку для каждого ID .

 tbl.orders %>%
  left_join(tbl.prices, by = 'type') %>%
  group_by(ID) %>%
  filter(select_row(type, nb_products_ordered, min_products_ordered))