1
$\begingroup$

I am new to Mathematica and I am struggling finding the solution for the following problem. I am studying this piecewise function:

Piecewise[{{pdf1[x]/pdf[x] (h + (1 - h) 2 cdf1[x])/(
 h + (1 - h) 2 cdf[x]), 
x < a}, {pdf1[x]/pdf[x] (h + (1 - h) 2 (1 - cdf1[x] + cdf1[a]))/(
 h + (1 - h) 2 (1 - cdf[x] + cdf[a])), 
a <= x < b}, {pdf1[x]/pdf[x] (
 h + (1 - h) 2 (cdf1[x] - cdf1[b] + cdf1[a]))/(
 h + (1 - h) 2 (cdf[x] - cdf[b] + cdf[a])), 
b <= x < c}, {pdf1[x]/pdf[x] (
 h + (1 - h) 2 (1 - cdf1[x] + cdf1[c] - cdf1[b] + cdf1[a]))/(
 h + (1 - h) 2 (1 - cdf[x] + cdf[c] - cdf[b] + cdf[a])), x >= c}}]    

where

pdf1[x_] = PDF[NormalDistribution[1, 1], x]; 
pdf[x_] = PDF[NormalDistribution[0, 1], x];
cdf1[x_] = CDF[NormalDistribution[1, 1], x];
cdf[x_] = CDF[NormalDistribution[0, 1], x];

I would like the first and the third piece of the piecewise function to be smaller than a certain value $l$, say $l=0.48$; and the second and fourth piece of the function to be greater than the same $l$.

I managed to represent graphically the piecewise function with the following code:

Manipulate[Plot[{Piecewise[{{pdf1[x]/pdf[x] (h + (1 - h) 2 cdf1[x])/(
   h + (1 - h) 2 cdf[x]), 
  x < a}, {pdf1[x]/pdf[x] (
   h + (1 - h) 2 (1 - cdf1[x] + cdf1[a]))/(
   h + (1 - h) 2 (1 - cdf[x] + cdf[a])), 
  a <= x < b}, {pdf1[x]/pdf[x] (
   h + (1 - h) 2 (cdf1[x] - cdf1[b] + cdf1[a]))/(
   h + (1 - h) 2 (cdf[x] - cdf[b] + cdf[a])), 
  b <= x < c}, {pdf1[x]/pdf[x] (
   h + (1 - h) 2 (1 - cdf1[x] + cdf1[c] - cdf1[b] + cdf1[a]))/(
   h + (1 - h) 2 (1 - cdf[x] + cdf[c] - cdf[b] + cdf[a])), 
  x >= c}}], l}, {x, -5, 5}, PlotRange -> 3], {a, -10, 10, 
  Appearance -> "Labeled"}, {b, a, 5, Appearance -> "Labeled"}, {c, b,
   5, Appearance -> "Labeled"}, {h, 0, 1, 
  Appearance -> "Labeled"}, {l, 0, 1, Appearance -> "Labeled"}]  

The picture is an example of a solution where, for $h=0$, I set $a=0.05$, $b=0.27$ and $c=0.41$ (the yellow line corresponds to $l=0.48$)enter image description here

What I am interested in is finding for each $h$ the set of combinations of $a$, $b$ and $c$ such that the system of inequalities is satisfied and I need to give a graphical representation of the set of solution somehow. I have tried something also by defining a domain for $a$, $b$ and $c$ such that $-2<a<b<c<2$, but I feel my skills with Mathematica are too poor to handle the task. Any piece of advice would be highly appreciated. Thank you.

$\endgroup$
  • 1
    $\begingroup$ Given your description of the problem, {a, b, c} are not unique. For instance, for the parameters in the question, a could just as well be 0. Please describe more carefully what you are seeking. By the way,, the last block of code in the question does not execute as written. $\endgroup$ – bbgodfrey Sep 27 '18 at 1:21
  • $\begingroup$ Thank you for your answer, I edited the last part of the code and now it should work: the image represented is obtained using the values of the parameters I reported in the post and $h=0$. As you correctly noticed ${a, b, c}$ are not unique: I would like to know, given a certain $h$, all the possible ${a, b, c}$ such that the four inequalities are satisfied, this is what I meant when I said 'the set of combination of $a$, $b$ and $c$. Thank you again $\endgroup$ – Api Sep 27 '18 at 21:37
0
$\begingroup$

The following seems to work, but I have not tested it exhaustively. Define the four curves in the Piecewise function as

Clear[a, b, c, f1, f2, f3, f4, f]; h = 0; l = .48; SeedRandom[1900];
f1[x_] := pdf1[x]/pdf[x] (h + (1 - h) 2 cdf1[x])/(h + (1 - h) 2 cdf[x])
f2[x_] := pdf1[x]/pdf[x] (h + (1 - h) 2 (1 - cdf1[x] + cdf1[a]))/
    (h + (1 - h) 2 (1 - cdf[x] + cdf[a]))
f3[x_] := pdf1[x]/pdf[x] (h + (1 - h) 2 (cdf1[x] - cdf1[b] + cdf1[a]))/
    (h + (1 - h) 2 (cdf[x] - cdf[b] + cdf[a]))
f4[x_] := pdf1[x]/pdf[x] (h + (1 - h) 2 (1 - cdf1[x] + cdf1[c] - cdf1[b] + 
    cdf1[a]))/(h + (1 - h) 2 (1 - cdf[x] + cdf[c] - cdf[b] + cdf[a]))

Then a can be no smaller that the value of x for which f2 is equal to l, and no larger than the value of x for which f1 is equal to l. Compute these points and place a randomly in that range.

{amin = a /. FindRoot[f2[a] == l, {a, -1/2}], amax = a /. FindRoot[f1[a] == l, {a, 1/2}], 
    a = RandomReal[{amin, amax}]}
(* {-0.233969, 0.544866, 0.337909} *)

Next, b can be no smaller than a and no larger than the value of x for which f3 is equal to l. Compute these points and place b randomly in that range.

{bmin = a, bmax = b /. FindRoot[f3[b] == l, {b, 1/2}], b = RandomReal[{bmin, bmax}]}
(* {0.337909, 0.678207, 0.432968} *)

Finally, c is calculated in a similar manner.

{cmin = b, cmax = c /. FindRoot[f3[c] == l, {c, 1/2}], c = RandomReal[{cmin, cmax}]}
(* {0.432968, 0.574512, 0.465049} *)

f[x_] := Piecewise[{{f1[x], x < a}, {f2[x], a <= x < b}, 
    {f3[x], b <= x < c}, {f4[x], x >= c}}]
Plot[{f[x], l}, {x, -1, 1}, PlotRange -> All, PlotPoints -> 1000,
    ImageSize -> Large, AxesLabel -> {x, f}, LabelStyle -> {Bold, Black, Medium}]

enter image description here

Addendum

The need for reasonable guesses when computing amin, etc. with FindRoot can be eliminated by using NArgMin and NArgMax as follows. (Subsequently edited by including b < c in the computation of cmax to avoid a singularity in f3 for some parameters.)

{amin = NArgMin[{f2[a], f2[a] > l}, a], amax = NArgMax[{f1[a], f1[a] < l}, a], 
    a = RandomReal[{amin, amax}]}
{bmin = a, bmax = NArgMax[{f3[b], f3[b] < l}, b], b = RandomReal[{bmin, bmax}]}
{cmin = b, cmax = NArgMax[{f3[c], f3[c] < l, b < c}, c], c = RandomReal[{cmin, cmax}]}

Incidentally, I have obtained results similar to those above with h = 0.1 and h = 0.5, the latter shown below.

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for your answer, it has been very helpful in proceeding with my work! I am stuck right now on another issue: I would like to represent on a 3d graph the set of the combination of ${a,b,c)$ that satisfies the four inequalities. Would you be able to provide any piece of advice? everything I have tried does not seem to work. Thank you again $\endgroup$ – Api Oct 4 '18 at 17:48
  • $\begingroup$ I apologize that I had not accepted your answer until now. I have also posted a new question about the 3d graph. Thank you very much. $\endgroup$ – Api Oct 4 '18 at 23:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.