How to efficiently compute the integral of a piecewise demand function?

Questions
, , ,
1

Dear all,

This is a question about efficient coding. In the code below, I write demands as integrals of piecewise functions (three pieces). I then need to find the price for which the derivative is null. In spite of my numerous trials, I didn’t manage to make the code efficient enough for Mathematica to find the answer.

Do you see a way to make it more efficient, or do you think the problem in itself is too intricate to be solved?

Code:

Clear["Global`*"]
a = 1/2;
t = 4/10;

da = Integrate[Piecewise[{{1, pa + t*x < 1/4},
     {((3/4) - (pa + t*x))/((3/4) - (1/4)) + ((pa + t*x - 1/4) (t*
          x))/(2*((3/4) - (1/4))) + ((pa + t*x - 1/4) (1 - pb - 
          t*x))/((3/4) - (1/4)), 1/4 < pa + t*x && pb + t*x < 1},
     {((3/4) - (pa + t*x))/((3/4) - (1/4)) + (1 - pb)^2/(
       2*((3/4) - (1/4))), 1/4 < pa + t*x && pb + t*x > 1}}], {x, 0, 
    1}];

db = Integrate[Piecewise[{{(1 - pb), pa + t*x < 1/4},
     {((1 - pb) ((3/4) - (pa + t*x)))/((3/4) - (1/4)) + ((pa + t*x - 
          1/4) (t*x))/(
       2*((3/4) - (1/4))) + ((pa + t*x - 1/4) (1 - pb - t*x))/((3/
          4) - (1/4)), 1/4 < pa + t*x && pb + t*x < 1},
     {((1 - pb) ((3/4) - (pa + t*x)))/((3/4) - (1/4)) + (1 - pb)^2/(
       2*((3/4) - (1/4))), 1/4 < pa + t*x && pb + t*x > 1}}], {x, 0, 
    1}];

pi = da*pa + pb*db;

dbdev = Integrate[Piecewise[{{1 - pbdev, pa + t*x < 1/4},
     {((1 - pbdev) ((3/4) - (pa + pb + t*x - pbdev)))/((3/4) - (1/
          4)) + ((pb + t*x - pbdev) (pa + pb + t*x - pbdev - 1/4))/(
       2*((3/4) - (1/4))) + ((pa + pb + t*x - pbdev - 1/4) (1 - pb - 
          t*x))/((3/4) - (1/4)), 1/4 < pa + t*x && pb + t*x < 1},
     {((3/4 - (pa + pb + t*x - pbdev)) (1 - pbdev))/((3/4) - (1/
          4)) + (1 - pbdev)^2/(2*((3/4) - (1/4))), 
      1/4 < pa + t*x && pb + t*x > 1}}], {x, 0, 1}];

pidev = da*pa + pbdev*dbdev;

Solve[D[pidev, pbdev] == 0 && D[D[pidev, pbdev], pbdev] < 0, pbdev, Reals]

Thank you so much for your help !

2

Your problem depends on three variables pa, pb, pbdev and it has one equation and one inequality, all of them polynomial. It seems hard to solve symbolically. You can explore the solution set visually:

ContourPlot3D[Evaluate[D[pidev, pbdev] == 0],
 {pbdev, 0, 10}, {pa, 0, 10}, {pb, 0, 10},
 RegionFunction -> Function[{pbdev, pa, pb},
   Evaluate[D[D[pidev, pbdev], pbdev] < 0]],
 AxesLabel -> Automatic]
3

I see, thank you very much! I wish I could compute the exact solution, but such a visual inspection is already very useful!