Applying sliding scale price in R based on quantity - r

Question

R gurus,
I would like to write a function to apply dynamic prices based on quantities purchased.
Here is the dataset.
prices <- data.frame(from = c(0,101,201,301,401,501,601,701,801,901,1001,1101,2001),
to = c(100,200,300,400,500,600,700,800,900,1000,1100,2000,10000),
price = c(50,45,40,35,30,25,20,15,10,8,7,6,5))
purchases <- data.frame(customer = LETTERS[1:20],
quantity = c(305,100,70,576,687,1200,5007,491,870,320,80,295,680,1100,1305,1024,1800,7400,3500,730),
bill = NA)
purchases dataset has quantities and price dataset has sliding scale prices for different quantity ranges.
For example, customer A purchased 305 units. To calculate billing for this quantity, first hundred units will be billed at $50, second hundred units at $45, third hundred units at $40 and remaining 5 units at $35. Mathematically:
purchases$bill[1] = 100*50 + 100*45 + 100*40 + 5*35
OR
purchases$bill[1] = 100*prices$price[1] + 100*prices$price[2] + 100*prices$price[3] + 5*prices$price[4]
I wonder what is the best way to do this using an R function to calculate bill for each purchase.
Any help is much appreciated.

Answer 1

Using base R we dan do something like below:
c(prices$price%*%diff(replace(A<-outer(c(0,prices$to),purchases$quantity,"-"),A>0,0)))
[1] 13675 5000 3500 21900 24240 29100 48935 19730 26700 14200 4000 13300 24100 28500 29730 27968
[17] 32700 60900 41400 24950
Elaboration:
price=prices$price
lowr=c(0,prices$to)
qnty=purchases$quantity
x=outer(lowr,qnty,"-")
M=diff(replace(x,x>0,0))
colSums(price*M)##similar to c(price%*%M)
transform(purchases,bill=colSums(price*M))
transform(purchases,bill=colSums(price*M))
customer quantity bill
1 A 305 13675
2 B 100 5000
3 C 70 3500
4 D 576 21900
5 E 687 24240
6 F 1200 29100
7 G 5007 48935
8 H 491 19730
9 I 870 26700
10 J 320 14200
11 K 80 4000
12 L 295 13300
13 M 680 24100
14 N 1100 28500
15 O 1305 29730
16 P 1024 27968
17 Q 1800 32700
18 R 7400 60900
19 S 3500 41400
20 T 730 24950

Answer 2

Here is an example of a bad solution. It is not 100% accurate either.
library(dplyr)
prices <- data.frame(from = c(0,101,201,301,401,501,601,701,801,901,1001,1101,2001),
to = c(100,200,300,400,500,600,700,800,900,1000,1100,2000,10000),
price = c(50,45,40,35,30,25,20,15,10,8,7,6,5))
purchases <- data.frame(customer = LETTERS[1:20],
quantity = c(305,100,70,576,687,1200,5007,491,870,320,80,295,680,1100,1305,1024,1800,7400,3500,800),
bill = NA)
prices$qty = prices$to - prices$from + 1
prices$qty[1] = prices$to[1]
prices$c_qty = cumsum(prices$qty)
prices$bill = prices$qty * prices$price
prices$c_bill = cumsum(prices$bill)
prices$id = 1:nrow(prices)
calculate_billing <- function(qty) {
if(qty <= 100){ price_case = 1}
if(qty >= 101 & qty <= 200) { price_case = 2}
if(qty >= 201 & qty <= 300) { price_case = 3}
if(qty >= 301 & qty <= 400) { price_case = 4}
if(qty >= 401 & qty <= 500) { price_case = 5}
if(qty >= 501 & qty <= 600) { price_case = 6}
if(qty >= 601 & qty <= 700) { price_case = 7}
if(qty >= 701 & qty <= 800) { price_case = 8}
if(qty >= 801 & qty <= 900) { price_case = 9}
if(qty >= 901 & qty <= 1000) { price_case = 10}
if(qty >= 1001 & qty <= 1100) { price_case = 11}
if(qty >= 1101 & qty <= 2000) { price_case = 12}
if(qty >= 2001 & qty <= 10000){ price_case = 13}
if(price_case==1) {
billing = prices$price[price_case]*qty
}
if(price_case>1 & price_case<=11 ) {
remainder <- qty%%100
billing = prices$c_bill[price_case-1] + prices$price[price_case]*remainder
}
if(price_case==12) {
remainder <- qty - 1100
billing = prices$c_bill[price_case-1] + prices$price[price_case]*remainder
}
if(price_case==13) {
remainder <- qty - 2000
billing = prices$c_bill[price_case-1] + prices$price[price_case]*remainder
}
return(billing)
}
purchases %>%
rowwise() %>%
mutate(bill = calculate_billing(quantity))