1
$\begingroup$

I have two equations:

$$P_a=P_a(x,y)$$

$$ P_b=1-P_a(x,y) $$ $P_a$, $P_b$, $x$ and $y$ are probabilities so their values are between 0 and 1.

If I know the values of $x$ and $y$ I can calculate easily $P_a$ and $P_b$, the problems is I have $P_a$ and $P_b$, and I need to calculate $x$ and $y$. I had some ideas but any of them worked:

  • The polynomials are high order and I tried to simplify the expressions, but I still get errors.
  • I tried reduce also with assumptions, I still get the errors.
  • I thought maybe the Inverse function could help but I have two equations and two variables and failed to use it in this case.
  • I generated a list of points, then used Interpolation and the expression I got in the 3D Plot is similar to the original polynomial BUT I don't have any explicit expression to work with so it was not useful. Apparently there is an internal calculation inside Mathematica but you don't get an expression. I tried InterpolatingPolynomial but got an error.
  • I tried a Taylor expansion to get a simpler expression but only worked around $x$,$y\approx 0.5$. I saw in the plot that for values close to 1 there were some strange things.

So folks, does anybody know how could I get $x$ and $y$ as function of $P_a$ and $P_b$?

Or at least, does anybody know how to calculate $x$ and $y$ if I know $P_a$ and $P_b$?

I have lost 6 days with this problem and I am desperate.

This is the expression for $P_a$:

Pa = 1/(-wb + wa (-1 + 2 wb))*
  wa (-1 + wb) (-(-1 + wb)^5 (1 + 5 wb) + 
    15 wa (-1 + wb)^4 wb (1 + 5 wb) - 
    5 wa^2 (-1 + wb)^3 wb (-11 + wb + 70 wb^2) + 
    5 wa^3 (-1 + wb)^2 wb (17 - 69 wb - 28 wb^2 + 140 wb^3) - 
    5 wa^6 wb (1 - 14 wb + 56 wb^2 - 84 wb^3 + 42 wb^4) + 
    3 wa^4 wb (-23 + 202 wb - 473 wb^2 + 252 wb^3 + 252 wb^4 - 
       210 wb^5) + 
    wa^5 wb (29 - 331 wb + 1064 wb^2 - 1176 wb^3 + 210 wb^4 + 
       210 wb^5))

I have to mention that I have the same problem with an expression that is like a 100 times larger than this one. Hopefully what I learn from this calculation could be applied in the more complicated polynomial.

I have to mention that sometimes when I push Enter to start a calculation Mathematica doesn't respond. Should I increase the memory dedicated to calculations to avoid this problem?

It says "running" but I can wait hours and I don't get an answer.

This is for example the code I used to try to Solve this polynomial:

NSolve[0.5 == 
   1/(-wb + wa (-1 + 2 wb)) *
     wa (-1 + wb) (-(-1 + wb)^5 (1 + 5 wb) + 
      15 wa (-1 + wb)^4 wb (1 + 5 wb) - 
      5 wa^2 (-1 + wb)^3 wb (-11 + wb + 70 wb^2) + 
      5 wa^3 (-1 + wb)^2 wb (17 - 69 wb - 28 wb^2 + 140 wb^3) - 
      5 wa^6 wb (1 - 14 wb + 56 wb^2 - 84 wb^3 + 42 wb^4) + 
      3 wa^4 wb (-23 + 202 wb - 473 wb^2 + 252 wb^3 + 252 wb^4 - 
         210 wb^5) + 
      wa^5 wb (29 - 331 wb + 1064 wb^2 - 1176 wb^3 + 210 wb^4 + 
         210 wb^5)) && 
  0.5 == 1 - (1/(-wb + wa (-1 + 2 wb)) *
       wa (-1 + wb) (-(-1 + wb)^5 (1 + 5 wb) + 
        15 wa (-1 + wb)^4 wb (1 + 5 wb) - 
        5 wa^2 (-1 + wb)^3 wb (-11 + wb + 70 wb^2) + 
        5 wa^3 (-1 + wb)^2 wb (17 - 69 wb - 28 wb^2 + 140 wb^3) - 
        5 wa^6 wb (1 - 14 wb + 56 wb^2 - 84 wb^3 + 42 wb^4) + 
        3 wa^4 wb (-23 + 202 wb - 473 wb^2 + 252 wb^3 + 252 wb^4 - 
           210 wb^5) + 
        wa^5 wb (29 - 331 wb + 1064 wb^2 - 1176 wb^3 + 210 wb^4 + 
           210 wb^5))) && 0 < wa < 1 && 0 < wb < 1, {wa, wb}]

These are the errors I get:

NSolve::svars: Equations may not give solutions for all "solve" variables. >>
NSolve::ratnz: NSolve was unable to solve the system with inexact coefficients. The answer was obtained by solving a corresponding exact system and numericizing the result. >>

And this is the result:

(*{{wb -> ConditionalExpression[wa, 0 < wa < 1.]}}*)

I know the polynomials contain a lot of terms and could be high order, but the range is between 0 and 1, maybe there is a way to take advantage of that to get the solution.

$\endgroup$
  • 2
    $\begingroup$ If you run a ContourPlot on both equations, you'll see that for both the solution is $wa=wb$ for $0 < wa, wb < 1$. So there are an infinite number of solutions. The result you see {{wb -> ConditionalExpression[wa, 0 < wa < 1.]}} is correct. $\endgroup$ – JimB Dec 12 '15 at 21:33
  • 3
    $\begingroup$ You don't have two independent equations, which is what is needed in order for NSolve to give a "better" result. $\endgroup$ – Daniel Lichtblau Dec 12 '15 at 21:47
  • $\begingroup$ Maybe it was a particular case for 0.5. If Pa=0.6 and Pb=0.4, Do you think I still will get the same problem? $\endgroup$ – George Dec 12 '15 at 22:19
  • $\begingroup$ Basically what I have is: $\endgroup$ – George Dec 12 '15 at 22:20
  • $\begingroup$ Pa=Pa(wa,wb) And Pb+Pa=1 $\endgroup$ – George Dec 12 '15 at 22:21
4
$\begingroup$

This is more of an extended comment.

Knowing $P_b=1-P_a$ doesn't add another equation to the party (as @Daniel Lichtblau pointed out). In other words, knowing $P_a$ and $P_b$ doesn't give you two equations for the two unknowns $x$ and $y$. However, if you know $P_a$ and $x$, then you could solve (numerically) for $y$. (Below I've used your notation of wa and wb interchangeably for $x$ and $y$.)

First show the contour plot:

prob[wa_, wb_] := 1/(-wb + wa (-1 + 2 wb)) wa (-1 + wb) (-(-1 + wb)^5 (1 + 5 wb) +
        15 wa (-1 + wb)^4 wb (1 + 5 wb) - 
        5 wa^2 (-1 + wb)^3 wb (-11 + wb + 70 wb^2) + 
        5 wa^3 (-1 + wb)^2 wb (17 - 69 wb - 28 wb^2 + 140 wb^3) -
        5 wa^6 wb (1 - 14 wb + 56 wb^2 - 84 wb^3 + 42 wb^4) + 
        3 wa^4 wb (-23 + 202 wb - 473 wb^2 + 252 wb^3 + 252 wb^4 - 210 wb^5) + 
        wa^5 wb (29 - 331 wb + 1064 wb^2 - 1176 wb^3 + 210 wb^4 + 210 wb^5))

ContourPlot[prob[wa, wb], {wa, 0, 1}, {wb, 0, 1}, ContourLabels -> True,
  Contours -> {0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.95},
  Frame -> True, FrameLabel -> {Style["wa", Large, Bold, Black],
    Style["wb", Large, Bold, Black]}]

Contour plot

One way to solve for wb given values of wa and pa is to use NSolve:

wa = 0.8;
pa = 0.1;
wb /. NSolve[pa == prob[wa, wb] && 0 < wb < 1, wb][[1]]
(* 0.9625101428796428 *)

An alternative but less exact approach is to interpolate:

y = Interpolation[
  Flatten[Table[{{wa, prob[wa, wb]}, wb}, {wa, 0.005, 0.995, 0.005},
     {wb, 0.005, 0.995, 0.005}], 1],
  InterpolationOrder -> 1]

x = 0.8;
pa = 0.1;
y[x, pa]
(* 0.9624580040494005 *)

(* Check to see if we get back close to the original value of pa *)
prob[x, y[x, pa]]
(* 0.1001401896838602 *)

The interpolation method is less exact but likely much, much quicker if you have lots of evaluations to make.

$\endgroup$

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.