Join by range and group in dplyr pipe - r

Question

I have a several large data frames that I need to append data to. The data structure is simulated below:
Orders
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
Bulk pricing. Prices are variable depending on the number of products ordered.
The table shows the minimum number of products at which bulk pricing applies.
Other products are not counted and their price is to be considered "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"
)
My convoluted solution, which seems overly complex and is rather slow when running on my large data frames (500K+ rows each). Is there a simpler, faster way? I ultimately want it in a pipe because I have transformations before and after.
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)
Result
# 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

Answer 1

Here is my attempt which also seems bit convoluted :
We write a function to select the correct value of prices for each 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
}
}
Join the dataframe by type and select the row for each ID.
tbl.orders %>%
left_join(tbl.prices, by = 'type') %>%
group_by(ID) %>%
filter(select_row(type, nb_products_ordered, min_products_ordered))