3
$\begingroup$

I would like to solve this equation

$\log{\frac{a}{1 - a}} + b (1 - 2 a) = 0$

letting varying the parameter $b$ in $\lbrace 0,1,\ldots,20\rbrace$ and then plot the result.

I am trying writing the code but I am stuck with this

eq = Log[a/(1 - a)] + b (1 - 2 a) == 0
x = Range[1, 20, 1]
y = x
For[i = 1, i <= Length[x], i++, y[[i]] = NSolve[eq[a, b ./ b -> x[[i]]], a]]

but the syntax is wrong. How can I do my plot? Thanks.

$\endgroup$
  • $\begingroup$ What should the correct code do? Independently of b, a=1/2 is a solution. If b is an integer greater or equal to 2, there are additional real solutions. Which solutions do you need? $\endgroup$ – Coolwater Sep 7 '16 at 16:58
  • $\begingroup$ I should have been more precise. I am interested in the case $b>2$ and $a\neq \frac{1}{2}$. In the case $b > 2$ the solutions $a = \frac{1}{2}$ are always local maximums, I want to find the two global minimums. $\endgroup$ – Nisba Sep 7 '16 at 17:04
2
$\begingroup$

I post for insights. By inspection a=1/2 is always a real solution. For insight into the other solutions that vary with b:

f[a_, b_] := Log[a/(1 - a)] + b (1 - 2 a)
cp = ContourPlot[f[y, x], {x, 0, 20}, {y, 0.001, 0.999}, 
   Contours -> {{0.}}, ContourShading -> None, PlotPoints -> 50];
pp = Plot3D[f[y, x], {x, 0, 20}, {y, 0.001, 0.999}, 
   MeshFunctions -> {#3 &}, Mesh -> {{0.}}, MeshStyle -> {Red, Thick},
    PlotPoints -> 50];
sol[b_] := 
  Chop[(a /. 
       Quiet[FindRoot[f[a, b] == 0, {a, #}, 
         AccuracyGoal -> Infinity]]) & /@ {0.0001, 0.5, 0.9999}];
rt = ListPlot[Transpose[Table[sol[j], {j, 0, 20, 0.5}]], 
   Joined -> True, Frame -> True];
Column[{cp, pp, rt}, Frame -> True]

enter image description here

$\endgroup$
1
$\begingroup$

Let

eq = Log[a/(1 - a)] + b (1 - 2 a) == 0

First, at all cost don't use For. This is a topic way too broad and extensively covered on this site, so I'll just state it: don't use For, use Do, While, Table, ...

In this case I'll use Table.

Next, NSolve tries to find all solutions, which is usually hard. That's why I plotted the function Log[a/(1 - a)] + b (1 - 2 a) for a few b to see what to expect. This allowed me to set a starting point for FindRoot: the solutions will be near 0 and 1 (in fact, the greater b will be, the closer the solutions will be to 0 or 1).

To find solutions near a=1:

a1 = SetAccuracy[Chop@Table[{i, a /. FindRoot[eq /. b -> i, {a, 0.9999}]}, {i, 3, 
20}], 15]

{{3.00000000000000, 0.92927981832006}, {4.000000000000000, 0.97875201203864},...}

up to b=20.

Similarly, to find the other solution:

a0 = SetAccuracy[Chop@Table[{i, a /. FindRoot[eq /. b -> i, {a, 0.0000001}]}, {i, 3, 
20}], 15]

{{3.00000000000000, 0.07072018167994}, {4.000000000000000, 0.02124798796136},...}

also up to b=20.

To plot the solutions in dependence on b:

GraphicsRow[{ListPlot[a1, Frame -> True], ListPlot[a0, Frame -> True]}, ImageSize -> 1000]

enter image description here

$\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.