# Best approach to find optimal solution to linear equation by group in R

I am currently modeling a pricing and discount system in R.

My data frame looks as follows:

df = structure(
list(
Customers = structure(
c(1L, 1L, 1L, 2L, 2L, 2L),
.Label = c("A", "B"),
class = "factor"
),
Products = structure(
c(1L,
2L, 3L, 1L, 2L, 3L),
.Label = c("P1", "P2", "P3"),
class = "factor"
),
Old_Price = c(5, 2, 10, 7, 4, 8),
New_Price = c(6, 3, 9,
6, 3, 9)
),
class = "data.frame",
row.names = c(NA,-6L)
)


There are several customers who buy different products with an "Old Price" and a "New Price". I now want to identify one discount parameter (a real from -1.0 to 1.0) for each customer that minimizes the difference of Old Price and New Price.

Because I do not know a lot about optimizations, etc. my current approach would be to do the following, which seems horribly inefficient and might not lead to the optimal solution anyway:

df %>%
mutate(Individual_Discount = (Old_Price-New_Price)/New_Price) %>% # Identify optimal discount individually
group_by(Customers) %>%
mutate(Optimal_Discount = mean(Individual_Discount)) # Average individual discount to get approximate discount for customer


What's the best approach to solve a case like this and how can I implement it in R?

Update:

To clarify the problem more plainly. There is a data frame that looks like this:

Customers | Product | Old Price | New Price | Delta  | Discount | Discounted New Price
CustA     | ProdA   | 10.00     | 12.00     |  2.00  | -0.167   | 10.00
CustA     | ProdB   | 30.00     | 25.00     | -5.00  |  0.2     | 30.00
CustB     | ProdA   | 15.00     | 12.00     | -3.00  |  0.25    | 15.00
CustB     | ProdB   | 20.00     | 25.00     |  5.00  | -0.2     | 20.00


The discount represents the optimal discount to reduce the difference between the old and new price to zero (So a new price 2 would be calculated as New Price + New Price * Discount). However each customer can only get one discount, so which discount should I choose per customer to minimize the remaining deltas (the delta between the discounted new price and the old price)?

Update2: Mathematical relationships

Delta = New_Price - Old_Price

Discount = Delta / -New_Price

Discounted_New_Price = New_Price+New_Price*Discount

Update3:

I have fitted a linear model based on the comments but a "linear discount" based on the gradient of the grouped linear model yields worse results than my "mean hack":

df %>%
group_by(Customers) %>%
do({ co <- coef(lm(Old_Price ~ New_Price, .))
mutate(., linear_discount = co[2])
}) %>%
ungroup %>%
mutate(linear_discount = 1/linear_discount-1) %>%
mutate(linear_price = New_Price+New_Price*linear_dis


The results are

Customers | Product | Old Price | New Price | Linear Discount  | Linear Price | Discounted New Price
CustA     | Prod1   | 05.00     | 06.00     |  -0.25           | 4.50
CustA     | Prod2   | 02.00     | 03.00     |  -0.25           | 2.25
CustA     | Prod3   | 10.00     | 09.00     |  -0.25           | 6.75
CustB     | Prod1   | 07.00     | 06.00     |   0.50           | 9.00
...

• Could you state the optimization problem more accurately? This: "There are several customers who buy different products with an "Old Price" and a "New Price". I now want to identify one discount parameter (a real from -1.0 to 1.0) for each customer that minimizes the difference of Old Price and New Price." is not clear enough to me Apr 15 '20 at 11:41
• Besides, what do you mean by horribly inefficient? Apr 15 '20 at 11:41
• @DavidMasip I added some more detail about the problem. I called my mean-solution inefficient because it is a lot of lines and computation that need to be done for a subpar result. This is true IF and only IF there actually is a better solution than the mean, which I am not 100% sure about. Apr 15 '20 at 12:30
• @Fnguyen Can you please confirm the relations between old price, new price and discount? More conventional way would be to write as follows new price = old price*(1 - discount) = old price - old price*discount. Apr 20 '20 at 22:02
• @aivanov I added the mathematical relationships/formulas for each variable. Apr 21 '20 at 7:41

You could use linear regression without intercept in order to accomplish this.

If I understand correctly, your implementation of linear regression in Update 3 had two issues: first, you fit the linear model with intercept, but then drop the intercept when applying the model. Second, there is a typo in the following line

linear_discount = 1/linear_discount-1


In the code snippet below I extended your analyses by two approaches: linear regression without intercept and linear regression with intercept. The former case should correspond exactly to your requirements, i.e. using a single relative discount rate per customer. The latter one corresponds to the case with relaxed assumptions, i.e. one relative discount rate and one absolute discount (independent on the price level).

Note that for the illustrative dataset you provided the optimal (in terms of mean squared error) discount rate would be zero.

df_ext <- df %>%
# mean hack
mutate(Discount_indiv = (Old_Price-New_Price)/New_Price) %>% # Identify optimal discount individually
group_by(Customers) %>%
mutate(Discount_mean = mean(Discount_indiv),
Old_Price_mean = New_Price + New_Price*Discount_mean) %>% # Average individual discount to get approximate discount for customer

# incorrect linear regression (fitted with intercept, then intercept dropped)
do({ co <- coef(lm(Old_Price ~ New_Price, .))
mutate(., Discount_wrong = co[2])
}) %>%
ungroup %>%
mutate(Discount_wrong = 1 / Discount_wrong-1) %>%
mutate(Old_Price_wrong = New_Price+New_Price*Discount_wrong) %>%

# correct linear regression w/o intercept
group_by(Customers) %>%
mutate(Discount_regr = coef(lm(Old_Price ~ New_Price -1))[1] - 1,
Old_Price_regr1 = New_Price+New_Price*Discount_regr) %>%

# correct linear regression with intercept (i.e. two discounts per customer)
mutate(
Discount_abs = coef(lm(Old_Price ~ New_Price))[1],
Discount_rel = coef(lm(Old_Price ~ New_Price))[2] - 1,
Old_Price_regr2 = New_Price + New_Price*Discount_rel + Discount_abs) %>%

#calculate residuals
ungroup() %>%
mutate(Resid_mean = Old_Price_mean - Old_Price,
Resid_wrong = Old_Price_wrong - Old_Price,
Resid_regr1 = Old_Price_regr1 - Old_Price,
Resid_regr2 = Old_Price_regr2 - Old_Price)

#transform data for visualisation
df_gat <- select(df_ext, matches("Customers|Price")) %>%
gather(key="Approach", value="Old_Price", -Customers, -New_Price)

ggplot(df_gat, aes(x=New_Price, y=Old_Price, group=Approach, colour=Approach, shape=Approach)) +
geom_line() + geom_point(size=3) + facet_wrap(~Customers, ncol = 1)

select(df_ext, matches("Customers|Disc"))
select(df_ext, matches("Customers|Price"))

#calculate mean square error for all approaches
select(df_ext, matches("Customers|Res")) %>%
group_by(Customers) %>%
summarise_all(~mean(.^2))


Results for all approaches: MSE by customer & some visualizations

  Customers Resid_mean Resid_wrong Resid_regr1 Resid_regr2
<fct>          <dbl>       <dbl>       <dbl>       <dbl>
1 A               1.71        3.62       1.          0.222
2 B               1.71       11.5        1.000       0.222


• Awesome stuff! Thank you so much, this is super helpful and what I was looking for. The "absolute discount" is a bit strange in the domain but can be applied easily enough! Apr 22 '20 at 19:13
• I restarted the bounty to reward this answer btw. Apr 22 '20 at 19:14
• Happy to help. The idea about an absolute discount came to mind when I was thinking about how to bend the “model” so that it fits the data points better: the more parameters, the better the fit. You are right that the domain should be considered, I.e. to ensure that the absolute discount is not exploited. Apr 22 '20 at 19:23